packages feed

configurator-pg (empty) → 0.1.0.0

raw patch · 10 files changed

+819/−0 lines, 10 filesdep +HUnitdep +attoparsecdep +basesetup-changed

Dependencies added: HUnit, attoparsec, base, bytestring, configurator-pg, containers, filepath, protolude, scientific, test-framework, test-framework-hunit, text

Files

+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for configurator-pg++## 0.1.0.0 -- 2019-06-03++* First version.
+ LICENSE view
@@ -0,0 +1,33 @@+Copyright (c) 2011, MailRank, Inc.+Copyright (c) 2011-2014, Bryan O'Sullivan+Copyright (c) 2015-2016, Leon P Smith+Copyright (c) 2019, Robert Vollmert++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Robert Vollmert nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ configurator-pg.cabal view
@@ -0,0 +1,59 @@+cabal-version:       1.12+name:                configurator-pg+version:             0.1.0.0+synopsis:            Reduced parser for configurator-ng config files+description:+  This module provides a simplified and updated interface to the+  configuration file format of+  <https://hackage.haskell.org/package/configurator configurator> and+  <https://hackage.haskell.org/package/configurator-ng configurator-ng>.+  Its aim is primarily to allow updating programs that depend on+  configurator-ng to new versions of GHC without changing the+  configuration file format.+homepage:            https://github.com/robx/configurator-pg+bug-reports:         https://github.com/robx/configurator-pg/issues+license:             BSD3+license-file:        LICENSE+author:              Robert Vollmert+maintainer:          rob@vllmrt.net+copyright:           Copyright 2011 MailRank, Inc.+                     Copyright 2011-2014 Bryan O'Sullivan+                     Copyright 2015-2016 Leon P Smith+                     Copyright 2019 Robert Vollmert+category:            Configuration, Data+extra-source-files:  CHANGELOG.md+build-type:          Simple++library+  exposed-modules:     Data.Configurator+  other-modules:       Data.Configurator.Load+                       Data.Configurator.Parser+                       Data.Configurator.Syntax+                       Data.Configurator.Types+  build-depends:       base                 >= 4.9.1 && < 4.13+                     , attoparsec           >= 0.13.1 && < 0.14+                     , containers           >= 0.5.7.1 && < 0.7+                     , protolude            >= 0.1.10 && < 0.3+                     , scientific           >= 0.3.5.2 && < 0.4+                     , text                 >= 1.2.2.2 && < 1.3+  hs-source-dirs:      src+  default-language:    Haskell2010+  default-extensions:  OverloadedStrings, NoImplicitPrelude+  ghc-options: -Wall++test-suite tests+  type:                exitcode-stdio-1.0+  main-is:             Test.hs+  hs-source-dirs:      tests+  build-depends:       base                 >= 4.9.1 && < 4.13+                     , configurator-pg+                     , HUnit                >= 1.5 && < 1.7+                     , bytestring           >= 0.10.8.1 && < 0.11+                     , filepath             >= 1.4.1.1 && < 1.5+                     , protolude            >= 0.1.10 && < 0.3+                     , test-framework       >= 0.8.1.1 && < 0.9+                     , test-framework-hunit >= 0.3.0.2 && < 0.4+                     , text                 >= 1.2.2.2 && < 1.3+  default-language:    Haskell2010+  default-extensions:  OverloadedStrings, NoImplicitPrelude+  ghc-options: -Wall
+ src/Data/Configurator.hs view
@@ -0,0 +1,34 @@+-- |+-- Module:      Data.Configurator+-- Description: A configuration file parser+--+-- A simplified library for reading configuration files+-- in the format of [configurator-ng](https://hackage.haskell.org/package/configurator-ng).++module Data.Configurator+    (+    -- * Types+      Key+    , Value(..)+    , Config+    -- * Low-level parsing+    , load+    , ParseError(..)+    -- * High-level parsing+    , Parser+    , runParser+    -- ** Value parsers+    , bool+    , int+    , string+    , value+    , list+    -- ** Configuration parsers+    , optional+    , required+    , subassocs+    ) where++import Data.Configurator.Load   (load)+import Data.Configurator.Parser+import Data.Configurator.Types
+ src/Data/Configurator/Load.hs view
@@ -0,0 +1,91 @@+module Data.Configurator.Load+  ( load+  ) where++import Protolude++import           Control.Exception                (throw)+import qualified Data.Attoparsec.Text             as A+import qualified Data.Map.Strict                  as M+import           Data.Scientific                  (toBoundedInteger,+                                                   toRealFloat)+import qualified Data.Text                        as T+import qualified Data.Text.Lazy                   as TL+import           Data.Text.Lazy.Builder           (fromString,+                                                   fromText,+                                                   toLazyText)+import           Data.Text.Lazy.Builder.Int       (decimal)+import           Data.Text.Lazy.Builder.RealFloat (realFloat)+import qualified System.Environment++import Data.Configurator.Syntax+import Data.Configurator.Types++-- | Read and parse a configuration file.+--+-- This may cause IO exceptions for reading this file or+-- imported files, and 'ParseError' if there is a problem+-- with parsing or evaluating the file.+load :: FilePath -> IO Config+load path = applyDirective "" "" M.empty (Import $ T.pack path)++loadOne :: Path -> IO [Directive]+loadOne path = do+  s <- readFile (T.unpack path)+  case A.parseOnly topLevel s of+    Left err         -> throw $ ParseError $ "parsing " <> path <> ": " <> T.pack err+    Right directives -> return directives++applyDirective :: Key -> Path -> Config -> Directive -> IO Config+applyDirective prefix path config directive = case directive of+  Bind key (String str) -> do+    v <- interpolate prefix str config+    return $! M.insert (prefix <> key) (String v) config+  Bind key value ->+    return $! M.insert (prefix <> key) value config+  Group key directives -> foldM (applyDirective prefix' path) config directives+    where prefix' = prefix <> key <> "."+  Import relpath ->+    let path' = relativize path relpath+    in do+      directives <- loadOne path'+      foldM (applyDirective prefix path') config directives+  DirectiveComment _ -> return config++interpolate :: Key -> Text -> Config -> IO Text+interpolate prefix s config+  | "$" `T.isInfixOf` s =+    case A.parseOnly interp s of+      Left err   -> throw $ ParseError $ "parsing interpolation: " <> T.pack err+      Right xs -> TL.toStrict . toLazyText . mconcat <$> mapM interpret xs+  | otherwise = return s++ where+  lookupEnv name = msum $ map (flip M.lookup config) fullnames+    where fullnames = map (T.intercalate ".") -- ["a.b.c.x","a.b.x","a.x","x"]+                    . map (reverse . (name:)) -- [["a","b","c","x"],["a","b","x"],["a","x"],["x"]]+                    . tails                   -- [["c","b","a"],["b","a"],["a"],[]]+                    . reverse                 -- ["c","b","a"]+                    . filter (not . T.null)   -- ["a","b","c"]+                    . T.split (=='.')         -- ["a","b","c",""]+                    $ prefix                  -- "a.b.c."++  interpret (Literal x)   = return (fromText x)+  interpret (Interpolate name) =+    case lookupEnv name of+      Just (String x) -> return (fromText x)+      Just (Number r) ->+        case toBoundedInteger r :: Maybe Int64 of+          Just n  -> return (decimal n)+          Nothing -> return (realFloat (toRealFloat r :: Double))+      Just _  -> throw $ ParseError $ "variable '" <> name <> "' is not a string or number"+      Nothing -> do+        var <- System.Environment.lookupEnv (T.unpack name)+        case var of+          Nothing -> throw $ ParseError $ "no such variable: '" <> name <> "'"+          Just x  -> return (fromString x)++relativize :: Path -> Path -> Path+relativize parent child+  | T.head child == '/' = child+  | otherwise           = fst (T.breakOnEnd "/" parent) `T.append` child
+ src/Data/Configurator/Parser.hs view
@@ -0,0 +1,125 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase                 #-}++module Data.Configurator.Parser+    ( Parser+    , runParser+    , bool+    , int+    , string+    , value+    , list+    , optional+    , required+    , subassocs+    ) where++import Protolude hiding (bool, list, optional)++import           Data.Functor.Compose+import qualified Data.Map.Strict      as M+import qualified Data.Scientific      as Scientific+import           Data.Text            (Text)+import qualified Data.Text            as T++import Data.Configurator.Types++-- | A generic parser.+--+-- A @'Parser' a b@ knows how to extract a @b@ from an @a@. Typical+-- instances are @'Parser' 'Value' a@, which handles the parsing of+-- individual configuration values, and @'Parser' 'Config' a@, which+-- handles extracting data from a full keyed configuration file.+newtype Parser a b = Parser { getParser :: Compose ((->) a) (Either Text) b }+  deriving (Functor, Applicative)++makeParser :: (a -> Either Text b) -> Parser a b+makeParser = Parser . Compose++-- | Run a parser.+--+-- @'runParser' p x@ runs the parser @p@ on the input @x@, returning+-- a value @'Right' v@ on success, or @'Left' err@ on error.+runParser :: Parser a b -> a -> Either Text b+runParser = getCompose . getParser++instance Monad (Parser a) where+  p >>= f = makeParser $ \v -> runParser p v >>= \w -> runParser (f w) v++-- | Parse a required configuration field.+--+-- @'required' key p@ expects the field @key@ to be present, and parses+-- its value with @p@.+required :: Key -> Parser Value a -> Parser Config a+required key pv = makeParser $ \cfg ->+                case M.lookup key cfg of+                       Nothing -> Left $ "missing key: " <> key+                       Just v  -> runParser pv v++-- | Parse an optional configuration field.+--+-- @'optional' key p@ returns 'Nothing' if the field @key@ is not present.+-- Otherwise it returns @'Just' v@, where @v@ is the result of parsing the+-- field value with @p@.+optional :: Key -> Parser Value a -> Parser Config (Maybe a)+optional key pv = makeParser $ \cfg ->+                case M.lookup key cfg of+                       Nothing -> Right Nothing+                       Just v  -> Just <$> runParser pv v++-- | Parse a set of fields with a shared prefix.+--+-- @'subassocs' prefix p@ extracts all configuration keys one level+-- below @prefix@, and collects pairs of the full keys and the+-- corresponding field values parsed with @p@.+subassocs :: Key -> Parser Value a -> Parser Config [(Key, a)]+subassocs prefix pv = makeParser $ \cfg ->+  M.toList <$> mapM (runParser pv) (M.filterWithKey match cfg)+ where+  match k _ = if T.null prefix+                then not (T.isInfixOf "." k)+                else case T.stripPrefix (prefix <> ".") k of+                       Nothing   -> False+                       Just suff -> not (T.isInfixOf "." suff)++-- | Parse a list of values.+--+-- @'list' p@ expects a list value, and parses each entry with @p@.+list :: Parser Value a -> Parser Value [a]+list p = makeParser $ \case+  List vs -> mapM (runParser p) vs+  _       -> Left "expected a list"++-- | Extract a raw value.+--+-- 'value' returns a configuration value in its raw form.+value :: Parser Value Value+value = makeParser pure++-- | Extract a string value.+--+-- 'string' expects the given value to be a string.+string :: Parser Value Text+string = makeParser $ \case+  String s -> Right s+  _        -> Left "expected a string"++-- | Extract an integer value.+--+-- 'int' expects the given value to be an 'Int'.+int :: Parser Value Int+int = makeParser $ \case+  Number n -> if Scientific.isInteger n+                then case Scientific.toBoundedInteger n of+                      Just x  -> Right x+                      Nothing -> Left "int out of bounds"+                else Left "expected an integer"+  _        -> Left "expected an integer"++-- | Extract a boolean value.+--+-- 'bool' expects the given value to be boolean.+bool :: Parser Value Bool+bool = makeParser $ \case+  Bool b -> Right b+  _      -> Left "expected a boolean"
+ src/Data/Configurator/Syntax.hs view
@@ -0,0 +1,182 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module:      Data.Configurator.Syntax+-- Copyright:   (c) 2011 MailRank, Inc.+--              (c) 2015-2016 Leon P Smith+-- License:     BSD3+-- Maintainer:  Leon P Smith <leon@melding-monads.com>+-- Stability:   experimental+-- Portability: portable+--+-- A parser for configuration files.++module Data.Configurator.Syntax+    (+      topLevel+    , interp+    ) where++import Protolude hiding (First, try)++import           Control.Monad           (fail, when)+import           Data.Attoparsec.Text    as A+import           Data.Bits               (shiftL)+import           Data.Char               (chr, isAlpha, isAlphaNum,+                                          isSpace)+import           Data.Configurator.Types+import           Data.Monoid             (Monoid (..))+import           Data.Text               (Text)+import qualified Data.Text               as T+import qualified Data.Text.Lazy          as L+import           Data.Text.Lazy.Builder  (fromText, singleton,+                                          toLazyText)++topLevel :: Parser [Directive]+topLevel = directives <* skipLWS <* endOfInput++directive :: Parser Directive+directive =+  mconcat [+    string "import" *> skipLWS *> (Import <$> string_)+  , string "#;" *> skipHWS *> (DirectiveComment <$> directive)+  , Bind <$> try (ident <* skipLWS <* char '=' <* skipLWS) <*> value+  , Group <$> try (ident <* skipLWS <* char '{' <* skipLWS)+          <*> directives <* skipLWS <* char '}'+  ]++directives :: Parser [Directive]+directives = (skipLWS *> directive <* skipHWS) `sepBy`+             (satisfy $ \c -> c == '\r' || c == '\n')++data Skip = Space | Comment++-- | Skip lines, comments, or horizontal white space.+skipLWS :: Parser ()+skipLWS = loop+  where+    loop = A.takeWhile isSpace >> ((comment >> loop) <|> return ())++    comment = try beginComment >> A.takeWhile (\c -> c /= '\r' && c /= '\n')++    beginComment = do+      _ <- A.char '#'+      mc <- peekChar+      case mc of+        Just ';' -> fail ""+        _        -> return ()++-- | Skip comments or horizontal white space.+skipHWS :: Parser ()+skipHWS = scan Space go *> pure ()+  where go Space ' '    = Just Space+        go Space '\t'   = Just Space+        go Space '#'    = Just Comment+        go Space _      = Nothing+        go Comment '\r' = Nothing+        go Comment '\n' = Nothing+        go Comment _    = Just Comment++data IdentState = First | Follow++ident :: Parser Key+ident = do+  n <- scan First go+  when (n == "import") $+    fail $ "reserved word (" ++ show n ++ ") used as identifier"+  when (T.null n) $ fail "no identifier found"+  when (T.last n == '.') $ fail "identifier must not end with a dot"+  return n+ where+  go First c =+      if isAlpha c+      then Just Follow+      else Nothing+  go Follow c =+      if isAlphaNum c || c == '_' || c == '-'+      then Just Follow+      else if c == '.'+           then Just First+           else Nothing++value :: Parser Value+value = mconcat [+          string "on" *> pure (Bool True)+        , string "off" *> pure (Bool False)+        , string "true" *> pure (Bool True)+        , string "false" *> pure (Bool False)+        , String <$> string_+        , Number <$> scientific+        , List <$> brackets '[' ']'+                   ((value <* skipLWS) `sepBy` (char ',' <* skipLWS))+        ]++string_ :: Parser Text+string_ = do+  s <- char '"' *> scan False isChar <* char '"'+  if "\\" `T.isInfixOf` s+    then unescape s+    else return s+ where+  isChar True _ = Just False+  isChar _ '"'  = Nothing+  isChar _ c    = Just (c == '\\')++brackets :: Char -> Char -> Parser a -> Parser a+brackets open close p = char open *> skipLWS *> p <* char close++embed :: Parser a -> Text -> Parser a+embed p s = case parseOnly p s of+              Left err -> fail err+              Right v  -> return v++unescape :: Text -> Parser Text+unescape = fmap (L.toStrict . toLazyText) . embed (p mempty)+ where+  p acc = do+    h <- A.takeWhile (/='\\')+    let rest = do+          let cont c = p (acc `mappend` fromText h `mappend` singleton c)+          c <- char '\\' *> satisfy (inClass "ntru\"\\")+          case c of+            'n'  -> cont '\n'+            't'  -> cont '\t'+            'r'  -> cont '\r'+            '"'  -> cont '"'+            '\\' -> cont '\\'+            _    -> cont =<< hexQuad+    done <- atEnd+    if done+      then return (acc `mappend` fromText h)+      else rest++hexQuad :: Parser Char+hexQuad = do+  a <- embed hexadecimal =<< A.take 4+  if a < 0xd800 || a > 0xdfff+    then return (chr a)+    else do+      b <- embed hexadecimal =<< string "\\u" *> A.take 4+      if a <= 0xdbff && b >= 0xdc00 && b <= 0xdfff+        then return $! chr (((a - 0xd800) `shiftL` 10) + (b - 0xdc00) + 0x10000)+        else fail "invalid UTF-16 surrogates"++-- | Parse a string interpolation spec.+--+-- The sequence @$$@ is treated as a single @$@ character.  The+-- sequence @$(@ begins a section to be interpolated, and @)@ ends it.+interp :: Parser [Interpolate]+interp = reverse <$> p []+ where+  p acc = do+    h <- Literal <$> A.takeWhile (/='$')+    let rest = do+          let cont x = p (x : h : acc)+          c <- char '$' *> satisfy (\c -> c == '$' || c == '(')+          case c of+            '$' -> cont (Literal (T.singleton '$'))+            _   -> (cont . Interpolate) =<< A.takeWhile1 (/=')') <* char ')'+    done <- atEnd+    if done+      then return (h : acc)+      else rest
+ src/Data/Configurator/Types.hs view
@@ -0,0 +1,78 @@+module Data.Configurator.Types+    ( Value(..)+    , Directive(..)+    , ParseError(..)+    , Key+    , Path+    , Config+    , Interpolate (..)+    ) where++import Protolude++import Data.Map.Strict (Map)+import Data.Scientific (Scientific)++-- | An error that occurred during the low-level parsing of a configuration file.+newtype ParseError = ParseError Text+  deriving (Show)++instance Exception ParseError++-- | An evaluated configuation.+type Config = Map Key Value++-- | The left-hand side of a configuration binding.+type Key = Text++-- | A packed 'FilePath'.+type Path = Text++-- | A key-value binding.+--type Binding = (Key, Value)++-- | A directive in a configuration file.+data Directive = Import Path+               | Bind Key Value+               | Group Key [Directive]+               | DirectiveComment Directive+                 deriving (Eq, Show)++-- | A general right-hand side value of a configuration binding.+data Value = Bool Bool+           -- ^ A Boolean. Represented in a configuration file as @on@+           -- or @off@, @true@ or @false@ (case sensitive).+           | String Text+           -- ^ A Unicode string.  Represented in a configuration file+           -- as text surrounded by double quotes.+           --+           -- Escape sequences:+           --+           -- * @\\n@ - newline+           --+           -- * @\\r@ - carriage return+           --+           -- * @\\t@ - horizontal tab+           --+           -- * @\\\\@ - backslash+           --+           -- * @\\\"@ - quotes+           --+           -- * @\\u@/xxxx/ - Unicode character, encoded as four+           --   hexadecimal digits+           --+           -- * @\\u@/xxxx/@\\u@/xxxx/ - Unicode character (as two+           --   UTF-16 surrogates)+           | Number Scientific+           -- ^ A number.+           | List [Value]+           -- ^ A heterogeneous list.  Represented in a configuration+           -- file as an opening square bracket \"@[@\", followed by a+           -- comma-separated series of values, ending with a closing+           -- square bracket \"@]@\".+             deriving (Eq, Show)++-- | An interpolation directive.+data Interpolate = Literal Text+                 | Interpolate Text+                   deriving (Eq, Show)
+ tests/Test.hs view
@@ -0,0 +1,210 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Protolude hiding (bool, list, optional)++import           Data.Configurator+import           Data.Function                  (on)+import           Data.List                      (sortBy)+import           Data.Maybe                     (fromMaybe)+import           Data.Text                      (Text)+import qualified Data.Text                      as T+import           System.Environment+import           System.FilePath+import           Test.Framework+import           Test.Framework.Providers.HUnit+import           Test.HUnit                     hiding (Test)++main :: IO ()+main = defaultMain tests++tests :: [Test]+tests =+    [ testCase "read" readTest+    , testCase "load" loadTest+    , testCase "types" typesTest+    , testCase "interp" interpTest+    , testCase "scoped-interp" scopedInterpTest+    , testCase "import" importTest+    , testCase "readme" readmeTest+    ]++withLoad :: FilePath -> (Config -> IO ()) -> IO ()+withLoad name t = load (testFile name) >>= t++testFile :: FilePath -> FilePath+testFile name = "tests" </> "resources" </> name++parse :: Config -> Parser Value a -> Key -> Either Text a+parse cfg p key = runParser (required key p) cfg++parseOpt :: Config -> Parser Value a -> Key -> Either Text (Maybe a)+parseOpt cfg p key = runParser (optional key p) cfg++parseSub :: Config -> Parser Value a -> Key -> Either Text [(Key, a)]+parseSub cfg p prefix = runParser (subassocs prefix p) cfg++readTest :: Assertion+readTest = load (testFile "pathological.cfg") >> return ()++loadTest :: Assertion+loadTest =+  withLoad "pathological.cfg" $ \cfg -> do+    assertEqual "int property"+      (Right 1)+      (parse cfg int "aa")++    assertEqual "int as value"+      (Right (Number 1))+      (parse cfg value "aa")++    assertEqual "string property"+      (Right "foo")+      (parse cfg string "ab")++    assertEqual "nested int"+      (Right 1)+      (parse cfg int "ac.x")++    assertEqual "nested bool"+      (Right True)+      (parse cfg bool "ac.y")++    assertEqual "simple bool"+      (Right False)+      (parse cfg bool "ad")++    assertEqual "simple int 2"+      (Right 1)+      (parse cfg int "ae")++    assertEqual "simple int 2"+      (Right [2, 3])+      (parse cfg (list int) "af")++    assertEqual "deep bool"+      (Right False)+      (parse cfg bool "ag.q-e.i_u9.a")++    assertEqual "notacomment"+      (Right 42)+      (parse cfg int "notacomment")++    assertEqual "comment"+      (Left "missing key: comment.x")+      (parse cfg int "comment.x")++typesTest :: Assertion+typesTest =+  withLoad "pathological.cfg" $ \cfg -> do+    assertEqual "bad text"+      (Left "expected a string")+      (parse cfg string "aa")++    assertEqual "bad text list"+      (Left "expected a list")+      (parse cfg (list string) "ab")++    assertEqual "bad text list 2"+      (Left "expected a string")+      (parse cfg (list string) "af")++    assertEqual "heterogeneous list"+      (Right [Number 1, Number 2, String "3"])+      (parse cfg (list value) "xs")++    assertEqual "bad text list (heterogeneous)"+      (Left "expected a string")+      (parse cfg string "xs")++    assertEqual "bad int list (heterogeneous)"+      (Left "expected an integer")+      (parse cfg int "xs")++    assertEqual "assocs"+      (Right [("ac.x", Number 1), ("ac.y", Bool True)])+      (parseSub cfg value "ac")++    home <- T.pack <$> getEnv "HOME"+    assertEqual "assocs'"+      (Right (sortBy (compare `on` fst)+               [ ("aa", Number 1)+               , ("ab", String "foo")+               , ("ad", Bool False)+               , ("ae", Number 1)+               , ("af", List [Number 2, Number 3])+               , ("ba", String home)+               , ("xs", List [Number 1, Number 2, String "3"])+               , ("c" , String "x")+               , ("notacomment", Number 42)+               ]))+      (parseSub cfg value "")++interpTest :: Assertion+interpTest =+  withLoad "pathological.cfg" $ \cfg -> do+    home    <- getEnv "HOME"+    assertEqual "home interp"+      (Right (T.pack home))+      (parse cfg string "ba")++scopedInterpTest :: Assertion+scopedInterpTest = withLoad "interp.cfg" $ \cfg -> do+    home <- T.pack <$> getEnv "HOME"++    assertEqual "myprogram.exec"+      (Right $ home <> "/services/myprogram/myprogram")+      (parse cfg string "myprogram.exec")++    assertEqual "myprogram.stdout"+      (Right $ home <> "/services/myprogram/stdout")+      (parse cfg string "myprogram.stdout")++    assertEqual "nested scope"+      (Right $ home <> "/top/layer1/layer2")+      (parse cfg string "top.layer1.layer2.dir")++importTest :: Assertion+importTest =+  withLoad "import.cfg" $ \cfg -> do+    assertEqual "simple"+      (Right 1)+      (parse cfg int "x.aa")++    assertEqual "nested"+      (Right 1)+      (parse cfg int "x.ac.x")++data Settings = Settings+  { hostname  :: Text+  , port      :: Int+  , logfile   :: Maybe FilePath+  , loglevels :: Maybe [Int]+  , users     :: [(Text, Text)]+  , passwords :: [(Text, Text)]+  }+  deriving (Show, Eq)++settingsParser :: Parser Config Settings+settingsParser =+  Settings+    <$> required "hostname" string+    <*> (fromMaybe 1234 <$> optional "port" int)+    <*> optional "logfile" (T.unpack <$> string)+    <*> optional "loglevels" (list int)+    <*> subassocs "users" string+    <*> subassocs "passwords" string++readmeTest :: Assertion+readmeTest =+  withLoad "readme.cfg" $ \cfg -> do+    assertEqual "readme"+      (Right (Settings+                "localhost"+                8000+                (Just "/var/log/log.txt")+                (Just [1,4,5])+                [("users.alice", "alice@example.com"), ("users.bob", "bob@example.com")]+                [("passwords.alice", "secret")]))+      (runParser settingsParser cfg)