Get config of another snaplet inside Initializer

[menelaos]

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

The relevant devel.cfg files are:

snaplets/postgresql-auth/devel.cfg:

minPasswordLen = 8
rememberCookie = "_remember"
rememberPeriod = 1209600
siteKey = "site_key.txt"
authTable = "snap_auth_user"

snaplets/postgresql-simple/devel.cfg (make sure testdb exists):

host = "localhost"
port = 5432
user = "postgres"
pass = ""
db = "testdb"
numStripes = 1
idleTime = 5
maxResourcesPerStripe = 20

snaplets/mysnaplet/devel.cfg:

someKey = "This text is read from snaplets/mysnaplet/devel.cfg"

When I replace the line

  config <- withTop l getSnapletUserConfig

with

  config <- getSnapletUserConfig

the program behaviour does not change at all.

Am I doing something wrong or could this be a bug in Snap?