Is it possible to read the devel.cfg files of other snaplets when I'm writing my own snaplet?
I've tried to use getSnapletUserConfig together with withTop but that does not seem to work.
Below is a minimal (non-)working example in which I try to read the authTable key of snaplets/postgresql-auth/devel.cfg from within the Initializer of my own snaplet.
-- Main.hs
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module Main where
import Control.Lens.TH
import Control.Monad.IO.Class
import Data.Text
import Snap.Http.Server
import Snap.Snaplet
import Snap.Snaplet.Auth
import Snap.Snaplet.Auth.Backends.PostgresqlSimple
import Snap.Snaplet.PostgresqlSimple
import Snap.Snaplet.Session
import Snap.Snaplet.Session.Backends.CookieSession
import qualified Data.Configurator as C
-- ============================================================================
-- Pretty-Print
-- ============================================================================
horizontalRule :: IO ()
horizontalRule = do
putStrLn ""
putStrLn $ Prelude.replicate 79 '='
putStrLn ""
-- ============================================================================
-- Snaplet Code
-- ============================================================================
data MySnaplet = MySnaplet
initMySnaplet :: Snaplet Postgres -> SnapletLens b a -> SnapletInit b MySnaplet
initMySnaplet db l = makeSnaplet "mysnaplet" "My Snaplet" Nothing $ do
-- I would assume `config` to be the `devel.cfg` file of the Snaplet whose
-- SnapletLens `l` is passed in.
-- In the `App` example below, `l` will be `auth`.
-- As such, it should be possible to read the value of the `authTable` key
-- in `snaplets/postgresql-auth/devel.cfg`.
-- However, this does not work (see below).
config <- withTop l getSnapletUserConfig
-- For simplicity, `config` and the value of the `authTable` key are
-- printed to stdout.
liftIO $ do
horizontalRule
putStrLn
"Result of `withTop l getSnapletUserConfig >>= liftIO . C.display`:"
putStrLn ""
C.display config
horizontalRule
putStrLn "This should print the value of the `authTable` key in "
putStrLn "`snaplets/postgresql-auth/devel.cfg`."
putStrLn "Usually, this would be `snap_auth_user`."
putStrLn ""
print =<< C.lookupDefault
("This should not happen!" :: Text)
config
"authTable"
horizontalRule
putStrLn
"Despite `withTop`, values are read from the current Snaplet's config:"
putStrLn ""
print =<< C.lookupDefault
("This does not happen" :: Text)
config
"someKey"
horizontalRule
return MySnaplet
-- ============================================================================
-- Application Code
-- ============================================================================
data App = App
{ _sess :: Snaplet SessionManager
, _auth :: Snaplet (AuthManager App)
, _db :: Snaplet Postgres
, _mySnaplet :: Snaplet MySnaplet
}
makeLenses ''App
appInit :: SnapletInit App App
appInit = makeSnaplet "app" "App" Nothing $ do
sessionSnaplet <- nestSnaplet "sess" sess $
initCookieSessionManager "site_key.txt" "sess" Nothing (Just 3600)
dbSnaplet <- nestSnaplet "db" db pgsInit
authSnaplet <- nestSnaplet "auth" auth $ initPostgresAuth sess dbSnaplet
mySnaplet <- nestSnaplet "mysnaplet" mySnaplet $ initMySnaplet dbSnaplet auth
return App
{ _sess = sessionSnaplet
, _auth = authSnaplet
, _db = dbSnaplet
, _mySnaplet = mySnaplet
}
main :: IO ()
main = do
(_, site, _) <- runSnaplet Nothing appInit
quickHttpServe site
Is it possible to read the
devel.cfg
files of other snaplets when I'm writing my own snaplet?I've tried to use
getSnapletUserConfig
together withwithTop
but that does not seem to work.Below is a minimal (non-)working example in which I try to read the
authTable
key ofsnaplets/postgresql-auth/devel.cfg
from within theInitializer
of my own snaplet.The relevant
devel.cfg
files are:snaplets/postgresql-auth/devel.cfg
:snaplets/postgresql-simple/devel.cfg
(make suretestdb
exists):snaplets/mysnaplet/devel.cfg
:When I replace the line
with
the program behaviour does not change at all.
Am I doing something wrong or could this be a bug in
Snap
?