Commits

Anonymous committed 1ae07f4

Add APIs to put additional files into an existing config.

  • Participants
  • Parent commits b3a927d

Comments (0)

Files changed (2)

File Data/Configurator.hs

     , load
     , loadGroups
     , reload
+    , addToConfig
+    , addGroupsToConfig
     -- * Helper functions
     , display
     , getMap
   let second f (x,y) = (x, f y)
       paths          = map (second (fmap T.pack)) paths0
   ds <- loadFiles (map snd paths)
+  p <- newIORef paths
   m <- newIORef =<< flatten paths ds
   s <- newIORef H.empty
   return Config {
                 cfgAuto = auto
-              , cfgPaths = paths
+              , cfgPaths = p
               , cfgMap = m
               , cfgSubs = s
               }
 -- if files no longer exist or contain errors.
 reload :: Config -> IO ()
 reload cfg@Config{..} = do
-  m' <- flatten cfgPaths =<< loadFiles (map snd cfgPaths)
+  paths <- readIORef cfgPaths
+  m' <- flatten paths =<< loadFiles (map snd paths)
   m <- atomicModifyIORef cfgMap $ \m -> (m', 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 paths0 cfg = addGroupsToConfig (map (\x -> ("",x)) paths0) 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 paths0 cfg@Config{..} = do
+  let second f (x,y) = (x, f y)
+      paths          = map (second (fmap T.pack)) paths0
+  atomicModifyIORef cfgPaths $ \prev -> (prev ++ paths, ())
+  reload cfg
+
 -- | Defaults for automatic 'Config' reloading when using
 -- 'autoReload'.  The 'interval' is one second, while the 'onError'
 -- action ignores its argument and does nothing.
         Nothing -> return m
         Just ds -> foldM (directive pfx (worth f)) m ds
 
-  directive pfx f m (Bind name (String value)) = do
+  directive pfx _ m (Bind name (String value)) = do
       v <- interpolate value m
       return $! H.insert (T.append pfx name) (String v) m
-  directive pfx f m (Bind name value) =
+  directive pfx _ m (Bind name value) =
       return $! H.insert (T.append pfx name) value m
   directive pfx f m (Group name xs) = foldM (directive pfx' f) m xs
       where pfx' = T.concat [pfx, name, "."]
 -- | A completely empty configuration.
 empty :: Config
 empty = unsafePerformIO $ do
+          p <- newIORef []
           m <- newIORef H.empty
           s <- newIORef H.empty
           return Config {
                        cfgAuto = Nothing
-                     , cfgPaths = []
+                     , cfgPaths = p
                      , cfgMap = m
                      , cfgSubs = s
                      }

File Data/Configurator/Types/Internal.hs

 -- | Configuration data.
 data Config = Config {
       cfgAuto :: Maybe AutoConfig
-    , cfgPaths :: [(Name, Worth Path)]
+    , cfgPaths :: IORef [(Name, Worth Path)]
     -- ^ The files from which the 'Config' was loaded.
     , cfgMap :: IORef (H.HashMap Name Value)
     , cfgSubs :: IORef (H.HashMap Pattern [ChangeHandler])