configifier 0.0.3 → 0.0.4

raw patch · 4 files changed

+318/−114 lines, 4 filesdep ~aesondep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: aeson, base

API changes (from Hackage documentation)

Files

• configifier.cabal +13/−13
• examples/Main.hs +65/−20
• src/Data/Configifier.hs +198/−52
• tests/Data/ConfigifierSpec.hs +42/−29

@@ -1,15 +1,7 @@ name:                configifier-version:             0.0.3-synopsis:-    parser for config files, shell variables, command line args.-description:--    WARNING NOT READY FOR USE YET.  JUST PUTTING IT OUT THERE TO HAVE A DISCUSSION.-    .-    Read runtime configuration from files, command line, and shell-    environment in a uniform, canonical, and flexible way.  Inspired-    by, among others, Configurator, cmdargs, optparse-applicative.-+version:             0.0.4+synopsis:            parser for config files, shell variables, command line args.+description:         See <https://github.com/zerobuzz/configifier/blob/master/README.md README> license:             AGPL-3 license-file:        LICENSE author:              Matthias Fischmann <mf@zerobuzz.net>, Andres Löh <andres@well-typed.com>@@ -26,6 +18,9 @@ flag profiling   default: False +flag with-example+  default: False+ library   hs-source-dirs:       src@@ -36,9 +31,9 @@   exposed-modules:       Data.Configifier   build-depends:-      base >=4.7 && <4.8+      base >=4.7 && <5 -    , aeson >=0.8 && <0.9+    , bytestring >=0.10 && <0.11     , case-insensitive >=1.2 && <1.3     , containers >=0.5 && <0.6     , either >=4.3 && <4.4@@ -51,6 +46,11 @@     , yaml >=0.8 && <0.9  executable configifier-example+  if flag(with-example)+    Buildable: True+  else+    Buildable: False+   default-language:       Haskell2010   hs-source-dirs:

@@ -17,7 +17,7 @@ where  import Control.Applicative ((<$>))-import Data.String.Conversions (ST, cs)+import Data.String.Conversions (ST, cs, (<>)) import Data.Typeable (Proxy(Proxy)) import System.Environment (getEnvironment, getArgs) import Text.Show.Pretty (ppShow)@@ -30,20 +30,20 @@  -- * an interesting example -type Cfg = NoDesc CfgDesc-type CfgDesc = ToConfigCode Cfg'-+type Cfg = ToConfigCode Cfg' type Cfg' =-             "frontend"      :> ServerCfg :>: "descr"-  :*> Maybe ("backend"       :> ServerCfg)-  :*>        "default_users" :> [UserCfg] :>: "list of users that are created on start if database is empty"+             "frontend"      :> ServerCfg' :>: "descr"+  :*> Maybe ("backend"       :> ServerCfg')+  :*>        "default_users" :> [UserCfg'] :>: "list of users that are created on start if database is empty" -type ServerCfg =+type ServerCfg = ToConfigCode ServerCfg'+type ServerCfg' =              "bind_port"   :> Int   :*>        "bind_host"   :> ST   :*> Maybe ("expose_host" :> ST) -type UserCfg =+type UserCfg = ToConfigCode UserCfg'+type UserCfg' =              "name"     :> ST :>: "user name (must be unique)"   :*>        "email"    :> ST :>: "email address (must also be unique)"   :*>        "password" :> ST :>: "password (not encrypted)"@@ -62,12 +62,12 @@ main :: IO () main = do     sources <- sequence-        [ ConfigFileYaml <$> SBS.readFile "examples/config.yaml"-        , ShellEnv       <$> getEnvironment-        , CommandLine    <$> getArgs+        [ YamlString  <$> SBS.readFile "examples/config.yaml"+        , ShellEnv    <$> getEnvironment+        , CommandLine <$> getArgs         ] -    ST.putStrLn $ docs (Proxy :: Proxy CfgDesc)+    ST.putStrLn $ docs (Proxy :: Proxy Cfg) <> "\n\n"      let dump cfg = do             putStrLn $ ppShow cfg@@ -75,11 +75,56 @@      dump defaultCfg -    case configify sources :: Result Cfg of-        Left e -> print e-        Right cfg -> do-            dump cfg+    cfg :: Tagged Cfg <- configify sources+    dump cfg -            putStrLn "accessing config values:"-            print $ cfg >>. (Proxy :: Proxy '["frontend"])-            print $ cfg >>. (Proxy :: Proxy '["frontend", "expose_host"])+    putStrLn "accessing config values:"+    print $ (Tagged (cfg >>. (Proxy :: Proxy '["frontend"])) :: Tagged ServerCfg)+    print $ cfg >>. (Proxy :: Proxy '["frontend", "expose_host"])+    print $ cfg >>. (Proxy :: Proxy '["frontend", "bind_port"])+++{-++Example session:++$ configifier-example+[...]+accessing config values:+(Tagged Id 8001 :*> (Id "localhost" :*> JustO (Id "fost")))+Just "fost"+8001++$ FRONTEND_BIND_PORT=31 configifier-example+[...]+accessing config values:+(Tagged Id 31 :*> (Id "localhost" :*> JustO (Id "fost")))+Just "fost"+31++$ FRONTEND_BIND_PORT=31 configifier-example --frontend-bind-port 15+[...]+accessing config values:+(Tagged Id 15 :*> (Id "localhost" :*> JustO (Id "fost")))+Just "fost"+15++$ configifier-example --frontend-expose-host "false"+[...]+configifier-example: CommandLinePrimitiveOtherError (ShellEnvNoParse {shellEnvNoParseType = "Text", shellEnvNoParseValue = "false", shellEnvNoParseMsg = "when expecting a Text, encountered Boolean instead"})++$ configifier-example --frontend-expose-host "\"false\""+[...]+accessing config values:+(Tagged Id 8001 :*> (Id "localhost" :*> JustO (Id "false")))+Just "false"+8001++$ configifier-example --config examples/config2.yaml+[...]+backend:+  bind_host: arrr+  bind_port: 281+[...]++-}

@@ -20,22 +20,23 @@ module Data.Configifier where -import Control.Applicative ((<$>), (<*>), (<|>))-import Control.Exception (Exception)-import Data.Aeson (ToJSON, FromJSON, Value(Object, Null), object, toJSON, (.=))+import Control.Applicative ((<$>), (<|>))+import Control.Exception (Exception, throwIO) import Data.CaseInsensitive (mk) import Data.Char (toUpper) import Data.Either.Combinators (mapLeft) import Data.Function (on)-import Data.List (nubBy, intercalate)+import Data.List (nubBy, intercalate, isPrefixOf) import Data.Maybe (catMaybes) import Data.Monoid (Monoid, (<>), mempty, mappend, mconcat) import Data.String.Conversions (ST, SBS, cs) import Data.Typeable (Typeable, Proxy(Proxy), typeOf)+import Data.Yaml.Include (decodeFileEither)+import Data.Yaml (ToJSON, FromJSON, Value(Object, Array, Null), object, toJSON, parseJSON, (.=)) import GHC.TypeLits (Symbol, KnownSymbol, symbolVal)+import System.Environment (getEnvironment, getArgs, getProgName) -import qualified Data.Aeson as Aeson-import qualified Data.Aeson.Types as Aeson+import qualified Data.ByteString as SBS import qualified Data.HashMap.Strict as HashMap import qualified Data.Vector as Vector import qualified Data.Yaml as Yaml@@ -80,19 +81,15 @@     ToConfigCode (Maybe a) = Option (ToConfigCode a)     ToConfigCode a         = Type a --- | Filter 'Descr' constructors from 'ConfigCode'.+{-# DEPRECATED NoDesc "use of NoDesc is redundant and can be dropped without replacement." #-} type family NoDesc (a :: ConfigCode *) :: ConfigCode * where-    NoDesc (Record a b) = Record (NoDesc a) (NoDesc b)-    NoDesc (Label s a)  = Label s (NoDesc a)-    NoDesc (Descr a s)  = NoDesc a-    NoDesc (List a)     = List (NoDesc a)-    NoDesc (Option a)   = Option (NoDesc a)-    NoDesc (Type a)     = Type a+    NoDesc a = a  -- | Map 'ConfgCode' types to the types of config values. type family ToConfig (a :: ConfigCode *) (f :: * -> *) :: * where     ToConfig (Record a b) f = ToConfig a f :*> ToConfig b f     ToConfig (Label s a)  f = f (ToConfig a f)+    ToConfig (Descr a s)  f = ToConfig a f     ToConfig (List a)     f = [ToConfig a f]     ToConfig (Option a)   f = MaybeO (ToConfig a f)     ToConfig (Type a)     f = a@@ -111,7 +108,8 @@ -- * sources  data Source =-      ConfigFileYaml SBS+      YamlString SBS+    | YamlFile FilePath     | ShellEnv [(String, String)]     | CommandLine [String]   deriving (Eq, Ord, Show, Typeable)@@ -146,13 +144,15 @@  -- * results and errors -type Result cfg = Either Error (Tagged cfg)- data Error =-      InvalidYaml+      InvalidYamlString         { invalidYamlInput :: SBS-        , invalidYamlMsg :: String+        , invalidYamlMsg :: Yaml.ParseException         }+    | InvalidYamlFile+        { invalidYamlFile :: FilePath+        , invalidYamlMsg :: Yaml.ParseException+        }     | ShellEnvNil     | ShellEnvNoParse         { shellEnvNoParseType  :: String@@ -164,7 +164,7 @@     | FreezeIncomplete         { freezeIncompleteAtPath :: [String]         }-  deriving (Eq, Ord, Show, Typeable)+  deriving (Show, Typeable)  instance Exception Error @@ -180,10 +180,10 @@       , HasParseShellEnv cfg       , HasParseCommandLine cfg       , CanonicalizePartial cfg-      ) => [Source] -> Result cfg-configify = configify' (mempty :: tm)+      ) => [Source] -> IO (Tagged cfg)+configify = configifyWithDefault (mempty :: tm) -configify' :: forall cfg tm .+configifyWithDefault :: forall cfg tm .       ( tm ~ TaggedM cfg       , Show tm       , Monoid tm@@ -192,20 +192,90 @@       , HasParseShellEnv cfg       , HasParseCommandLine cfg       , CanonicalizePartial cfg-      ) => tm -> [Source] -> Result cfg-configify' def sources = sequence (get <$> sources) >>= merge . (def:)+      ) => tm -> [Source] -> IO (Tagged cfg)+configifyWithDefault def sources = sequence (get <$> readUserConfigFiles sources) >>= run . merge . (def:)   where-    get :: Source -> Either Error tm-    get (ConfigFileYaml sbs) = parseConfigFile sbs-    get (ShellEnv env)       = parseShellEnv env-    get (CommandLine args)   = parseCommandLine args+    run :: Either Error a -> IO a+    run = either throwIO return +    get :: Source -> IO tm+    get (YamlString sbs)     = run $ parseConfigFile sbs+    get (YamlFile fpath)     = parseConfigFileWithIncludes fpath >>= run+    get (ShellEnv env)       = run $ parseShellEnv env+    get (CommandLine args)   = run $ parseCommandLine args ++-- * IO++-- | From a list of config file paths, construct a source list that+-- (1) reads those files allowing for recursive includes; then (2)+-- processes shell environment variables (with `getProgName` as+-- prefix), and finally (3) processes command line args, turning+-- @--config@ arguments into further recursive config file loads.+defaultSources :: [FilePath] -> IO [Source]+defaultSources filePaths = do+    let files = YamlFile <$> filePaths+    env  <- ShellEnv     <$> (getEnvironment >>= withShellEnvPrefix)+    args <- CommandLine  <$> getArgs+    return $ files ++ [env] ++ readUserConfigFiles [args]++-- | Require that all shell env variables start with executable name.+-- (This is just a call to 'requireShellEnvPrefix'' with the result of+-- 'progName'.)+withShellEnvPrefix :: Env -> IO Env+withShellEnvPrefix env = (`withShellEnvPrefix'` env) <$> getProgName+++-- * corner cases++-- FUTURE WORK: the functions in this section operate on sources, not+-- parsers.  This has the unintended effect of leaving the+-- documentation functionality oblivious of what happens here, so the+-- user of the apliation that uses configifier has no way of knowing+-- about '--config' or the program name prefix of shell env variables.+-- there should be a better way.++-- | Handle `--config=<FILE>`, `--config <FILE>`: split up+-- 'CommandLine' source on each of these, and inject a+-- 'YamlFile' source with the resp. file name.+readUserConfigFiles :: [Source] -> [Source]+readUserConfigFiles = mconcat . map f+  where+    f :: Source -> [Source]+    f s@(YamlString _)   = [s]+    f s@(YamlFile _)     = [s]+    f s@(ShellEnv _)     = [s]+    f (CommandLine args) = filter (not . (== CommandLine [])) $ g [] args++    g :: [String] -> [String] -> [Source]+    g acc [] = [CommandLine (reverse acc)]+    g acc fresh@(freshHead:freshTail) = case popArg fresh of+        Right (("config", v), fresh') -> CommandLine (reverse acc) : YamlFile v : g [] fresh'+        _ -> g (freshHead : acc) freshTail++-- | Require prefix for shell env variables.  This function will chop+-- off the given prefix of all env entries, and filter all entries+-- that do not have this prefix.+withShellEnvPrefix' :: String -> Env -> Env+withShellEnvPrefix' prefix = catMaybes . map f+  where+    f (k, v) = if prefix `isPrefixOf` k+        then Just (take (length prefix) k, v)+        else Nothing++ -- * yaml / json  parseConfigFile :: (FromJSON (TaggedM cfg)) => SBS -> Either Error (TaggedM cfg)-parseConfigFile sbs = mapLeft (InvalidYaml sbs) $ Yaml.decodeEither sbs+parseConfigFile sbs = mapLeft (InvalidYamlString (trunc sbs)) $ Yaml.decodeEither' sbs+  where+    l = 21+    trunc s = if SBS.length s > l then SBS.take l s <> "..." else s +-- | See "Data.Yaml.Include".+parseConfigFileWithIncludes :: (FromJSON (TaggedM cfg)) => FilePath -> IO (Either Error (TaggedM cfg))+parseConfigFileWithIncludes fpath = mapLeft (InvalidYamlFile fpath) <$> decodeFileEither fpath+ renderConfigFile :: (Freeze cfg, t ~ Tagged cfg, ToJSON (TaggedM cfg)) => t -> SBS renderConfigFile = Yaml.encode . thaw @@ -229,11 +299,16 @@          , KnownSymbol s          )         => ToJSON (TaggedM (Label s cfg)) where-    toJSON (TaggedM Nothing) = Aeson.Null+    toJSON (TaggedM Nothing) = Null     toJSON (TaggedM (Just v)) = case toJSON (TaggedM v :: TaggedM cfg) of-        Aeson.Null -> Aeson.Null+        Null -> Null         val        -> object [key .= val]  where key = cs $ symbolVal (Proxy :: Proxy s) +instance ( ToConfig (Descr cfg s) Maybe ~ ToConfig cfg Maybe+         , ToJSON (TaggedM cfg)+         ) => ToJSON (TaggedM (Descr cfg s)) where+    toJSON (TaggedM v) = toJSON (TaggedM v :: TaggedM cfg)+ -- | @instance ToJSON List@ instance ( t ~ ToConfig cfg Maybe          , ToJSON (TaggedM cfg)@@ -247,7 +322,7 @@          , ToJSON (TaggedM cfg)          ) => ToJSON (TaggedM (Option cfg)) where     toJSON (TaggedM (JustO v)) = toJSON $ (TaggedM v :: TaggedM cfg)-    toJSON (TaggedM NothingO)  = Aeson.Null+    toJSON (TaggedM NothingO)  = Null  -- | @instance ToJSON Type@ instance (ToJSON a) => ToJSON (TaggedM (Type a)) where@@ -259,36 +334,46 @@ -- | @instance FromJSON Record@ instance (FromJSON (TaggedM cfg1), FromJSON (TaggedM cfg2)) => FromJSON (TaggedM (Record cfg1 cfg2)) where     parseJSON json = do-        TaggedM o1 :: TaggedM cfg1 <- Aeson.parseJSON json-        TaggedM o2 :: TaggedM cfg2 <- Aeson.parseJSON json+        TaggedM o1 :: TaggedM cfg1 <- parseJSON json+        TaggedM o2 :: TaggedM cfg2 <- parseJSON json         return . TaggedM $ o1 :*> o2  -- | @instance FromJSON Label@ (tolerates unknown fields in json object.) instance (FromJSON (TaggedM cfg), KnownSymbol s) => FromJSON (TaggedM (Label s cfg)) where-    parseJSON = Aeson.withObject "configifier object" $ \ m ->-          case HashMap.lookup key m of+    parseJSON (Object hashmap) =+          case HashMap.lookup key hashmap of             (Just json) -> TaggedM . Just . fromTaggedM <$> parseJSON' json             Nothing     -> return $ TaggedM Nothing         where           key = cs $ symbolVal (Proxy :: Proxy s)-          parseJSON' :: Aeson.Value -> Aeson.Parser (TaggedM cfg) = Aeson.parseJSON+          parseJSON' :: Value -> Yaml.Parser (TaggedM cfg) = parseJSON+    parseJSON bad = fail $ "when expecting 'Label', encountered this instead: " ++ show bad +instance ( ToConfig (Descr cfg s) Maybe ~ ToConfig cfg Maybe+         , FromJSON (TaggedM cfg)+         ) => FromJSON (TaggedM (Descr cfg s)) where+    parseJSON v = cast <$> parseJSON v+      where+        cast :: TaggedM cfg -> TaggedM (Descr cfg s)+        cast = TaggedM . fromTaggedM+ -- | @instance ParseJSON List@ instance (FromJSON (TaggedM cfg)) => FromJSON (TaggedM (List cfg)) where-    parseJSON = Aeson.withArray "configifier list" $ \ vector -> do-        vector' :: [TaggedM cfg] <- sequence $ Aeson.parseJSON <$> Vector.toList vector+    parseJSON (Array vector) = do+        vector' :: [TaggedM cfg] <- sequence $ parseJSON <$> Vector.toList vector         return . TaggedM . (fromTaggedM <$>) $ vector'+    parseJSON bad = fail $ "when expecting 'List', encountered this instead: " ++ show bad  -- | @instance ParseJSON Option@ instance (FromJSON (TaggedM cfg)) => FromJSON (TaggedM (Option cfg)) where     parseJSON Null = return (TaggedM NothingO :: TaggedM (Option cfg))     parseJSON v = do-        TaggedM js :: TaggedM cfg <- Aeson.parseJSON v+        TaggedM js :: TaggedM cfg <- parseJSON v         return $ (TaggedM (JustO js) :: TaggedM (Option cfg))  -- | @instance FromJSON Type@ instance (FromJSON a) => FromJSON (TaggedM (Type a)) where-    parseJSON = (TaggedM <$>) . Aeson.parseJSON+    parseJSON = (TaggedM <$>) . parseJSON   -- * shell env@@ -326,6 +411,14 @@             (key', '_':s@(_:_)) | mk key == mk key' -> Just (s, v)             _                                       -> Nothing +instance ( ToConfig (Descr cfg s) Maybe ~ ToConfig cfg Maybe+         , HasParseShellEnv cfg+         ) => HasParseShellEnv (Descr cfg s) where+    parseShellEnv env = cast <$> parseShellEnv env+      where+        cast :: TaggedM cfg -> TaggedM (Descr cfg s)+        cast = TaggedM . fromTaggedM+ -- | You can provide a list value via the shell environment by -- providing a single element.  This element will be put into a list -- implicitly.@@ -369,7 +462,7 @@     parseCommandLine = primitiveParseCommandLine  --- | Very basic fist approach: read @/--(key)(=|\s+)(value)/@;+-- | Very basic first approach: read @/--(key)(=|\s+)(value)/@; -- construct shell env from keys and names, and use 'parseShellEnv' on -- the command line.  If it doesn't like the syntax used in the -- command line, it will crash.  I hope for this to get much fancier@@ -383,18 +476,22 @@  parseArgs :: Args -> Either String Env parseArgs [] = Right []-parseArgs (h:[]) = parseArgsWithEqSign h-parseArgs (h:h':t) = ((++) <$> parseArgsWithEqSign h   <*> parseArgs (h':t))-                 <|> ((++) <$> parseArgsWithSpace h h' <*> parseArgs t)+parseArgs args = popArg args >>= \ ((k, v), args') -> ((parseArgName k, v):) <$> parseArgs args' -parseArgsWithEqSign :: String -> Either String Env+popArg :: Args -> Either String ((String, String), Args)+popArg []       = Left "empty argument list."+popArg (h:[])   = (, []) <$> parseArgsWithEqSign h+popArg (h:h':t) = ((, h':t) <$> parseArgsWithEqSign h)+              <|> ((,    t) <$> parseArgsWithSpace h h')++parseArgsWithEqSign :: String -> Either String (String, String) parseArgsWithEqSign s = case cs s Regex.=~- "^--([^=]+)=(.*)$" of-    [_, k, v] -> Right [(parseArgName $ cs k, cs v)]+    [_, k, v] -> Right (cs k, cs v)     bad -> Left $ "could not parse last arg: " ++ show (s, bad) -parseArgsWithSpace :: String -> String -> Either String Env+parseArgsWithSpace :: String -> String -> Either String (String, String) parseArgsWithSpace s v = case cs s Regex.=~- "^--([^=]+)$" of-    [_, k] -> Right [(parseArgName $ cs k, cs v)]+    [_, k] -> Right (cs k, cs v)     bad -> Left $ "could not parse long-arg with value: " ++ show (s, v, bad)  parseArgName :: String -> String@@ -422,6 +519,7 @@     ToVal (Record a b) '[]       = Just (ToConfig (Record a b) Id)     ToVal (Record a b) ps        = OrElse (ToVal a ps) (ToVal b ps)     ToVal (Label p a)  (p ': ps) = ToVal a ps+    ToVal (Descr a s)  ps        = ToVal a ps     ToVal (Option a)   ps        = ToValueMaybe (ToVal a ps)     ToVal a            '[]       = Just (ToConfig a Id)     ToVal a            (p ': ps) = Nothing@@ -483,20 +581,26 @@     sel (Tagged record) Proxy = CJust record  instance ( cfg ~ Record cfg' cfg''-         -- @ToVal cfg ps ~ Just t@ or @ToVal cfg ps ~ Nothing@          , Sel cfg' (p ': ps)          , Sel cfg'' (p ': ps)          ) => Sel (Record cfg' cfg'') (p ': ps) where     sel (Tagged (a :*> b)) path = orElse (sel (Tagged a :: Tagged cfg') path) (sel (Tagged b :: Tagged cfg'') path)  instance ( cfg ~ Label p cfg'-         -- @ToVal cfg ps ~ Just t@ or @ToVal cfg ps ~ Nothing@-         , t ~ ToConfig cfg Id          , Sel cfg' ps          , KnownSymbol p          ) => Sel (Label p cfg') (p ': ps) where     sel (Tagged (Id a)) Proxy = sel (Tagged a :: Tagged cfg') (Proxy :: Proxy ps) +instance ( cfg ~ Descr cfg' s+         , Sel cfg' ps+         , ToConfig (Descr cfg' s) Id ~ ToConfig cfg' Id+         ) => Sel (Descr cfg' s) ps where+    sel = sel . cast+      where+        cast :: Tagged (Descr cfg' s) -> Tagged cfg'+        cast = Tagged . fromTagged+ instance ( cfg ~ Option cfg'          , NothingValue (ToVal cfg' ps)          , Sel cfg' ps@@ -586,6 +690,23 @@         tagA :: ToConfig a Maybe -> TaggedM a         tagA = TaggedM +instance ( ToConfig (Descr a s) Maybe ~ ToConfig a Maybe+         , ToConfig a Maybe ~ Maybe a'+         , Monoid (TaggedM a)+         ) => Monoid (TaggedM (Descr a s)) where+    mempty = cast $ TaggedM Nothing+      where+        cast :: TaggedM a -> TaggedM (Descr a s)+        cast = TaggedM . fromTaggedM++    mappend x x' = cast $ cast' x <> cast' x'+      where+        cast :: TaggedM a -> TaggedM (Descr a s)+        cast' :: TaggedM (Descr a s) -> TaggedM a++        cast = TaggedM . fromTaggedM+        cast' = TaggedM . fromTaggedM+ -- | There is no @instance Monoid (TaggedM (Type a))@, since there -- is no reasonable 'mempty'.  Therefore, we offer a specialized -- instance for labels that map to 'Type'.@@ -636,6 +757,13 @@      thw Proxy (Id x) = Just $ thw (Proxy :: Proxy t) x +instance ( ToConfig (Descr t s) Maybe ~ ToConfig t Maybe+         , ToConfig (Descr t s) Id ~ ToConfig t Id+         , Freeze t+         ) => Freeze (Descr t s) where+    frz Proxy path x = frz (Proxy :: Proxy t) path x+    thw Proxy = thw (Proxy :: Proxy t)+ instance (Freeze c) => Freeze (List c) where     frz Proxy path xs = sequence $ frz (Proxy :: Proxy c) path <$> xs     thw Proxy xs = thw (Proxy :: Proxy c) <$> xs@@ -669,6 +797,9 @@     thw Proxy x = x  +-- | Partials are constructed with every 'Nothing' spelled out,+-- resulting in deep skeletons of 'Nothing's.  'CanonicalizePartial'+-- replaces those with single 'Nothing's at their tops. class CanonicalizePartial a where     canonicalizePartial :: TaggedM a -> TaggedM a     emptyPartial :: TaggedM a -> Bool@@ -695,6 +826,21 @@      emptyPartial (TaggedM Nothing) = True     emptyPartial (TaggedM (Just a)) = emptyPartial (TaggedM a :: TaggedM cfg')++instance (cfg ~ Descr cfg' s, CanonicalizePartial cfg')+        => CanonicalizePartial (Descr cfg' s) where+    canonicalizePartial = cast . canonicalizePartial . cast'+      where+        cast :: TaggedM a -> TaggedM (Descr a s)+        cast' :: TaggedM (Descr a s) -> TaggedM a++        cast = TaggedM . fromTaggedM+        cast' = TaggedM . fromTaggedM++    emptyPartial = emptyPartial . cast+      where+        cast :: TaggedM (Descr a s) -> TaggedM a+        cast = TaggedM . fromTaggedM  instance (cfg ~ List cfg', CanonicalizePartial cfg')         => CanonicalizePartial (List cfg') where

@@ -31,6 +31,7 @@     selectSpec     mergeSpec     sourcesSpec+    readUserConfigFilesSpec  miscSpec :: Spec miscSpec = do@@ -47,8 +48,7 @@     it "descriptions" $         let text :: SBS             want :: ( c ~ ToConfigCode ("bla" :> Int :>: "describe stuff!")-                    , c' ~ NoDesc c-                    ) => Tagged c'+                    ) => Tagged c              text = "bla: 3"             want = Tagged $ Id 3@@ -65,13 +65,13 @@          in run text want      it "option, no sources" $-        let have :: (c ~ ToConfigCode (Maybe ("bla" :> Int))) => Configifier.Result c+        let have :: (c ~ ToConfigCode (Maybe ("bla" :> Int))) => IO (Tagged c)             want :: (c ~ ToConfigCode (Maybe ("bla" :> Int))) => Tagged c              have = configify []             want = Tagged NothingO -         in have `shouldBe` Right want+         in have >>= (`shouldBe` want)      it "yaml cannot parse empty cfg files (even if all config data is optional!)" $         let text1, text2, text3 :: SBS@@ -127,8 +127,7 @@     it "lists" $         let text :: SBS             want :: ( c ~ ToConfigCode ("bla" :> [Bool])-                    , c' ~ NoDesc c-                    ) => Tagged c'+                    ) => Tagged c              text = "bla: [yes, no]"             want = Tagged $ Id [True, False]@@ -149,11 +148,11 @@       , CanonicalizePartial cfg       ) => SBS -> ti -> IO () run text parsedWant = do-    let f :: SBS -> Either Error ti-        f sbs = configify [ConfigFileYaml sbs]+    let f :: SBS -> IO ti+        f sbs = configify [YamlString sbs] -    f text `shouldBe` Right parsedWant-    f (renderConfigFile parsedWant) `shouldBe` Right parsedWant+    f text                          >>= (`shouldBe` parsedWant)+    f (renderConfigFile parsedWant) >>= (`shouldBe` parsedWant)   selectSpec :: Spec@@ -234,22 +233,22 @@      it "partial select paths and non-leaf sub-configs" $         let t :: forall config config' ponfig ponfig' .-                    ( config ~ Tagged (NoDesc (ToConfigCode config'))+                    ( config ~ Tagged (ToConfigCode config')                     , config' ~ (Maybe ("a" :> ST) :*> ("b" :> ST)) -                    , ponfig ~ Tagged (NoDesc (ToConfigCode ponfig'))+                    , ponfig ~ Tagged (ToConfigCode ponfig')                     , ponfig' ~ ("c" :> config')                      ) => IO ()             t = do-                  let Right (cfg1 :: ponfig) = configify [ConfigFileYaml . cs . unlines $+                  cfg1 :: ponfig <- configify [YamlString . cs . unlines $                           "c:" :                           "  a: goih" :                           "  b: c38" :                           "..." :                           []] -                      Right (Tagged cfg2 :: config) = configify [ConfigFileYaml . cs . unlines $+                  Tagged cfg2 :: config <- configify [YamlString . cs . unlines $                           "a: goih" :                           "b: c38" :                           "..." :@@ -304,10 +303,10 @@     let f :: ( c  ~ ToConfigCode c'              , c' ~ ("frontend" :> sc :*> Maybe ("backend" :> sc))              , sc ~ ("bind_port" :> Int :*> Maybe ("expose_host" :> ST))-             ) => [Source] -> Result c+             ) => [Source] -> IO (Tagged c)         f = configify -        configFile1 :: Source = ConfigFileYaml . cs . unlines $+        configFile1 :: Source = YamlString . cs . unlines $               "frontend:" :               "  bind_port: 3" :               "  expose_host: host" :@@ -315,7 +314,7 @@               "  bind_port: 4" :               "  expose_host: hist" :               []-        configFile2 :: Source = ConfigFileYaml . cs . unlines $+        configFile2 :: Source = YamlString . cs . unlines $               "frontend:" :               "  bind_port: 3" :               []@@ -331,21 +330,35 @@             parseArgs (["--arg=31", "--flob", "gluh"] :: Args) `shouldBe` Right ([("ARG", "31"), ("FLOB", "gluh")] :: Env)          it "1" $-            f [configFile1] `shouldBe`-                (Right . Tagged $ Id (Id 3 :*> JustO (Id "host"))-                               :*> JustO (Id (Id 4 :*> JustO (Id "hist"))))+            f [configFile1] >>= (`shouldBe`+                (Tagged $ Id (Id 3 :*> JustO (Id "host"))+                      :*> JustO (Id (Id 4 :*> JustO (Id "hist")))))          it "2" $-            f [configFile1, shellEnv1, shellEnv2] `shouldBe`-                (Right . Tagged $ Id (Id 18 :*> JustO (Id "host"))-                               :*> JustO (Id (Id 4 :*> JustO (Id "bom"))))+            f [configFile1, shellEnv1, shellEnv2] >>= (`shouldBe`+                (Tagged $ Id (Id 18 :*> JustO (Id "host"))+                      :*> JustO (Id (Id 4 :*> JustO (Id "bom")))))          it "3" $-            f [configFile1, shellEnv1, shellEnv2, commandLine1] `shouldBe`-                (Right . Tagged $ Id (Id 31 :*> JustO (Id "host"))-                               :*> JustO (Id (Id 4 :*> JustO (Id "bom"))))+            f [configFile1, shellEnv1, shellEnv2, commandLine1] >>= (`shouldBe`+                (Tagged $ Id (Id 31 :*> JustO (Id "host"))+                      :*> JustO (Id (Id 4 :*> JustO (Id "bom")))))          it "4" $-            f [configFile2, commandLine2] `shouldBe`-                (Right . Tagged $ Id (Id 3 :*> NothingO)-                               :*> JustO (Id (Id 8710 :*> JustO (Id "mab"))))+            f [configFile2, commandLine2] >>= (`shouldBe`+                (Tagged $ Id (Id 3 :*> NothingO)+                      :*> JustO (Id (Id 8710 :*> JustO (Id "mab")))))+++readUserConfigFilesSpec :: Spec+readUserConfigFilesSpec = describe "readUserConfigFiles" $ do+    it "finds --config args" $+        readUserConfigFiles [CommandLine ["--config=FILE"]] `shouldBe` [YamlFile "FILE"]++    it "keeps surrounding args intact" $ do+        readUserConfigFiles [CommandLine ["1", "2", "--config=FILE", "3", "4"]] `shouldBe`+            [CommandLine ["1", "2"], YamlFile "FILE", CommandLine ["3", "4"]]+        readUserConfigFiles [CommandLine ["--config=FILE", "2"]] `shouldBe`+            [YamlFile "FILE", CommandLine ["2"]]+        readUserConfigFiles [CommandLine ["1", "--config=FILE"]] `shouldBe`+            [CommandLine ["1"], YamlFile "FILE"]