    {-# LANGUAGE BangPatterns, OverloadedStrings, RecordWildCards,
        ScopedTypeVariables, TupleSections #-}

    -- |
    -- Module:      Data.Configurator
    -- Copyright:   (c) 2011 MailRank, Inc.
    -- License:     BSD3
    -- Maintainer:  Bryan O'Sullivan <bos@serpentine.com>
    -- Stability:   experimental
    -- Portability: portable
    --
    -- A simple (yet powerful) library for working with configuration
    -- files.

    module Data.Configurator
        (
        -- * Configuration file format
        -- $format

        -- ** Binding a name to a value
        -- $binding

        -- *** Value types
        -- $types

        -- *** String interpolation
        -- $interp

        -- ** Grouping directives
        -- $group

        -- ** Importing files
        -- $import

        -- * Types
          Worth(..)
        -- * Loading configuration data
        , autoReload
        , autoReloadGroups
        , autoConfig
        , empty
        -- * Lookup functions
        , lookup
        , lookupDefault
        , require
        -- * Notification of configuration changes
        -- $notify
        , prefix
        , exact
        , subscribe
        -- * Low-level loading functions
        , load
        , loadGroups
        , reload
        , subconfig
        , addToConfig
        , addGroupsToConfig
        -- * Helper functions
        , display
        , getMap
        ) where

    import Control.Applicative ((<$>))
    import Control.Concurrent (ThreadId, forkIO, threadDelay)
    import Control.Exception (SomeException, evaluate, handle, throwIO, try)
    import Control.Monad (foldM, forM, forM_, join, when, msum)
    import Data.Configurator.Instances ()
    import Data.Configurator.Parser (interp, topLevel)
    import Data.Configurator.Types.Internal
    import Data.IORef (atomicModifyIORef, newIORef, readIORef)
    import Data.List (tails)
    import Data.Maybe (fromMaybe, isJust)
    import Data.Monoid (mconcat)
    import Data.Ratio (denominator, numerator)
    import Data.Text.Lazy.Builder (fromString, fromText, toLazyText)
    import Data.Text.Lazy.Builder.Int (decimal)
    import Data.Text.Lazy.Builder.RealFloat (realFloat)
    import Prelude hiding (lookup)
    import System.Environment (getEnv)
    import System.IO (hPutStrLn, stderr)
    import System.IO.Unsafe (unsafePerformIO)
    import System.Posix.Types (EpochTime, FileOffset)
    import System.PosixCompat.Files (fileSize, getFileStatus, modificationTime)
    import qualified Control.Exception as E
    import qualified Data.Attoparsec.Text as T
    import qualified Data.Attoparsec.Text.Lazy as L
    import qualified Data.HashMap.Lazy as H
    import qualified Data.Text as T
    import qualified Data.Text.Lazy as L
    import qualified Data.Text.Lazy.IO as L

    loadFiles :: [Worth Path] -> IO (H.HashMap (Worth Path) [Directive])
    loadFiles :: [Worth Text] -> IO (HashMap (Worth Text) [Directive])
    loadFiles = (HashMap (Worth Text) [Directive]
     -> Worth Text -> IO (HashMap (Worth Text) [Directive]))
    -> HashMap (Worth Text) [Directive]
    -> [Worth Text]
    -> IO (HashMap (Worth Text) [Directive])
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM HashMap (Worth Text) [Directive]
    -> Worth Text -> IO (HashMap (Worth Text) [Directive])
    go HashMap (Worth Text) [Directive]
    forall k v. HashMap k v
    H.empty
     where
       go :: HashMap (Worth Text) [Directive]
    -> Worth Text -> IO (HashMap (Worth Text) [Directive])
    go HashMap (Worth Text) [Directive]
    seen Worth Text
    path = do
         let rewrap :: b -> Worth b
    rewrap b
    n = b -> Text -> b
    forall a b. a -> b -> a
    const b
    n (Text -> b) -> Worth Text -> Worth b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Worth Text
    path
             wpath :: Text
    wpath = Worth Text -> Text
    forall a. Worth a -> a
    worth Worth Text
    path
         path' <- Text -> Worth Text
    forall {b}. b -> Worth b
    rewrap (Text -> Worth Text) -> IO Text -> IO (Worth Text)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Text -> Text -> HashMap Text Value -> IO Text
    interpolate Text
    "" Text
    wpath HashMap Text Value
    forall k v. HashMap k v
    H.empty
         ds    <- loadOne (T.unpack <$> path')
         let !seen'    = Worth Text
    -> [Directive]
    -> HashMap (Worth Text) [Directive]
    -> HashMap (Worth Text) [Directive]
    forall k v.
    (Eq k, Hashable k) =>
    k -> v -> HashMap k v -> HashMap k v
    H.insert Worth Text
    path [Directive]
    ds HashMap (Worth Text) [Directive]
    seen
             notSeen Worth Text
    n = Bool -> Bool
    not (Bool -> Bool)
    -> (HashMap (Worth Text) [Directive] -> Bool)
    -> HashMap (Worth Text) [Directive]
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe [Directive] -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe [Directive] -> Bool)
    -> (HashMap (Worth Text) [Directive] -> Maybe [Directive])
    -> HashMap (Worth Text) [Directive]
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Worth Text -> HashMap (Worth Text) [Directive] -> Maybe [Directive]
    forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
    H.lookup Worth Text
    n (HashMap (Worth Text) [Directive] -> Bool)
    -> HashMap (Worth Text) [Directive] -> Bool
    forall a b. (a -> b) -> a -> b
    $ HashMap (Worth Text) [Directive]
    seen
         foldM go seen' . filter notSeen . importsOf wpath $ ds

    -- | Create a 'Config' from the contents of the named files. Throws an
    -- exception on error, such as if files do not exist or contain errors.
    --
    -- File names have any environment variables expanded prior to the
    -- first time they are opened, so you can specify a file name such as
    -- @\"$(HOME)/myapp.cfg\"@.
    load :: [Worth FilePath] -> IO Config
    load :: [Worth String] -> IO Config
    load [Worth String]
    files = (BaseConfig -> Config) -> IO BaseConfig -> IO Config
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Text -> BaseConfig -> Config
    Config Text
    "") (IO BaseConfig -> IO Config) -> IO BaseConfig -> IO Config
    forall a b. (a -> b) -> a -> b
    $ Maybe AutoConfig -> [(Text, Worth String)] -> IO BaseConfig
    load' Maybe AutoConfig
    forall a. Maybe a
    Nothing ((Worth String -> (Text, Worth String))
    -> [Worth String] -> [(Text, Worth String)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\Worth String
    f -> (Text
    "", Worth String
    f)) [Worth String]
    files)

    -- | Create a 'Config' from the contents of the named files, placing them
    -- into named prefixes.  If a prefix is non-empty, it should end in a
    -- dot.
    loadGroups :: [(Name, Worth FilePath)] -> IO Config
    loadGroups :: [(Text, Worth String)] -> IO Config
    loadGroups [(Text, Worth String)]
    files = (BaseConfig -> Config) -> IO BaseConfig -> IO Config
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Text -> BaseConfig -> Config
    Config Text
    "") (IO BaseConfig -> IO Config) -> IO BaseConfig -> IO Config
    forall a b. (a -> b) -> a -> b
    $ Maybe AutoConfig -> [(Text, Worth String)] -> IO BaseConfig
    load' Maybe AutoConfig
    forall a. Maybe a
    Nothing [(Text, Worth String)]
    files

    load' :: Maybe AutoConfig -> [(Name, Worth FilePath)] -> IO BaseConfig
    load' :: Maybe AutoConfig -> [(Text, Worth String)] -> IO BaseConfig
    load' Maybe AutoConfig
    auto [(Text, Worth String)]
    paths0 = do
      let second :: (t -> b) -> (a, t) -> (a, b)
    second t -> b
    f (a
    x,t
    y) = (a
    x, t -> b
    f t
    y)
          paths :: [(Text, Worth Text)]
    paths          = ((Text, Worth String) -> (Text, Worth Text))
    -> [(Text, Worth String)] -> [(Text, Worth Text)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Worth String -> Worth Text)
    -> (Text, Worth String) -> (Text, Worth Text)
    forall {t} {b} {a}. (t -> b) -> (a, t) -> (a, b)
    second ((String -> Text) -> Worth String -> Worth Text
    forall a b. (a -> b) -> Worth a -> Worth b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap String -> Text
    T.pack)) [(Text, Worth String)]
    paths0
      ds <- [Worth Text] -> IO (HashMap (Worth Text) [Directive])
    loadFiles (((Text, Worth Text) -> Worth Text)
    -> [(Text, Worth Text)] -> [Worth Text]
    forall a b. (a -> b) -> [a] -> [b]
    map (Text, Worth Text) -> Worth Text
    forall a b. (a, b) -> b
    snd [(Text, Worth Text)]
    paths)
      p <- newIORef paths
      m <- newIORef =<< flatten paths ds
      s <- newIORef H.empty
      return BaseConfig {
                    cfgAuto = auto
                  , cfgPaths = p
                  , cfgMap = m
                  , cfgSubs = s
                  }

    -- | Gives a 'Config' corresponding to just a single group of the original
    -- 'Config'.  The subconfig can be used just like the original 'Config', but
    -- see the documentation for 'reload'.
    subconfig :: Name -> Config -> Config
    subconfig :: Text -> Config -> Config
    subconfig Text
    g (Config Text
    root BaseConfig
    cfg) = Text -> BaseConfig -> Config
    Config ([Text] -> Text
    T.concat [Text
    root, Text
    g, Text
    "."]) BaseConfig
    cfg

    -- | Forcibly reload a 'Config'. Throws an exception on error, such as
    -- if files no longer exist or contain errors.  If the provided 'Config' is
    -- a 'subconfig', this will reload the entire top-level configuration, not just
    -- the local section.
    reload :: Config -> IO ()
    reload :: Config -> IO ()
    reload (Config Text
    _ cfg :: BaseConfig
    cfg@BaseConfig{Maybe AutoConfig
    IORef [(Text, Worth Text)]
    IORef (HashMap Text Value)
    IORef (HashMap Pattern [ChangeHandler])
    cfgAuto :: BaseConfig -> Maybe AutoConfig
    cfgPaths :: BaseConfig -> IORef [(Text, Worth Text)]
    cfgMap :: BaseConfig -> IORef (HashMap Text Value)
    cfgSubs :: BaseConfig -> IORef (HashMap Pattern [ChangeHandler])
    cfgAuto :: Maybe AutoConfig
    cfgPaths :: IORef [(Text, Worth Text)]
    cfgMap :: IORef (HashMap Text Value)
    cfgSubs :: IORef (HashMap Pattern [ChangeHandler])
    ..}) = BaseConfig -> IO ()
    reloadBase BaseConfig
    cfg

    reloadBase :: BaseConfig -> IO ()
    reloadBase :: BaseConfig -> IO ()
    reloadBase cfg :: BaseConfig
    cfg@BaseConfig{Maybe AutoConfig
    IORef [(Text, Worth Text)]
    IORef (HashMap Text Value)
    IORef (HashMap Pattern [ChangeHandler])
    cfgAuto :: BaseConfig -> Maybe AutoConfig
    cfgPaths :: BaseConfig -> IORef [(Text, Worth Text)]
    cfgMap :: BaseConfig -> IORef (HashMap Text Value)
    cfgSubs :: BaseConfig -> IORef (HashMap Pattern [ChangeHandler])
    cfgAuto :: Maybe AutoConfig
    cfgPaths :: IORef [(Text, Worth Text)]
    cfgMap :: IORef (HashMap Text Value)
    cfgSubs :: IORef (HashMap Pattern [ChangeHandler])
    ..} = do
      paths <- IORef [(Text, Worth Text)] -> IO [(Text, Worth Text)]
    forall a. IORef a -> IO a
    readIORef IORef [(Text, Worth Text)]
    cfgPaths
      m' <- flatten paths =<< loadFiles (map snd paths)
      m <- atomicModifyIORef cfgMap $ \HashMap Text Value
    m -> (HashMap Text Value
    m', HashMap Text Value
    m)
      notifySubscribers cfg m m' =<< readIORef cfgSubs

    -- | Add additional files to a 'Config', causing it to be reloaded to add
    -- their contents.
    addToConfig :: [Worth FilePath] -> Config -> IO ()
    addToConfig :: [Worth String] -> Config -> IO ()
    addToConfig [Worth String]
    paths0 Config
    cfg = [(Text, Worth String)] -> Config -> IO ()
    addGroupsToConfig ((Worth String -> (Text, Worth String))
    -> [Worth String] -> [(Text, Worth String)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\Worth String
    x -> (Text
    "",Worth String
    x)) [Worth String]
    paths0) Config
    cfg

    -- | Add additional files to named groups in a 'Config', causing it to be
    -- reloaded to add their contents.  If the prefixes are non-empty, they should
    -- end in dots.
    addGroupsToConfig :: [(Name, Worth FilePath)] -> Config -> IO ()
    addGroupsToConfig :: [(Text, Worth String)] -> Config -> IO ()
    addGroupsToConfig [(Text, Worth String)]
    paths0 (Config Text
    root cfg :: BaseConfig
    cfg@BaseConfig{Maybe AutoConfig
    IORef [(Text, Worth Text)]
    IORef (HashMap Text Value)
    IORef (HashMap Pattern [ChangeHandler])
    cfgAuto :: BaseConfig -> Maybe AutoConfig
    cfgPaths :: BaseConfig -> IORef [(Text, Worth Text)]
    cfgMap :: BaseConfig -> IORef (HashMap Text Value)
    cfgSubs :: BaseConfig -> IORef (HashMap Pattern [ChangeHandler])
    cfgAuto :: Maybe AutoConfig
    cfgPaths :: IORef [(Text, Worth Text)]
    cfgMap :: IORef (HashMap Text Value)
    cfgSubs :: IORef (HashMap Pattern [ChangeHandler])
    ..}) = do
      let fix :: (Text, f String) -> (Text, f Text)
    fix (Text
    x,f String
    y) = (Text
    root Text -> Text -> Text
    `T.append` Text
    x, (String -> Text) -> f String -> f Text
    forall a b. (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap String -> Text
    T.pack f String
    y)
          paths :: [(Text, Worth Text)]
    paths     = ((Text, Worth String) -> (Text, Worth Text))
    -> [(Text, Worth String)] -> [(Text, Worth Text)]
    forall a b. (a -> b) -> [a] -> [b]
    map (Text, Worth String) -> (Text, Worth Text)
    forall {f :: * -> *}.
    Functor f =>
    (Text, f String) -> (Text, f Text)
    fix [(Text, Worth String)]
    paths0
      IORef [(Text, Worth Text)]
    -> ([(Text, Worth Text)] -> ([(Text, Worth Text)], ())) -> IO ()
    forall a b. IORef a -> (a -> (a, b)) -> IO b
    atomicModifyIORef IORef [(Text, Worth Text)]
    cfgPaths (([(Text, Worth Text)] -> ([(Text, Worth Text)], ())) -> IO ())
    -> ([(Text, Worth Text)] -> ([(Text, Worth Text)], ())) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \[(Text, Worth Text)]
    prev -> ([(Text, Worth Text)]
    prev [(Text, Worth Text)]
    -> [(Text, Worth Text)] -> [(Text, Worth Text)]
    forall a. [a] -> [a] -> [a]
    ++ [(Text, Worth Text)]
    paths, ())
      BaseConfig -> IO ()
    reloadBase BaseConfig
    cfg

    -- | Defaults for automatic 'Config' reloading when using
    -- 'autoReload'.  The 'interval' is one second, while the 'onError'
    -- action ignores its argument and does nothing.
    autoConfig :: AutoConfig
    autoConfig :: AutoConfig
    autoConfig = AutoConfig {
                   interval :: Int
    interval = Int
    1
                 , onError :: SomeException -> IO ()
    onError = IO () -> SomeException -> IO ()
    forall a b. a -> b -> a
    const (IO () -> SomeException -> IO ())
    -> IO () -> SomeException -> IO ()
    forall a b. (a -> b) -> a -> b
    $ () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                 }

    -- | Load a 'Config' from the given 'FilePath's, and start a reload
    -- thread.
    --
    -- At intervals, a thread checks for modifications to both the
    -- original files and any files they refer to in @import@ directives,
    -- and reloads the 'Config' if any files have been modified.
    --
    -- If the initial attempt to load the configuration files fails, an
    -- exception is thrown.  If the initial load succeeds, but a
    -- subsequent attempt fails, the 'onError' handler is invoked.
    --
    -- File names have any environment variables expanded prior to the
    -- first time they are opened, so you can specify a file name such as
    -- @\"$(HOME)/myapp.cfg\"@.
    autoReload :: AutoConfig
               -- ^ Directions for when to reload and how to handle
               -- errors.
               -> [Worth FilePath]
               -- ^ Configuration files to load.
               -> IO (Config, ThreadId)
    autoReload :: AutoConfig -> [Worth String] -> IO (Config, ThreadId)
    autoReload AutoConfig
    auto [Worth String]
    paths = AutoConfig -> [(Text, Worth String)] -> IO (Config, ThreadId)
    autoReloadGroups AutoConfig
    auto ((Worth String -> (Text, Worth String))
    -> [Worth String] -> [(Text, Worth String)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\Worth String
    x -> (Text
    "", Worth String
    x)) [Worth String]
    paths)

    autoReloadGroups :: AutoConfig
                     -> [(Name, Worth FilePath)]
                     -> IO (Config, ThreadId)
    autoReloadGroups :: AutoConfig -> [(Text, Worth String)] -> IO (Config, ThreadId)
    autoReloadGroups AutoConfig{Int
    SomeException -> IO ()
    interval :: AutoConfig -> Int
    onError :: AutoConfig -> SomeException -> IO ()
    interval :: Int
    onError :: SomeException -> IO ()
    ..} [(Text, Worth String)]
    _
        | Int
    interval Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    1    = String -> IO (Config, ThreadId)
    forall a. HasCallStack => String -> a
    error String
    "autoReload: negative interval"
    autoReloadGroups AutoConfig
    _ [] = String -> IO (Config, ThreadId)
    forall a. HasCallStack => String -> a
    error String
    "autoReload: no paths to load"
    autoReloadGroups auto :: AutoConfig
    auto@AutoConfig{Int
    SomeException -> IO ()
    interval :: AutoConfig -> Int
    onError :: AutoConfig -> SomeException -> IO ()
    interval :: Int
    onError :: SomeException -> IO ()
    ..} [(Text, Worth String)]
    paths = do
      cfg <- Maybe AutoConfig -> [(Text, Worth String)] -> IO BaseConfig
    load' (AutoConfig -> Maybe AutoConfig
    forall a. a -> Maybe a
    Just AutoConfig
    auto) [(Text, Worth String)]
    paths
      let files = ((Text, Worth String) -> Worth String)
    -> [(Text, Worth String)] -> [Worth String]
    forall a b. (a -> b) -> [a] -> [b]
    map (Text, Worth String) -> Worth String
    forall a b. (a, b) -> b
    snd [(Text, Worth String)]
    paths
          loop [Maybe Meta]
    meta = do
            Int -> IO ()
    threadDelay (Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    interval Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    1000000)
            meta' <- [Worth String] -> IO [Maybe Meta]
    getMeta [Worth String]
    files
            if meta' == meta
              then loop meta
              else (reloadBase cfg `E.catch` onError) >> loop meta'
      tid <- forkIO $ loop =<< getMeta files
      return (Config "" cfg, tid)

    -- | Save both a file's size and its last modification date, so we
    -- have a better chance of detecting a modification on a crappy
    -- filesystem with timestamp resolution of 1 second or worse.
    type Meta = (FileOffset, EpochTime)

    getMeta :: [Worth FilePath] -> IO [Maybe Meta]
    getMeta :: [Worth String] -> IO [Maybe Meta]
    getMeta [Worth String]
    paths = [Worth String]
    -> (Worth String -> IO (Maybe Meta)) -> IO [Maybe Meta]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM [Worth String]
    paths ((Worth String -> IO (Maybe Meta)) -> IO [Maybe Meta])
    -> (Worth String -> IO (Maybe Meta)) -> IO [Maybe Meta]
    forall a b. (a -> b) -> a -> b
    $ \Worth String
    path ->
       (SomeException -> IO (Maybe Meta))
    -> IO (Maybe Meta) -> IO (Maybe Meta)
    forall e a. Exception e => (e -> IO a) -> IO a -> IO a
    handle (\(SomeException
    _::SomeException) -> Maybe Meta -> IO (Maybe Meta)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Meta
    forall a. Maybe a
    Nothing) (IO (Maybe Meta) -> IO (Maybe Meta))
    -> (IO Meta -> IO (Maybe Meta)) -> IO Meta -> IO (Maybe Meta)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Meta -> Maybe Meta) -> IO Meta -> IO (Maybe Meta)
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Meta -> Maybe Meta
    forall a. a -> Maybe a
    Just (IO Meta -> IO (Maybe Meta)) -> IO Meta -> IO (Maybe Meta)
    forall a b. (a -> b) -> a -> b
    $ do
         st <- String -> IO FileStatus
    getFileStatus (Worth String -> String
    forall a. Worth a -> a
    worth Worth String
    path)
         return (fileSize st, modificationTime st)

    -- | Look up a name in the given 'Config'.  If a binding exists, and
    -- the value can be 'convert'ed to the desired type, return the
    -- converted value, otherwise 'Nothing'.
    lookup :: Configured a => Config -> Name -> IO (Maybe a)
    lookup :: forall a. Configured a => Config -> Text -> IO (Maybe a)
    lookup (Config Text
    root BaseConfig{Maybe AutoConfig
    IORef [(Text, Worth Text)]
    IORef (HashMap Text Value)
    IORef (HashMap Pattern [ChangeHandler])
    cfgAuto :: BaseConfig -> Maybe AutoConfig
    cfgPaths :: BaseConfig -> IORef [(Text, Worth Text)]
    cfgMap :: BaseConfig -> IORef (HashMap Text Value)
    cfgSubs :: BaseConfig -> IORef (HashMap Pattern [ChangeHandler])
    cfgAuto :: Maybe AutoConfig
    cfgPaths :: IORef [(Text, Worth Text)]
    cfgMap :: IORef (HashMap Text Value)
    cfgSubs :: IORef (HashMap Pattern [ChangeHandler])
    ..}) Text
    name =
        (Maybe (Maybe a) -> Maybe a
    forall (m :: * -> *) a. Monad m => m (m a) -> m a
    join (Maybe (Maybe a) -> Maybe a)
    -> (HashMap Text Value -> Maybe (Maybe a))
    -> HashMap Text Value
    -> Maybe a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Value -> Maybe a) -> Maybe Value -> Maybe (Maybe a)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Value -> Maybe a
    forall a. Configured a => Value -> Maybe a
    convert (Maybe Value -> Maybe (Maybe a))
    -> (HashMap Text Value -> Maybe Value)
    -> HashMap Text Value
    -> Maybe (Maybe a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> HashMap Text Value -> Maybe Value
    forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
    H.lookup (Text
    root Text -> Text -> Text
    `T.append` Text
    name)) (HashMap Text Value -> Maybe a)
    -> IO (HashMap Text Value) -> IO (Maybe a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IORef (HashMap Text Value) -> IO (HashMap Text Value)
    forall a. IORef a -> IO a
    readIORef IORef (HashMap Text Value)
    cfgMap

    -- | Look up a name in the given 'Config'.  If a binding exists, and
    -- the value can be 'convert'ed to the desired type, return the
    -- converted value, otherwise throw a 'KeyError'.
    require :: Configured a => Config -> Name -> IO a
    require :: forall a. Configured a => Config -> Text -> IO a
    require Config
    cfg Text
    name = do
      val <- Config -> Text -> IO (Maybe a)
    forall a. Configured a => Config -> Text -> IO (Maybe a)
    lookup Config
    cfg Text
    name
      case val of
        Just a
    v -> a -> IO a
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    v
        Maybe a
    _      -> KeyError -> IO a
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO (KeyError -> IO a) -> (Text -> KeyError) -> Text -> IO a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> KeyError
    KeyError (Text -> IO a) -> Text -> IO a
    forall a b. (a -> b) -> a -> b
    $ Text
    name

    -- | Look up a name in the given 'Config'.  If a binding exists, and
    -- the value can be converted to the desired type, return it,
    -- otherwise return the default value.
    lookupDefault :: Configured a =>
                     a
                  -- ^ Default value to return if 'lookup' or 'convert'
                  -- fails.
                  -> Config -> Name -> IO a
    lookupDefault :: forall a. Configured a => a -> Config -> Text -> IO a
    lookupDefault a
    def Config
    cfg Text
    name = a -> Maybe a -> a
    forall a. a -> Maybe a -> a
    fromMaybe a
    def (Maybe a -> a) -> IO (Maybe a) -> IO a
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Config -> Text -> IO (Maybe a)
    forall a. Configured a => Config -> Text -> IO (Maybe a)
    lookup Config
    cfg Text
    name

    -- | Perform a simple dump of a 'Config' to @stdout@.
    display :: Config -> IO ()
    display :: Config -> IO ()
    display (Config Text
    root BaseConfig{Maybe AutoConfig
    IORef [(Text, Worth Text)]
    IORef (HashMap Text Value)
    IORef (HashMap Pattern [ChangeHandler])
    cfgAuto :: BaseConfig -> Maybe AutoConfig
    cfgPaths :: BaseConfig -> IORef [(Text, Worth Text)]
    cfgMap :: BaseConfig -> IORef (HashMap Text Value)
    cfgSubs :: BaseConfig -> IORef (HashMap Pattern [ChangeHandler])
    cfgAuto :: Maybe AutoConfig
    cfgPaths :: IORef [(Text, Worth Text)]
    cfgMap :: IORef (HashMap Text Value)
    cfgSubs :: IORef (HashMap Pattern [ChangeHandler])
    ..}) = (Text, HashMap Text Value) -> IO ()
    forall a. Show a => a -> IO ()
    print ((Text, HashMap Text Value) -> IO ())
    -> (HashMap Text Value -> (Text, HashMap Text Value))
    -> HashMap Text Value
    -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Text
    root,) (HashMap Text Value -> IO ()) -> IO (HashMap Text Value) -> IO ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< IORef (HashMap Text Value) -> IO (HashMap Text Value)
    forall a. IORef a -> IO a
    readIORef IORef (HashMap Text Value)
    cfgMap

    -- | Fetch the 'H.HashMap' that maps names to values.
    getMap :: Config -> IO (H.HashMap Name Value)
    getMap :: Config -> IO (HashMap Text Value)
    getMap = IORef (HashMap Text Value) -> IO (HashMap Text Value)
    forall a. IORef a -> IO a
    readIORef (IORef (HashMap Text Value) -> IO (HashMap Text Value))
    -> (Config -> IORef (HashMap Text Value))
    -> Config
    -> IO (HashMap Text Value)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . BaseConfig -> IORef (HashMap Text Value)
    cfgMap (BaseConfig -> IORef (HashMap Text Value))
    -> (Config -> BaseConfig) -> Config -> IORef (HashMap Text Value)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Config -> BaseConfig
    baseCfg

    flatten :: [(Name, Worth Path)]
            -> H.HashMap (Worth Path) [Directive]
            -> IO (H.HashMap Name Value)
    flatten :: [(Text, Worth Text)]
    -> HashMap (Worth Text) [Directive] -> IO (HashMap Text Value)
    flatten [(Text, Worth Text)]
    roots HashMap (Worth Text) [Directive]
    files = (HashMap Text Value
     -> (Text, Worth Text) -> IO (HashMap Text Value))
    -> HashMap Text Value
    -> [(Text, Worth Text)]
    -> IO (HashMap Text Value)
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM HashMap Text Value -> (Text, Worth Text) -> IO (HashMap Text Value)
    doPath HashMap Text Value
    forall k v. HashMap k v
    H.empty [(Text, Worth Text)]
    roots
     where
      doPath :: HashMap Text Value -> (Text, Worth Text) -> IO (HashMap Text Value)
    doPath HashMap Text Value
    m (Text
    pfx, Worth Text
    f) = case Worth Text -> HashMap (Worth Text) [Directive] -> Maybe [Directive]
    forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
    H.lookup Worth Text
    f HashMap (Worth Text) [Directive]
    files of
            Maybe [Directive]
    Nothing -> HashMap Text Value -> IO (HashMap Text Value)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return HashMap Text Value
    m
            Just [Directive]
    ds -> (HashMap Text Value -> Directive -> IO (HashMap Text Value))
    -> HashMap Text Value -> [Directive] -> IO (HashMap Text Value)
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM (Text
    -> Text
    -> HashMap Text Value
    -> Directive
    -> IO (HashMap Text Value)
    directive Text
    pfx (Worth Text -> Text
    forall a. Worth a -> a
    worth Worth Text
    f)) HashMap Text Value
    m [Directive]
    ds

      directive :: Text
    -> Text
    -> HashMap Text Value
    -> Directive
    -> IO (HashMap Text Value)
    directive Text
    pfx Text
    _ HashMap Text Value
    m (Bind Text
    name (String Text
    value)) = do
          v <- Text -> Text -> HashMap Text Value -> IO Text
    interpolate Text
    pfx Text
    value HashMap Text Value
    m
          return $! H.insert (T.append pfx name) (String v) m
      directive Text
    pfx Text
    _ HashMap Text Value
    m (Bind Text
    name Value
    value) =
          HashMap Text Value -> IO (HashMap Text Value)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HashMap Text Value -> IO (HashMap Text Value))
    -> HashMap Text Value -> IO (HashMap Text Value)
    forall a b. (a -> b) -> a -> b
    $! Text -> Value -> HashMap Text Value -> HashMap Text Value
    forall k v.
    (Eq k, Hashable k) =>
    k -> v -> HashMap k v -> HashMap k v
    H.insert (Text -> Text -> Text
    T.append Text
    pfx Text
    name) Value
    value HashMap Text Value
    m
      directive Text
    pfx Text
    f HashMap Text Value
    m (Group Text
    name [Directive]
    xs) = (HashMap Text Value -> Directive -> IO (HashMap Text Value))
    -> HashMap Text Value -> [Directive] -> IO (HashMap Text Value)
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM (Text
    -> Text
    -> HashMap Text Value
    -> Directive
    -> IO (HashMap Text Value)
    directive Text
    pfx' Text
    f) HashMap Text Value
    m [Directive]
    xs
          where pfx' :: Text
    pfx' = [Text] -> Text
    T.concat [Text
    pfx, Text
    name, Text
    "."]
      directive Text
    pfx Text
    f HashMap Text Value
    m (Import Text
    path) =
          let f' :: Text
    f' = Text -> Text -> Text
    relativize Text
    f Text
    path
          in  case Worth Text -> HashMap (Worth Text) [Directive] -> Maybe [Directive]
    forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
    H.lookup (Text -> Worth Text
    forall {b}. b -> Worth b
    Required (Text -> Text -> Text
    relativize Text
    f Text
    path)) HashMap (Worth Text) [Directive]
    files of
                Just [Directive]
    ds -> (HashMap Text Value -> Directive -> IO (HashMap Text Value))
    -> HashMap Text Value -> [Directive] -> IO (HashMap Text Value)
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM (Text
    -> Text
    -> HashMap Text Value
    -> Directive
    -> IO (HashMap Text Value)
    directive Text
    pfx Text
    f') HashMap Text Value
    m [Directive]
    ds
                Maybe [Directive]
    _       -> HashMap Text Value -> IO (HashMap Text Value)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return HashMap Text Value
    m

    interpolate :: T.Text -> T.Text -> H.HashMap Name Value -> IO T.Text
    interpolate :: Text -> Text -> HashMap Text Value -> IO Text
    interpolate Text
    pfx Text
    s HashMap Text Value
    env
        | Text
    "$" Text -> Text -> Bool
    `T.isInfixOf` Text
    s =
          case Parser [Interpolate] -> Text -> Either String [Interpolate]
    forall a. Parser a -> Text -> Either String a
    T.parseOnly Parser [Interpolate]
    interp Text
    s of
            Left String
    err   -> ConfigError -> IO Text
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO (ConfigError -> IO Text) -> ConfigError -> IO Text
    forall a b. (a -> b) -> a -> b
    $ String -> String -> ConfigError
    ParseError String
    "" String
    err
            Right [Interpolate]
    xs -> (LazyText -> Text
    L.toStrict (LazyText -> Text) -> ([Builder] -> LazyText) -> [Builder] -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Builder -> LazyText
    toLazyText (Builder -> LazyText)
    -> ([Builder] -> Builder) -> [Builder] -> LazyText
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Builder] -> Builder
    forall a. Monoid a => [a] -> a
    mconcat) ([Builder] -> Text) -> IO [Builder] -> IO Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Interpolate -> IO Builder) -> [Interpolate] -> IO [Builder]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Interpolate -> IO Builder
    interpret [Interpolate]
    xs
        | Bool
    otherwise = Text -> IO Text
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Text
    s
     where
      lookupEnv :: Text -> Maybe Value
    lookupEnv Text
    name = [Maybe Value] -> Maybe Value
    forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, MonadPlus m) =>
    t (m a) -> m a
    msum ([Maybe Value] -> Maybe Value) -> [Maybe Value] -> Maybe Value
    forall a b. (a -> b) -> a -> b
    $ (Text -> Maybe Value) -> [Text] -> [Maybe Value]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Text -> HashMap Text Value -> Maybe Value)
    -> HashMap Text Value -> Text -> Maybe Value
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Text -> HashMap Text Value -> Maybe Value
    forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
    H.lookup HashMap Text Value
    env) [Text]
    fullnames
        where fullnames :: [Text]
    fullnames = ([Text] -> Text) -> [[Text]] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map (Text -> [Text] -> Text
    T.intercalate Text
    ".")     -- ["a.b.c.x","a.b.x","a.x","x"]
                        ([[Text]] -> [Text]) -> (Text -> [[Text]]) -> Text -> [Text]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([Text] -> [Text]) -> [[Text]] -> [[Text]]
    forall a b. (a -> b) -> [a] -> [b]
    map ([Text] -> [Text]
    forall a. [a] -> [a]
    reverse ([Text] -> [Text]) -> ([Text] -> [Text]) -> [Text] -> [Text]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Text
    nameText -> [Text] -> [Text]
    forall a. a -> [a] -> [a]
    :)) -- [["a","b","c","x"],["a","b","x"],["a","x"],["x"]]
                        ([[Text]] -> [[Text]]) -> (Text -> [[Text]]) -> Text -> [[Text]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Text] -> [[Text]]
    forall a. [a] -> [[a]]
    tails                   -- [["c","b","a"],["b","a"],["a"],[]]
                        ([Text] -> [[Text]]) -> (Text -> [Text]) -> Text -> [[Text]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Text] -> [Text]
    forall a. [a] -> [a]
    reverse                 -- ["c","b","a"]
                        ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Text -> Bool) -> [Text] -> [Text]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Bool
    T.null)   -- ["a","b","c"]
                        ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> Text -> [Text]
    T.split (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Char
    '.')         -- ["a","b","c",""]
                        (Text -> [Text]) -> Text -> [Text]
    forall a b. (a -> b) -> a -> b
    $ Text
    pfx                     -- "a.b.c."

      interpret :: Interpolate -> IO Builder
    interpret (Literal Text
    x)   = Builder -> IO Builder
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Text -> Builder
    fromText Text
    x)
      interpret (Interpolate Text
    name) =
          case Text -> Maybe Value
    lookupEnv Text
    name of
            Just (String Text
    x) -> Builder -> IO Builder
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Text -> Builder
    fromText Text
    x)
            Just (Number Rational
    r)
                | Rational -> Integer
    forall a. Ratio a -> a
    denominator Rational
    r Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    == Integer
    1 -> Builder -> IO Builder
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Integer -> Builder
    forall a. Integral a => a -> Builder
    decimal (Integer -> Builder) -> Integer -> Builder
    forall a b. (a -> b) -> a -> b
    $ Rational -> Integer
    forall a. Ratio a -> a
    numerator Rational
    r)
                | Bool
    otherwise -> Builder -> IO Builder
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Builder -> IO Builder) -> Builder -> IO Builder
    forall a b. (a -> b) -> a -> b
    $ Double -> Builder
    forall a. RealFloat a => a -> Builder
    realFloat (Rational -> Double
    forall a. Fractional a => Rational -> a
    fromRational Rational
    r :: Double)
                               -- TODO: Use a dedicated Builder for Rationals instead of
                               -- using realFloat on a Double.
            Just Value
    _          -> String -> IO Builder
    forall a. HasCallStack => String -> a
    error String
    "type error"
            Maybe Value
    _ -> do
              e <- IO String -> IO (Either SomeException String)
    forall e a. Exception e => IO a -> IO (Either e a)
    try (IO String -> IO (Either SomeException String))
    -> (Text -> IO String) -> Text -> IO (Either SomeException String)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> IO String
    getEnv (String -> IO String) -> (Text -> String) -> Text -> IO String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> String
    T.unpack (Text -> IO (Either SomeException String))
    -> Text -> IO (Either SomeException String)
    forall a b. (a -> b) -> a -> b
    $ Text
    name
              case e of
                Left (SomeException
    _::SomeException) ->
                    ConfigError -> IO Builder
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO (ConfigError -> IO Builder)
    -> (String -> ConfigError) -> String -> IO Builder
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> ConfigError
    ParseError String
    "" (String -> IO Builder) -> String -> IO Builder
    forall a b. (a -> b) -> a -> b
    $ String
    "no such variable " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Text -> String
    forall a. Show a => a -> String
    show Text
    name
                Right String
    x -> Builder -> IO Builder
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> Builder
    fromString String
    x)

    importsOf :: Path -> [Directive] -> [Worth Path]
    importsOf :: Text -> [Directive] -> [Worth Text]
    importsOf Text
    path (Import Text
    ref : [Directive]
    xs) = Text -> Worth Text
    forall {b}. b -> Worth b
    Required (Text -> Text -> Text
    relativize Text
    path Text
    ref)
                                     Worth Text -> [Worth Text] -> [Worth Text]
    forall a. a -> [a] -> [a]
    : Text -> [Directive] -> [Worth Text]
    importsOf Text
    path [Directive]
    xs
    importsOf Text
    path (Group Text
    _ [Directive]
    ys : [Directive]
    xs) = Text -> [Directive] -> [Worth Text]
    importsOf Text
    path [Directive]
    ys [Worth Text] -> [Worth Text] -> [Worth Text]
    forall a. [a] -> [a] -> [a]
    ++ Text -> [Directive] -> [Worth Text]
    importsOf Text
    path [Directive]
    xs
    importsOf Text
    path (Directive
    _ : [Directive]
    xs)          = Text -> [Directive] -> [Worth Text]
    importsOf Text
    path [Directive]
    xs
    importsOf Text
    _    [Directive]
    _                 = []

    relativize :: Path -> Path -> Path
    relativize :: Text -> Text -> Text
    relativize Text
    parent Text
    child
      | HasCallStack => Text -> Char
    Text -> Char
    T.head Text
    child Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '/' = Text
    child
      | Bool
    otherwise           = (Text, Text) -> Text
    forall a b. (a, b) -> a
    fst (HasCallStack => Text -> Text -> (Text, Text)
    Text -> Text -> (Text, Text)
    T.breakOnEnd Text
    "/" Text
    parent) Text -> Text -> Text
    `T.append` Text
    child

    loadOne :: Worth FilePath -> IO [Directive]
    loadOne :: Worth String -> IO [Directive]
    loadOne Worth String
    path = do
      es <- IO LazyText -> IO (Either SomeException LazyText)
    forall e a. Exception e => IO a -> IO (Either e a)
    try (IO LazyText -> IO (Either SomeException LazyText))
    -> (Worth String -> IO LazyText)
    -> Worth String
    -> IO (Either SomeException LazyText)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> IO LazyText
    L.readFile (String -> IO LazyText)
    -> (Worth String -> String) -> Worth String -> IO LazyText
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Worth String -> String
    forall a. Worth a -> a
    worth (Worth String -> IO (Either SomeException LazyText))
    -> Worth String -> IO (Either SomeException LazyText)
    forall a b. (a -> b) -> a -> b
    $ Worth String
    path
      case es of
        Left (SomeException
    err::SomeException) -> case Worth String
    path of
                                       Required String
    _ -> SomeException -> IO [Directive]
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO SomeException
    err
                                       Worth String
    _          -> [Directive] -> IO [Directive]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
        Right LazyText
    s -> do
                p <- Either String [Directive] -> IO (Either String [Directive])
    forall a. a -> IO a
    evaluate (Result [Directive] -> Either String [Directive]
    forall r. Result r -> Either String r
    L.eitherResult (Result [Directive] -> Either String [Directive])
    -> Result [Directive] -> Either String [Directive]
    forall a b. (a -> b) -> a -> b
    $ Parser [Directive] -> LazyText -> Result [Directive]
    forall a. Parser a -> LazyText -> Result a
    L.parse Parser [Directive]
    topLevel LazyText
    s)
                     IO (Either String [Directive])
    -> (ConfigError -> IO (Either String [Directive]))
    -> IO (Either String [Directive])
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `E.catch` \(ConfigError
    e::ConfigError) ->
                     ConfigError -> IO (Either String [Directive])
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO (ConfigError -> IO (Either String [Directive]))
    -> ConfigError -> IO (Either String [Directive])
    forall a b. (a -> b) -> a -> b
    $ case ConfigError
    e of
                                 ParseError String
    _ String
    err -> String -> String -> ConfigError
    ParseError (Worth String -> String
    forall a. Worth a -> a
    worth Worth String
    path) String
    err
                case p of
                  Left String
    err -> ConfigError -> IO [Directive]
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO (String -> String -> ConfigError
    ParseError (Worth String -> String
    forall a. Worth a -> a
    worth Worth String
    path) String
    err)
                  Right [Directive]
    ds -> [Directive] -> IO [Directive]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Directive]
    ds

    -- | Subscribe for notifications.  The given action will be invoked
    -- when any change occurs to a configuration property matching the
    -- supplied pattern.
    subscribe :: Config -> Pattern -> ChangeHandler -> IO ()
    subscribe :: Config -> Pattern -> ChangeHandler -> IO ()
    subscribe (Config Text
    root BaseConfig{Maybe AutoConfig
    IORef [(Text, Worth Text)]
    IORef (HashMap Text Value)
    IORef (HashMap Pattern [ChangeHandler])
    cfgAuto :: BaseConfig -> Maybe AutoConfig
    cfgPaths :: BaseConfig -> IORef [(Text, Worth Text)]
    cfgMap :: BaseConfig -> IORef (HashMap Text Value)
    cfgSubs :: BaseConfig -> IORef (HashMap Pattern [ChangeHandler])
    cfgAuto :: Maybe AutoConfig
    cfgPaths :: IORef [(Text, Worth Text)]
    cfgMap :: IORef (HashMap Text Value)
    cfgSubs :: IORef (HashMap Pattern [ChangeHandler])
    ..}) Pattern
    pat ChangeHandler
    act = do
      m' <- IORef (HashMap Pattern [ChangeHandler])
    -> (HashMap Pattern [ChangeHandler]
        -> (HashMap Pattern [ChangeHandler],
            HashMap Pattern [ChangeHandler]))
    -> IO (HashMap Pattern [ChangeHandler])
    forall a b. IORef a -> (a -> (a, b)) -> IO b
    atomicModifyIORef IORef (HashMap Pattern [ChangeHandler])
    cfgSubs ((HashMap Pattern [ChangeHandler]
      -> (HashMap Pattern [ChangeHandler],
          HashMap Pattern [ChangeHandler]))
     -> IO (HashMap Pattern [ChangeHandler]))
    -> (HashMap Pattern [ChangeHandler]
        -> (HashMap Pattern [ChangeHandler],
            HashMap Pattern [ChangeHandler]))
    -> IO (HashMap Pattern [ChangeHandler])
    forall a b. (a -> b) -> a -> b
    $ \HashMap Pattern [ChangeHandler]
    m ->
            let m' :: HashMap Pattern [ChangeHandler]
    m' = ([ChangeHandler] -> [ChangeHandler] -> [ChangeHandler])
    -> Pattern
    -> [ChangeHandler]
    -> HashMap Pattern [ChangeHandler]
    -> HashMap Pattern [ChangeHandler]
    forall k v.
    (Eq k, Hashable k) =>
    (v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
    H.insertWith [ChangeHandler] -> [ChangeHandler] -> [ChangeHandler]
    forall a. [a] -> [a] -> [a]
    (++) (Text -> Pattern -> Pattern
    localPattern Text
    root Pattern
    pat) [ChangeHandler
    act] HashMap Pattern [ChangeHandler]
    m in (HashMap Pattern [ChangeHandler]
    m', HashMap Pattern [ChangeHandler]
    m')
      evaluate m' >> return ()

    localPattern :: Name -> Pattern -> Pattern
    localPattern :: Text -> Pattern -> Pattern
    localPattern Text
    pfx (Exact  Text
    s) = Text -> Pattern
    Exact  (Text
    pfx Text -> Text -> Text
    `T.append` Text
    s)
    localPattern Text
    pfx (Prefix Text
    s) = Text -> Pattern
    Prefix (Text
    pfx Text -> Text -> Text
    `T.append` Text
    s)

    notifySubscribers :: BaseConfig -> H.HashMap Name Value -> H.HashMap Name Value
                      -> H.HashMap Pattern [ChangeHandler] -> IO ()
    notifySubscribers :: BaseConfig
    -> HashMap Text Value
    -> HashMap Text Value
    -> HashMap Pattern [ChangeHandler]
    -> IO ()
    notifySubscribers BaseConfig{Maybe AutoConfig
    IORef [(Text, Worth Text)]
    IORef (HashMap Text Value)
    IORef (HashMap Pattern [ChangeHandler])
    cfgAuto :: BaseConfig -> Maybe AutoConfig
    cfgPaths :: BaseConfig -> IORef [(Text, Worth Text)]
    cfgMap :: BaseConfig -> IORef (HashMap Text Value)
    cfgSubs :: BaseConfig -> IORef (HashMap Pattern [ChangeHandler])
    cfgAuto :: Maybe AutoConfig
    cfgPaths :: IORef [(Text, Worth Text)]
    cfgMap :: IORef (HashMap Text Value)
    cfgSubs :: IORef (HashMap Pattern [ChangeHandler])
    ..} HashMap Text Value
    m HashMap Text Value
    m' HashMap Pattern [ChangeHandler]
    subs = (Pattern -> [ChangeHandler] -> IO () -> IO ())
    -> IO () -> HashMap Pattern [ChangeHandler] -> IO ()
    forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
    H.foldrWithKey Pattern -> [ChangeHandler] -> IO () -> IO ()
    forall {t :: * -> *} {b}.
    Foldable t =>
    Pattern -> t ChangeHandler -> IO b -> IO b
    go (() -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()) HashMap Pattern [ChangeHandler]
    subs
     where
      changedOrGone :: [(Text, Maybe Value)]
    changedOrGone = (Text -> Value -> [(Text, Maybe Value)] -> [(Text, Maybe Value)])
    -> [(Text, Maybe Value)]
    -> HashMap Text Value
    -> [(Text, Maybe Value)]
    forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
    H.foldrWithKey Text -> Value -> [(Text, Maybe Value)] -> [(Text, Maybe Value)]
    check [] HashMap Text Value
    m
          where check :: Text -> Value -> [(Text, Maybe Value)] -> [(Text, Maybe Value)]
    check Text
    n Value
    v [(Text, Maybe Value)]
    nvs = case Text -> HashMap Text Value -> Maybe Value
    forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
    H.lookup Text
    n HashMap Text Value
    m' of
                                  Just Value
    v' | Value
    v Value -> Value -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Value
    v'   -> (Text
    n,Value -> Maybe Value
    forall a. a -> Maybe a
    Just Value
    v')(Text, Maybe Value)
    -> [(Text, Maybe Value)] -> [(Text, Maybe Value)]
    forall a. a -> [a] -> [a]
    :[(Text, Maybe Value)]
    nvs
                                          | Bool
    otherwise -> [(Text, Maybe Value)]
    nvs
                                  Maybe Value
    _                   -> (Text
    n,Maybe Value
    forall a. Maybe a
    Nothing)(Text, Maybe Value)
    -> [(Text, Maybe Value)] -> [(Text, Maybe Value)]
    forall a. a -> [a] -> [a]
    :[(Text, Maybe Value)]
    nvs
      new :: [(Text, Value)]
    new = (Text -> Value -> [(Text, Value)] -> [(Text, Value)])
    -> [(Text, Value)] -> HashMap Text Value -> [(Text, Value)]
    forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
    H.foldrWithKey Text -> Value -> [(Text, Value)] -> [(Text, Value)]
    forall {b}. Text -> b -> [(Text, b)] -> [(Text, b)]
    check [] HashMap Text Value
    m'
          where check :: Text -> b -> [(Text, b)] -> [(Text, b)]
    check Text
    n b
    v [(Text, b)]
    nvs = case Text -> HashMap Text Value -> Maybe Value
    forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
    H.lookup Text
    n HashMap Text Value
    m of
                                  Maybe Value
    Nothing -> (Text
    n,b
    v)(Text, b) -> [(Text, b)] -> [(Text, b)]
    forall a. a -> [a] -> [a]
    :[(Text, b)]
    nvs
                                  Maybe Value
    _       -> [(Text, b)]
    nvs
      notify :: p -> t -> t -> (t -> t -> IO ()) -> IO ()
    notify p
    p t
    n t
    v t -> t -> IO ()
    a = t -> t -> IO ()
    a t
    n t
    v IO () -> (SomeException -> IO ()) -> IO ()
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `E.catch` (SomeException -> IO ())
    -> (AutoConfig -> SomeException -> IO ())
    -> Maybe AutoConfig
    -> SomeException
    -> IO ()
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe SomeException -> IO ()
    forall a. Show a => a -> IO ()
    report AutoConfig -> SomeException -> IO ()
    onError Maybe AutoConfig
    cfgAuto
        where report :: a -> IO ()
    report a
    e = Handle -> String -> IO ()
    hPutStrLn Handle
    stderr (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                         String
    "*** a ChangeHandler threw an exception for " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                         (p, t) -> String
    forall a. Show a => a -> String
    show (p
    p,t
    n) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ": " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ a -> String
    forall a. Show a => a -> String
    show a
    e
      go :: Pattern -> t ChangeHandler -> IO b -> IO b
    go p :: Pattern
    p@(Exact Text
    n) t ChangeHandler
    acts IO b
    next = (IO b -> () -> IO b
    forall a b. a -> b -> a
    const IO b
    next (() -> IO b) -> IO () -> IO b
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<<) (IO () -> IO b) -> IO () -> IO b
    forall a b. (a -> b) -> a -> b
    $ do
        let v' :: Maybe Value
    v' = Text -> HashMap Text Value -> Maybe Value
    forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
    H.lookup Text
    n HashMap Text Value
    m'
        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Text -> HashMap Text Value -> Maybe Value
    forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
    H.lookup Text
    n HashMap Text Value
    m Maybe Value -> Maybe Value -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Maybe Value
    v') (IO () -> IO ())
    -> (t ChangeHandler -> IO ()) -> t ChangeHandler -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ChangeHandler -> IO ()) -> t ChangeHandler -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Pattern -> Text -> Maybe Value -> ChangeHandler -> IO ()
    forall {p} {t} {t}.
    (Show p, Show t) =>
    p -> t -> t -> (t -> t -> IO ()) -> IO ()
    notify Pattern
    p Text
    n Maybe Value
    v') (t ChangeHandler -> IO ()) -> t ChangeHandler -> IO ()
    forall a b. (a -> b) -> a -> b
    $ t ChangeHandler
    acts
      go p :: Pattern
    p@(Prefix Text
    n) t ChangeHandler
    acts IO b
    next = (IO b -> () -> IO b
    forall a b. a -> b -> a
    const IO b
    next (() -> IO b) -> IO () -> IO b
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<<) (IO () -> IO b) -> IO () -> IO b
    forall a b. (a -> b) -> a -> b
    $ do
        let matching :: [(Text, b)] -> [(Text, b)]
    matching = ((Text, b) -> Bool) -> [(Text, b)] -> [(Text, b)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Text -> Text -> Bool
    T.isPrefixOf Text
    n (Text -> Bool) -> ((Text, b) -> Text) -> (Text, b) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Text, b) -> Text
    forall a b. (a, b) -> a
    fst)
        [(Text, Value)] -> ((Text, Value) -> IO ()) -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ ([(Text, Value)] -> [(Text, Value)]
    forall {b}. [(Text, b)] -> [(Text, b)]
    matching [(Text, Value)]
    new) (((Text, Value) -> IO ()) -> IO ())
    -> ((Text, Value) -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \(Text
    n',Value
    v) -> (ChangeHandler -> IO ()) -> t ChangeHandler -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Pattern -> Text -> Maybe Value -> ChangeHandler -> IO ()
    forall {p} {t} {t}.
    (Show p, Show t) =>
    p -> t -> t -> (t -> t -> IO ()) -> IO ()
    notify Pattern
    p Text
    n' (Value -> Maybe Value
    forall a. a -> Maybe a
    Just Value
    v)) t ChangeHandler
    acts
        [(Text, Maybe Value)] -> ((Text, Maybe Value) -> IO ()) -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ ([(Text, Maybe Value)] -> [(Text, Maybe Value)]
    forall {b}. [(Text, b)] -> [(Text, b)]
    matching [(Text, Maybe Value)]
    changedOrGone) (((Text, Maybe Value) -> IO ()) -> IO ())
    -> ((Text, Maybe Value) -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \(Text
    n',Maybe Value
    v) -> (ChangeHandler -> IO ()) -> t ChangeHandler -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Pattern -> Text -> Maybe Value -> ChangeHandler -> IO ()
    forall {p} {t} {t}.
    (Show p, Show t) =>
    p -> t -> t -> (t -> t -> IO ()) -> IO ()
    notify Pattern
    p Text
    n' Maybe Value
    v) t ChangeHandler
    acts

    -- | A completely empty configuration.
    empty :: Config
    empty :: Config
    empty = Text -> BaseConfig -> Config
    Config Text
    "" (BaseConfig -> Config) -> BaseConfig -> Config
    forall a b. (a -> b) -> a -> b
    $ IO BaseConfig -> BaseConfig
    forall a. IO a -> a
    unsafePerformIO (IO BaseConfig -> BaseConfig) -> IO BaseConfig -> BaseConfig
    forall a b. (a -> b) -> a -> b
    $ do
              p <- [(Text, Worth Text)] -> IO (IORef [(Text, Worth Text)])
    forall a. a -> IO (IORef a)
    newIORef []
              m <- newIORef H.empty
              s <- newIORef H.empty
              return BaseConfig {
                           cfgAuto = Nothing
                         , cfgPaths = p
                         , cfgMap = m
                         , cfgSubs = s
                         }
    {-# NOINLINE empty #-}

    -- $format
    --
    -- A configuration file consists of a series of directives and
    -- comments, encoded in UTF-8.  A comment begins with a \"@#@\"
    -- character, and continues to the end of a line.
    --
    -- Files and directives are processed from first to last, top to
    -- bottom.

    -- $binding
    --
    -- A binding associates a name with a value.
    --
    -- > my_string = "hi mom! \u2603"
    -- > your-int-33 = 33
    -- > his_bool = on
    -- > HerList = [1, "foo", off]
    --
    -- A name must begin with a Unicode letter, which is followed by zero
    -- or more of a Unicode alphanumeric code point, hyphen \"@-@\", or
    -- underscore \"@_@\".
    --
    -- Bindings are created or overwritten in the order in which they are
    -- encountered.  It is legitimate for a name to be bound multiple
    -- times, in which case the last value wins.
    --
    -- > a = 1
    -- > a = true
    -- > # value of a is now true, not 1

    -- $types
    --
    -- The configuration file format supports the following data types:
    --
    -- * Booleans, represented as @on@ or @off@, @true@ or @false@.  These
    --   are case sensitive, so do not try to use @True@ instead of
    --   @true@!
    --
    -- * Integers, represented in base 10.
    --
    -- * Unicode strings, represented as text (possibly containing escape
    --   sequences) surrounded by double quotes.
    --
    -- * Heterogeneous lists of values, represented as an opening square
    --   bracket \"@[@\", followed by a series of comma-separated values,
    --   ending with a closing square bracket \"@]@\".
    --
    -- The following escape sequences are recognised in a text string:
    --
    -- * @\\n@ - newline
    --
    -- * @\\r@ - carriage return
    --
    -- * @\\t@ - horizontal tab
    --
    -- * @\\\\@ - backslash
    --
    -- * @\\\"@ - double quote
    --
    -- * @\\u@/xxxx/ - Unicode character from the basic multilingual
    --   plane, encoded as four hexadecimal digits
    --
    -- * @\\u@/xxxx/@\\u@/xxxx/ - Unicode character from an astral plane,
    --   as two hexadecimal-encoded UTF-16 surrogates

    -- $interp
    --
    -- Strings support interpolation, so that you can dynamically
    -- construct a string based on data in your configuration or the OS
    -- environment.
    --
    -- If a string value contains the special sequence \"@$(foo)@\" (for
    -- any name @foo@), then the name @foo@ will be looked up in the
    -- configuration data and its value substituted.  If that name cannot
    -- be found, it will be looked up in the OS environment.
    --
    -- For security reasons, it is an error for a string interpolation
    -- fragment to contain a name that cannot be found in either the
    -- current configuration or the environment.
    --
    -- To represent a single literal \"@$@\" character in a string, double
    -- it: \"@$$@\".

    -- $group
    --
    -- It is possible to group a number of directives together under a
    -- single prefix:
    --
    -- > my-group
    -- > {
    -- >   a = 1
    -- >
    -- >   # groups support nesting
    -- >   nested {
    -- >     b = "yay!"
    -- >   }
    -- > }
    --
    -- The name of a group is used as a prefix for the items in the
    -- group. For instance, the value of \"@a@\" above can be retrieved
    -- using 'lookup' by supplying the name \"@my-group.a@\", and \"@b@\"
    -- will be named \"@my-group.nested.b@\".

    -- $import
    --
    -- To import the contents of another configuration file, use the
    -- @import@ directive.
    --
    -- > import "$(HOME)/etc/myapp.cfg"
    --
    -- Absolute paths are imported as is.  Relative paths are resolved with
    -- respect to the file they are imported from.  It is an error for an
    -- @import@ directive to name a file that does not exist, cannot be read,
    -- or contains errors.
    --
    -- If an @import@ appears inside a group, the group's naming prefix
    -- will be applied to all of the names imported from the given
    -- configuration file.
    --
    -- Supposing we have a file named \"@foo.cfg@\":
    --
    -- > bar = 1
    --
    -- And another file that imports it into a group:
    --
    -- > hi {
    -- >   import "foo.cfg"
    -- > }
    --
    -- This will result in a value named \"@hi.bar@\".

    -- $notify
    --
    -- To more efficiently support an application's need to dynamically
    -- reconfigure, a subsystem may ask to be notified when a
    -- configuration property is changed as a result of a reload, using
    -- the 'subscribe' action.