diff --git a/Data/Configurator.hs b/Data/Configurator.hs index 83d5def..c2e58b8 100644 --- a/Data/Configurator.hs +++ b/Data/Configurator.hs @@ -55,6 +55,16 @@ module Data.Configurator , subconfig , addToConfig , addGroupsToConfig + -- * Generating a new configuration file + -- $output + , emptyConfigFile + , addConfigFileComment + , addConfigFileNewline + , addConfigFileImport + , addConfigFileBind + , addConfigFileGroup + , configFileText + , writeConfigFile -- * Helper functions , display , getMap @@ -85,6 +95,7 @@ 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.IO as T import qualified Data.Text.Lazy as L import qualified Data.Text.Lazy.IO as L @@ -385,6 +396,59 @@ empty = Config "" $ unsafePerformIO $ do , cfgMap = m , cfgSubs = s } + +-- | An empty 'ConfigFile'. +emptyConfigFile :: ConfigFile +emptyConfigFile = [] + +-- | Appends a comment to the 'ConfigFile'. +addConfigFileComment :: T.Text -> ConfigFile -> ConfigFile +addConfigFileComment t f = f ++ [FComment t] + +-- | Appends a newline to the 'ConfigFile'. +addConfigFileNewline :: ConfigFile -> ConfigFile +addConfigFileNewline f = f ++ [FNewline] + +-- | Appends an import directive to the 'ConfigFile'. +addConfigFileImport :: Path -> ConfigFile -> ConfigFile +addConfigFileImport p f = f ++ [FImport p] + +-- | Appends a bind directive to the 'ConfigFile'. +addConfigFileBind :: Name -> T.Text -> ConfigFile -> ConfigFile +addConfigFileBind n v f = f ++ [FBind n v] + +-- | Appends the first 'ConfigFile' as a named group in the second 'ConfigFile'. +addConfigFileGroup :: Name -> ConfigFile -> ConfigFile -> ConfigFile +addConfigFileGroup n sub f = f ++ [FGroup n sub] + +-- TODO: Might want to add more value to addConfigFileBind function by +-- searching for and replacing duplicate bind directives within the +-- same group. + + +(##) :: T.Text -> T.Text -> T.Text +(##) = T.append + +-- hws is shorthand for horizontal white space +fileEntryAsText :: T.Text -> FileEntry -> T.Text +fileEntryAsText hws (FComment c) = hws ## "# " ## c ## "\n" +fileEntryAsText _hws (FNewline) = "\n" +fileEntryAsText hws (FImport p) = hws ## "import \"" ## p ## "\"\n" +fileEntryAsText hws (FBind n v) = hws ## n ## " = " ## v ## "\n" +fileEntryAsText hws (FGroup n f) = + hws ## n ## " {\n" ## + foldl (\acc new -> (##) acc $ fileEntryAsText (hws ## " ") new) T.empty f ## + hws ## "}\n" + +-- | Converts a 'ConfigFile' type to formatted text. +configFileText :: ConfigFile -> T.Text +configFileText [] = T.empty +configFileText conf = foldl (\acc new -> (##) acc $ fileEntryAsText "" new) T.empty conf + +-- | Writes a 'ConfigFile' as a formatted text file at the given 'FilePath'. +writeConfigFile :: FilePath -> ConfigFile -> IO () +writeConfigFile path conf = T.writeFile path $ configFileText conf + {-# NOINLINE empty #-} -- $format @@ -524,3 +588,12 @@ empty = Config "" $ unsafePerformIO $ do -- reconfigure, a subsystem may ask to be notified when a -- configuration property is changed as a result of a reload, using -- the 'subscribe' action. + +-- $output +-- +-- Configuration files can be generated algorithmically and written in +-- the correct format. A 'ConfigFile' is a list of 'FileEntry' +-- members, and as such can be manipulated using standard list +-- functions. Alternatively, the builder functions 'addConfigFileComment', +-- 'addConfigFileBind', etc. may be used. +-- diff --git a/Data/Configurator/Types.hs b/Data/Configurator/Types.hs index 541eb57..07df744 100644 --- a/Data/Configurator/Types.hs +++ b/Data/Configurator/Types.hs @@ -22,6 +22,9 @@ module Data.Configurator.Types -- * Notification of configuration changes , Pattern , ChangeHandler + -- * Types for generating config files + , FileEntry(..) + , ConfigFile ) where import Data.Configurator.Types.Internal diff --git a/Data/Configurator/Types/Internal.hs b/Data/Configurator/Types/Internal.hs index d34a659..f0136ac 100644 --- a/Data/Configurator/Types/Internal.hs +++ b/Data/Configurator/Types/Internal.hs @@ -29,6 +29,8 @@ module Data.Configurator.Types.Internal , exact , prefix , ChangeHandler + , FileEntry(..) + , ConfigFile ) where import Control.Exception @@ -214,3 +216,14 @@ data Value = Bool Bool data Interpolate = Literal Text | Interpolate Text deriving (Eq, Show) + +-- | Single entry of a desired configuration to be written to file. +data FileEntry = FComment Text + | FNewline + | FImport Path + | FBind Name Text + | FGroup Name ConfigFile -- arbitrary grouping + deriving (Eq) + +-- | Representation of a configuration file for writing to disk. +type ConfigFile = [FileEntry] diff --git a/tests/Test.hs b/tests/Test.hs index 05e6791..42c0e23 100644 --- a/tests/Test.hs +++ b/tests/Test.hs @@ -30,7 +30,8 @@ tests = TestList [ "types" ~: typesTest, "interp" ~: interpTest, "import" ~: importTest, - "reload" ~: reloadTest + "reload" ~: reloadTest, + "write" ~: writeTest ] withLoad :: [Worth FilePath] -> (Config -> IO ()) -> IO () @@ -166,3 +167,36 @@ reloadTest = withReload [Required "resources/pathological.cfg"] $ \[Just f] cfg r2 <- takeMVarTimeout 2000 wongly assertEqual "notify not happened" r2 Nothing +testConfig :: ConfigFile +testConfig = + [ FComment "This is a test comment" + , FComment "And here is a new one" + , FNewline + , FImport "pathological.cfg" + , FBind "myBindVar" "\"here's my bind string\"" + , FBind "myInt" "32 # This is a trailing comment as part of a bind" + , FComment "Ok, let's try a group now" + , FGroup "group1" + [ FComment "Starting group 1" + , FBind "group1a" "7" + , FBind "group1b" "90" + , FGroup "group2" + [ FComment "I am nested!" + , FImport "import.cfg" + , FBind "group2a" "\"nested var\"" + ] + , FComment "End the group" + ] + , FNewline + , FComment "A couple more binds for good measure" + , FBind "penultimate" "\"almost\"" + , FBind "final" "\"there\"" + ] + + +writeTest :: Assertion +writeTest = do + writeConfigFile "resources/testoutput.cfg" testConfig + withLoad [Required "resources/testoutput.cfg"] $ \_cfg -> do + assertBool "Failed to load write test file if here" True + diff --git a/tests/configurator-tests.cabal b/tests/configurator-tests.cabal index 6a44803..56934b1 100644 --- a/tests/configurator-tests.cabal +++ b/tests/configurator-tests.cabal @@ -10,7 +10,7 @@ Executable configurator-test directory, HUnit, text, - attoparsec-text, + attoparsec, unordered-containers, unix-compat, hashable,