config-schema 0.2.0.0 → 0.3.0.0

raw patch · 6 files changed

+341/−133 lines, 6 filesdep +config-schemadep +prettydep ~basedep ~config-valuedep ~kan-extensionsPVP ok

version bump matches the API change (PVP)

Dependencies added: config-schema, pretty

Dependency ranges changed: base, config-value, kan-extensions, semigroupoids, text

API changes (from Hackage documentation)

Files

• ChangeLog.md +7/−0
• config-schema.cabal +19/−9
• src/Config/Schema/Docs.hs +47/−40
• src/Config/Schema/Load.hs +63/−51
• src/Config/Schema/Spec.hs +54/−33
• tests/Main.hs +151/−0

@@ -1,5 +1,12 @@ # Revision history for config-schema +## 0.3.0.0  -- 2017-05-09++* Added "association list" specifications+* Use `pretty` library for documentation generation+* Reorder parameters so that documentation comes last+* Hide implementations of `ValueSpecs` and `SectionSpecs`+ ## 0.2.0.0  -- 2017-05-07  * Expose `liftValueSpec` and `liftSectionSpec`

@@ -1,5 +1,5 @@ name:                config-schema-version:             0.2.0.0+version:             0.3.0.0 synopsis:            Schema definitions for the config-value package description:         This package makes it possible to defined schemas for use when                      loading configuration files using the config-value format.@@ -17,6 +17,7 @@ cabal-version:       >=1.10 homepage:            https://github.com/glguy/config-schema bug-reports:         https://github.com/glguy/config-schema/issues+tested-with:         GHC==8.0.2  source-repository head   type:                 git@@ -24,14 +25,23 @@  library   exposed-modules:      Config.Schema, Config.Schema.Docs, Config.Schema.Load, Config.Schema.Spec-  build-depends:        base           >=4.9 && <4.11,-                        text           >=1.2 && <1.3,-                        free           >=4.12 && <4.13,-                        kan-extensions >=5.0 && <5.1,-                        semigroupoids  >=5.2 && <5.3,-                        transformers   >=0.5 && <0.6,-                        config-value   >=0.5 && <0.6,-                        containers     >=0.5 && <0.6+  build-depends:        base           >=4.9   && <4.11,+                        config-value   >=0.6   && <0.7,+                        containers     >=0.5   && <0.6,+                        free           >=4.12  && <4.13,+                        kan-extensions >=5.0.2 && <5.1,+                        pretty         >=1.1.3 && <1.2,+                        semigroupoids  >=5.2   && <5.3,+                        text           >=1.2   && <1.3,+                        transformers   >=0.5   && <0.6   hs-source-dirs:       src+  default-language:     Haskell2010+  ghc-options:          -Wall++test-suite unit-tests+  type:                 exitcode-stdio-1.0+  main-is:              Main.hs+  hs-source-dirs:       tests+  build-depends:        base, config-value, config-schema, text   default-language:     Haskell2010   ghc-options:          -Wall

@@ -36,93 +36,100 @@   ( generateDocs   ) where +import           Data.List (intersperse) import           Data.Map (Map) import qualified Data.Map as Map-import           Data.Monoid-import           Data.List.NonEmpty (NonEmpty)-import qualified Data.List.NonEmpty as NonEmpty import           Data.Text (Text) import qualified Data.Text as Text+import           Text.PrettyPrint (Doc, text, ($+$), (<>), (<+>), nest, empty, hsep)  import           Config.Schema.Spec  -- | Default documentation generator. This generator is specifically -- for configuration specifications where the top-level specification -- is named with the empty string (@""@).-generateDocs :: ValueSpecs a -> Text-generateDocs spec = Text.unlines-  ("Configuration file fields:"-   : map ("    " <>) top-  ++ concatMap sectionLines (Map.toList m'))-+generateDocs :: ValueSpecs a -> Doc+generateDocs spec+  = vcat'+  $ txt "Configuration file fields:"+  : nest 4 top+  : concatMap sectionLines (Map.toList m')   where     topname = ""     Just top = Map.lookup topname m-    DocBuilder (m,"") = valuesDoc spec+    (m,"") = runDocBuilder (valuesDoc spec)     m' = Map.delete topname m -    sectionLines :: (Text, [Text]) -> [Text]-    sectionLines (name, fields)-      = ""-      : name-      : map ("    "<>) fields+    sectionLines :: (Text, Doc) -> [Doc]+    sectionLines (name, fields) = [text "", txt name, nest 4 fields]   -- | Compute the documentation for a list of sections, store the -- documentation in the sections map and return the name of the section.-sectionsDoc :: Text -> SectionSpecs a -> DocBuilder Text-sectionsDoc l spec = emitDoc l =<< runSections_ sectionDoc spec+sectionsDoc :: Text -> SectionSpecs a -> DocBuilder Doc+sectionsDoc l spec = emitDoc l . vcat' =<< runSections_ (fmap pure . sectionDoc) spec   -- | Compute the documentation lines for a single key-value pair.-sectionDoc :: SectionSpec a -> DocBuilder [Text]+sectionDoc :: SectionSpec a -> DocBuilder Doc sectionDoc s =   case s of-    ReqSection name desc w -> aux "REQUIRED " name desc <$> valuesDoc w-    OptSection name desc w -> aux ""          name desc <$> valuesDoc w+    ReqSection name desc w -> aux "REQUIRED" name desc <$> valuesDoc w+    OptSection name desc w -> aux empty      name desc <$> valuesDoc w   where     aux req name desc val =-      (name <> ": " <> req <> val)-      : if Text.null desc then [] else ["   " <> desc]+      txt name <> ":" <+> req <+> val $+$+      if Text.null desc then empty else nest 4 (txt desc)   -- | Compute the documentation line for a particular value specification. -- Any sections contained in the specification will be stored in the -- sections map.-valuesDoc :: ValueSpecs a -> DocBuilder Text-valuesDoc = fmap disjunction . sequenceA . runValueSpecs_ valueDoc+valuesDoc :: ValueSpecs a -> DocBuilder Doc+valuesDoc = fmap disjunction . sequenceA . runValueSpecs_ (fmap pure valueDoc)   -- | Combine a list of text with the word @or@.-disjunction :: NonEmpty Text -> Text-disjunction = Text.intercalate " or " . NonEmpty.toList+disjunction :: [Doc] -> Doc+disjunction = hsep . intersperse "or"   -- | Compute the documentation fragment for an individual value specification.-valueDoc :: ValueSpec a -> DocBuilder Text+valueDoc :: ValueSpec a -> DocBuilder Doc valueDoc w =   case w of-    TextSpec         -> return "text"-    IntegerSpec      -> return "integer"-    RationalSpec     -> return "number"-    AtomSpec a       -> return ("`" <> a <> "`")-    AnyAtomSpec      -> return "atom"+    TextSpec         -> pure "text"+    IntegerSpec      -> pure "integer"+    RationalSpec     -> pure "number"+    AtomSpec a       -> pure ("`" <> txt a <> "`")+    AnyAtomSpec      -> pure "atom"     SectionSpecs l s -> sectionsDoc l s-    NamedSpec    l s -> emitDoc l . pure =<< valuesDoc s-    CustomSpec l w'  -> ((l <> " ") <>) <$> valuesDoc w'-    ListSpec ws      -> ("list of " <>) <$> valuesDoc ws+    NamedSpec    l s -> emitDoc l =<< valuesDoc s+    CustomSpec l w'  -> (txt l                 <+>) <$> valuesDoc w'+    ListSpec ws      -> ("list of"             <+>) <$> valuesDoc ws+    AssocSpec ws     -> ("association list of" <+>) <$> valuesDoc ws   -- | A writer-like type. A mapping of section names and documentation -- lines is accumulated.-newtype DocBuilder a = DocBuilder (Map Text [Text], a)+newtype DocBuilder a = DocBuilder { runDocBuilder :: (Map Text Doc, a) }   deriving (Functor, Applicative, Monad, Monoid, Show)   -- | Given a section name and section body, store the body -- in the map of sections and return the section name. emitDoc ::-  Text   {- ^ section name -} ->-  [Text] {- ^ section body -} ->-  DocBuilder Text-emitDoc l xs = DocBuilder (Map.singleton l xs, l)+  Text {- ^ section name -} ->+  Doc  {- ^ section body -} ->+  DocBuilder Doc+emitDoc l xs = DocBuilder (Map.singleton l xs, txt l)++------------------------------------------------------------------------++-- | Like text, but works on Text values.+txt :: Text -> Doc+txt = text . Text.unpack++-- | Like vcat but using ($+$) instead of ($$) to avoid overlap.+vcat' :: [Doc] -> Doc+vcat' = foldr ($+$) empty

@@ -18,16 +18,17 @@   , Problem(..)   ) where -import           Control.Monad                    (unless, zipWithM)+import           Control.Monad                    (zipWithM) import           Control.Monad.Trans.Class        (lift) import           Control.Monad.Trans.State        (StateT(..), runStateT) import           Control.Monad.Trans.Except       (Except, runExcept, throwE) import           Control.Monad.Trans.Reader       (ReaderT, runReaderT, ask, local)+import           Data.Semigroup.Foldable          (asum1) import           Data.Functor.Alt                 (Alt((<!>))) import           Data.Monoid                      ((<>)) import           Data.Ratio                       (numerator, denominator)-import           Data.Semigroup.Foldable          (asum1) import           Data.List.NonEmpty               (NonEmpty)+import qualified Data.List.NonEmpty as NonEmpty import           Data.Text                        (Text) import qualified Data.Text as Text @@ -40,83 +41,94 @@ -- encountered. loadValue ::   ValueSpecs a                  {- ^ specification           -} ->-  Value                         {- ^ value                   -} ->+  Value Position                {- ^ value                   -} ->   Either (NonEmpty LoadError) a {- ^ errors or decoded value -} loadValue spec val = runLoad (getValue spec val)  -getSection :: SectionSpec a -> StateT [Section] Load a-getSection (ReqSection k _ w) =-  do v <- StateT (lookupSection k)+getSection :: Position -> SectionSpec a -> StateT [Section Position] Load a+getSection pos (ReqSection k _ w) =+  do v <- StateT (lookupSection pos k)      lift (scope k (getValue w v))-getSection (OptSection k _ w) =-  do mb <- optional1 (StateT (lookupSection k))+getSection pos (OptSection k _ w) =+  do mb <- optional1 (StateT (lookupSection pos k))      lift (traverse (scope k . getValue w) mb)  -getSections :: SectionSpecs a -> [Section] -> Load a-getSections p xs =-  do (a,leftover) <- runStateT (runSections getSection p) xs-     unless (null leftover) (loadFail (UnusedSections (map sectionName leftover)))-     return a+getSections :: Position -> SectionSpecs a -> [Section Position] -> Load a+getSections pos spec xs =+  do (a,leftovers) <- runStateT (runSections (getSection pos) spec) xs+     case NonEmpty.nonEmpty leftovers of+       Nothing -> return a+       Just ss -> asum1 (fmap (\s -> loadFail (sectionAnn s) (UnusedSection (sectionName s))) ss)  -getValue :: ValueSpecs a -> Value -> Load a-getValue s v = asum1 (runValueSpecs (getValue1 v) s)+getValue :: ValueSpecs a -> Value Position -> Load a+getValue s v = runValueSpecs (getValue1 v) s   -- | Match a primitive value specification against a single value.-getValue1 :: Value -> ValueSpec a -> Load a-getValue1 (Text t)       TextSpec           = pure t-getValue1 (Number _ n)   IntegerSpec        = pure n-getValue1 (Floating a b) IntegerSpec | Just i <- floatingToInteger a b = pure i-getValue1 (Number _ n)   RationalSpec       = pure (fromInteger n)-getValue1 (Floating a b) RationalSpec       = pure (floatingToRational a b)-getValue1 (List xs)      (ListSpec w)       = getList w xs-getValue1 (Atom b)       AnyAtomSpec        = pure (atomName b)-getValue1 (Atom b)       (AtomSpec a) | a == atomName b = pure ()-getValue1 (Sections s)   (SectionSpecs _ w) = getSections w s-getValue1 v              (NamedSpec _ w)    = getValue w v-getValue1 v              (CustomSpec l w)   = getCustom l w v+getValue1 :: Value Position -> ValueSpec a -> Load a+getValue1 (Text _ t)       TextSpec           = pure t+getValue1 (Number _ _ n)   IntegerSpec        = pure n+getValue1 (Floating _ a b) IntegerSpec | Just i <- floatingToInteger a b = pure i+getValue1 (Number _ _ n)   RationalSpec       = pure (fromInteger n)+getValue1 (Floating _ a b) RationalSpec       = pure (floatingToRational a b)+getValue1 (List _ xs)      (ListSpec w)       = getList w xs+getValue1 (Atom _ b)       AnyAtomSpec        = pure (atomName b)+getValue1 (Atom _ b)       (AtomSpec a) | a == atomName b = pure ()+getValue1 (Sections p s)   (SectionSpecs _ w) = getSections p w s+getValue1 (Sections _ s)   (AssocSpec w)      = getAssoc w s+getValue1 v                (NamedSpec _ w)    = getValue w v+getValue1 v                (CustomSpec l w)   = getCustom l w v -getValue1 _              TextSpec           = loadFail (SpecMismatch "text")-getValue1 _              IntegerSpec        = loadFail (SpecMismatch "integer")-getValue1 _              RationalSpec       = loadFail (SpecMismatch "number")-getValue1 _              ListSpec{}         = loadFail (SpecMismatch "list")-getValue1 _              AnyAtomSpec        = loadFail (SpecMismatch "atom")-getValue1 _              (AtomSpec a)       = loadFail (SpecMismatch ("`" <> a <> "`"))-getValue1 _              (SectionSpecs l _) = loadFail (SpecMismatch l)+getValue1 v TextSpec           = loadFail (valueAnn v) (SpecMismatch "text")+getValue1 v IntegerSpec        = loadFail (valueAnn v) (SpecMismatch "integer")+getValue1 v RationalSpec       = loadFail (valueAnn v) (SpecMismatch "number")+getValue1 v ListSpec{}         = loadFail (valueAnn v) (SpecMismatch "list")+getValue1 v AnyAtomSpec        = loadFail (valueAnn v) (SpecMismatch "atom")+getValue1 v (AtomSpec a)       = loadFail (valueAnn v) (SpecMismatch ("`" <> a <> "`"))+getValue1 v (SectionSpecs l _) = loadFail (valueAnn v) (SpecMismatch l)+getValue1 v AssocSpec{}        = loadFail (valueAnn v) (SpecMismatch "association list")   -- | This operation processes all of the values in a list with the given -- value specification and updates the scope with a one-based list index.-getList :: ValueSpecs a -> [Value] -> Load [a]+getList :: ValueSpecs a -> [Value Position] -> Load [a] getList w = zipWithM (\i x -> scope (Text.pack (show i)) (getValue w x)) [1::Int ..]  +-- | This operation processes all of the values in a section list+-- against the given specification and associates them with the+-- section name.+getAssoc :: ValueSpecs a -> [Section Position] -> Load [(Text,a)]+getAssoc w = traverse $ \(Section _ k v) -> (,) k <$> getValue w v++ -- | Match a value against its specification. If 'Just' is matched -- return the value. If 'Nothing is matched, report an error. getCustom ::   Text                 {- ^ label         -} ->   ValueSpecs (Maybe a) {- ^ specification -} ->-  Value                {- ^ value         -} ->+  Value Position       {- ^ value         -} ->   Load a getCustom l w v =   do x <- getValue w v      case x of-       Nothing -> loadFail (SpecMismatch l)+       Nothing -> loadFail (valueAnn v) (SpecMismatch l)        Just y  -> pure y   -- | Extract a section from a list of sections by name. lookupSection ::-  Text                    {- ^ section name                       -} ->-  [Section]               {- ^ available sections                 -} ->-  Load (Value, [Section]) {- ^ found value and remaining sections -}-lookupSection key [] = loadFail (MissingSection key)-lookupSection key (s@(Section k v):xs)+  Position                    {- ^ starting position of sections      -} ->+  Text                        {- ^ section name                       -} ->+  [Section p]                 {- ^ available sections                 -} ->+  Load (Value p, [Section p]) {- ^ found value and remaining sections -}+lookupSection pos key [] = loadFail pos (MissingSection key)+lookupSection pos key (s@(Section _ k v):xs)   | key == k  = pure (v, xs)-  | otherwise = do (v',xs') <- lookupSection key xs+  | otherwise = do (v',xs') <- lookupSection pos key xs                    return (v',s:xs')  ------------------------------------------------------------------------@@ -149,8 +161,8 @@ -- | Type for errors that can be encountered while decoding a value according -- to a specification. The error includes a key path indicating where in -- the configuration file the error occurred.-data LoadError = LoadError [Text] Problem -- ^ path to problem and problem description-  deriving (Eq, Ord, Read, Show)+data LoadError = LoadError Position [Text] Problem -- ^ position, path, problem+  deriving (Read, Show)   -- | Run the Load computation until it produces a result or terminates@@ -161,9 +173,9 @@  -- | Problems that can be encountered when matching a 'Value' against a 'ValueSpecs'. data Problem-  = MissingSection Text   -- ^ missing section name-  | UnusedSections [Text] -- ^ unused section names-  | SpecMismatch Text     -- ^ failed specification name+  = MissingSection Text -- ^ missing section name+  | UnusedSection Text  -- ^ unused section names+  | SpecMismatch Text   -- ^ failed specification name   deriving (Eq, Ord, Read, Show)  -- | Push a new key onto the stack of nested fields.@@ -171,10 +183,10 @@ scope key (MkLoad m) = MkLoad (local (key:) m)  -- | Abort value specification matching with the given error.-loadFail :: Problem -> Load a-loadFail cause = MkLoad $+loadFail :: Position -> Problem -> Load a+loadFail pos cause = MkLoad $   do path <- ask-     lift (throwE (pure (LoadError (reverse path) cause)))+     lift (throwE (pure (LoadError pos (reverse path) cause)))  ------------------------------------------------------------------------ 

@@ -1,5 +1,5 @@ {-# Language FlexibleInstances, RankNTypes, GADTs, KindSignatures #-}-{-# Language GeneralizedNewtypeDeriving, OverloadedStrings #-}+{-# Language DeriveFunctor, GeneralizedNewtypeDeriving, OverloadedStrings #-}  {-| Module      : Config.Schema.Spec@@ -22,16 +22,17 @@ module Config.Schema.Spec   (   -- * Specifying sections-    SectionSpecs(..)+    SectionSpecs   , reqSection   , optSection   , reqSection'   , optSection'    -- * Specifying values-  , ValueSpecs(..)+  , ValueSpecs   , Spec(..)   , sectionsSpec+  , assocSpec   , atomSpec   , anyAtomSpec   , listSpec@@ -63,11 +64,12 @@  import           Control.Applicative.Free         (Ap, runAp, runAp_, liftAp) import           Data.Functor.Const               (Const(..))-import           Data.Functor.Coyoneda            (Coyoneda(..), liftCoyoneda, lowerCoyoneda)-import           Data.Functor.Compose             (Compose(..), getCompose)+import           Data.Functor.Coyoneda            (Coyoneda(..), liftCoyoneda, lowerCoyoneda, hoistCoyoneda) import           Data.Functor.Alt                 (Alt(..)) import           Data.List.NonEmpty               (NonEmpty) import qualified Data.List.NonEmpty as NonEmpty+import           Data.Semigroup                   (Semigroup)+import           Data.Semigroup.Foldable          (asum1, foldMap1) import           Data.Text                        (Text) import qualified Data.Text as Text @@ -98,7 +100,7 @@  -- | Lift a single specification into a list of specifications. ----- @since 0.1.1.0+-- @since 0.2.0.0 liftSectionSpec :: SectionSpec a -> SectionSpecs a liftSectionSpec = MkSectionSpecs . liftAp @@ -144,10 +146,10 @@ -- | Specification for a required section with an explicit value specification. reqSection' ::   Text         {- ^ section name        -} ->-  Text         {- ^ description         -} ->   ValueSpecs a {- ^ value specification -} ->+  Text         {- ^ description         -} ->   SectionSpecs a-reqSection' n i w = liftSectionSpec (ReqSection n i w)+reqSection' n w i = liftSectionSpec (ReqSection n i w)   -- | Specification for an optional section with an implicit value specification.@@ -162,10 +164,10 @@ -- | Specification for an optional section with an explicit value specification. optSection' ::   Text         {- ^ section name        -} ->-  Text         {- ^ description         -} ->   ValueSpecs a {- ^ value specification -} ->+  Text         {- ^ description         -} ->   SectionSpecs (Maybe a)-optSection' n i w = liftSectionSpec (OptSection n i w)+optSection' n w i = liftSectionSpec (OptSection n i w)   ------------------------------------------------------------------------@@ -196,6 +198,10 @@   -- | Documentation identifier and section specification   SectionSpecs :: Text -> SectionSpecs a -> ValueSpec a +  -- | Matches an arbitrary list of sections. Similar to 'SectionSpec'+  -- except that that the section names are user-defined.+  AssocSpec :: ValueSpecs a -> ValueSpec [(Text,a)]+   -- | Documentation text, underlying specification   CustomSpec :: Text -> ValueSpecs (Maybe a) -> ValueSpec a @@ -203,38 +209,49 @@   NamedSpec :: Text -> ValueSpecs a -> ValueSpec a  + -- | Non-empty disjunction of value specifications. This type is the primary -- way to specify expected values. Use the 'Spec' class to generate 'ValueSpecs' -- for simple types. -- -- Multiple specifications can be combined using this type's 'Alt' instance.-newtype ValueSpecs a = MkValueSpecs { unValueSpecs :: Compose NonEmpty (Coyoneda ValueSpec) a }-  deriving Functor+newtype ValueSpecs a = MkValueSpecs { unValueSpecs :: NonEmpty (Coyoneda ValueSpec a) }+  deriving (Functor)  -- | Left-biased choice between two specifications instance Alt ValueSpecs where MkValueSpecs x <!> MkValueSpecs y = MkValueSpecs (x <!> y)   -- | Given an interpretation of a primitive value specification, extract a list of--- the possible interpretations of a disjunction of value specifications.------ Unlike 'runValueSpecs_', this allows the result of the interpretation to be indexed--- by the type of the primitive value specifications.-runValueSpecs :: Functor f => (forall x. ValueSpec x -> f x) -> ValueSpecs a -> NonEmpty (f a)-runValueSpecs f = fmap (lowerCoyoneda . hoistCoyoneda f) . getCompose . unValueSpecs+-- the possible interpretations of a disjunction of value specifications. Each of+-- these primitive interpretations will be combined using the provided 'Alt' instance.+runValueSpecs :: Alt f => (forall x. ValueSpec x -> f x) -> ValueSpecs a -> f a+runValueSpecs f = asum1 . fmap (runCoyoneda f) . unValueSpecs   -- | Given an interpretation of a primitive value specification, extract a list of--- the possible interpretations of a disjunction of value specifications.-runValueSpecs_ :: (forall x. ValueSpec x -> m) -> ValueSpecs a -> NonEmpty m-runValueSpecs_ f = fmap getConst . runValueSpecs (Const . f)+-- the possible interpretations of a disjunction of value specifications. Each of+-- these primitive interpretations will be combined using the provided 'Semigroup' instance.+runValueSpecs_ :: Semigroup m => (forall x. ValueSpec x -> m) -> ValueSpecs a -> m+runValueSpecs_ f = foldMap1 (runCoyoneda_ f) . unValueSpecs  +-- Helper for transforming the underlying type @f@ to one supporting a 'Functor'+-- instance before lowering.+runCoyoneda :: Functor g => (forall a. f a -> g a) -> Coyoneda f b -> g b+runCoyoneda f = lowerCoyoneda . hoistCoyoneda f++-- Helper for extracting the the value stored in a 'Coyoneda' while forgetting its+-- type index.+runCoyoneda_ :: (forall a. f a -> m) -> Coyoneda f b -> m+runCoyoneda_ f = getConst . runCoyoneda (Const . f)++ -- | Lift a primitive value specification to 'ValueSpecs'. ----- @since 0.1.1.0+-- @since 0.2.0.0 liftValueSpec :: ValueSpec a -> ValueSpecs a-liftValueSpec = MkValueSpecs . Compose . pure . liftCoyoneda+liftValueSpec = MkValueSpecs . pure . liftCoyoneda   ------------------------------------------------------------------------@@ -271,7 +288,7 @@  -- | Specification for matching any fractional number. ----- @since 0.1.1.0+-- @since 0.2.0.0 fractionalSpec :: Fractional a => ValueSpecs a fractionalSpec = fromRational <$> valuesSpec @@ -291,6 +308,17 @@ sectionsSpec i s = liftValueSpec (SectionSpecs i s)  +-- | Specification for a section list where the keys are user-defined.+-- Values are matched against the underlying specification and returned+-- as a list of section-name\/value pairs.+--+-- @since 0.3.0.0+assocSpec ::+  ValueSpecs a {- ^ underlying specification -} ->+  ValueSpecs [(Text,a)]+assocSpec = liftValueSpec . AssocSpec++ -- | Named value specification. This is useful for factoring complicated -- value specifications out in the documentation to avoid repetition of -- complex specifications.@@ -324,19 +352,12 @@  -- | Matches a non-empty list. ----- @since 0.1.1.0+-- @since 0.2.0.0 nonemptySpec :: ValueSpecs a -> ValueSpecs (NonEmpty a) nonemptySpec s = customSpec "nonempty" (listSpec s) NonEmpty.nonEmpty  -- | Matches a single element or a non-empty list. ----- @since 0.1.1.0+-- @since 0.2.0.0 oneOrNonemptySpec :: ValueSpecs a -> ValueSpecs (NonEmpty a) oneOrNonemptySpec s = pure <$> s <!> nonemptySpec s------------------------------------------------------------------------------ | Lift a natural transformation to be a natural transformation of--- 'Coyoneda'.-hoistCoyoneda :: (forall x. f x -> g x) -> (Coyoneda f a -> Coyoneda g a)-hoistCoyoneda f (Coyoneda g x) = Coyoneda g (f x)

@@ -0,0 +1,151 @@+{-# Language OverloadedStrings #-}+{-|+Module      : Main+Description : Unit tests for config-schema+Copyright   : (c) Eric Mertens, 2017+License     : ISC+Maintainer  : emertens@gmail.com+-}+module Main (main) where++import           Config+import           Config.Schema+import           Control.Applicative+import           Data.Foldable+import           Data.Text (Text)+import qualified Data.Text as Text++-- tests that are expected to pass.+--+-- The input sources are a list of lists of lines. Each outer list+-- element contains a list of lines representing a complete input+-- source. Each of these variations must pass the test.+test ::+  Show a =>+  Eq   a =>+  ValueSpecs a {- ^ specification to match -} ->+  a            {- ^ expected output        -} ->+  [[Text]]     {- ^ inputs sources         -} ->+  IO ()+test spec expected txtss =+  for_ txtss $ \txts ->+  case parse (Text.unlines txts) of+    Left e -> fail (show e)+    Right v ->+      case loadValue spec v of+        Left e -> fail (show e)+        Right x | x == expected -> return ()+                | otherwise -> fail ("Got " ++ show x ++ " but expected " +++                                     show expected)++main :: IO ()+main = sequenceA_++  [ test valuesSpec ("Hello world"::Text)+    [["\"Hello world\""]+    ,["\"H\\101l\\&l\\o157 \\"+     ,"  \\w\\x6frld\""]+    ]++  , test valuesSpec (1234::Integer)+    [["1234"]+    ,["1234.0"]+    ]++  , test valuesSpec (0.65::Rational)+    [["0.65e0"]+    ,["65e-2"]+    ,["6.5e-1"]+    ,["0.65"]+    ]++  , test anyAtomSpec "default"+    [["default"]]++  , test (atomSpec "testing-1-2-3") ()+    [["testing-1-2-3"]]++  , test (listSpec valuesSpec) ([]::[Integer])+    [["[]"]+    ,["[ ]"]]++  , test (listSpec anyAtomSpec) ["ḿyatoḿ"]+    [["[ḿyatoḿ]"]+    ,[" [ ḿyatoḿ ] "]+    ,["* ḿyatoḿ"]+    ]++  , test valuesSpec [1,2,3::Int]+    [["[1,2,3]"]+    ,["[1,2,3,]"]+    ,["* 1"+     ,"* 2"+     ,"* 3"]+    ]++  , test (listSpec valuesSpec) [[1,2],[3,4::Int]]+    [["[[1,2,],[3,4]]"]+    ,["*[1,2]"+     ,"*[3,4]"]+    ,["**1"+     ," *2"+     ,"* *3"+     ,"  *4"+     ]+    ]++  , test (assocSpec valuesSpec) ([]::[(Text,Int)])+    [["{}"]+    ,["{ }"]+    ]++  , test (assocSpec valuesSpec) [("k1",10::Int), ("k2",20)]+    [["{k1: 10, k2: 20}"]+    ,["{k1: 10, k2: 20,}"]+    ,["k1 : 10"+     ,"k2: 20"]+    ]++  , test valuesSpec [ Left (1::Int), Right ("two"::Text) ]+    [["[1, \"two\"]"]+    ,["* 1"+     ,"* \"two\""]+    ]++  , test (sectionsSpec "test"+            (liftA2 (,) (reqSection "k1" "") (reqSection "k2" "")))+         (10 :: Int, 20 :: Int)+    [["k1: 10"+     ,"k2: 20"]+    ,["k2: 20"+     ,"k1: 10"]+    ]++  , test (sectionsSpec "test"+            (liftA2 (,) (optSection "k1" "") (reqSection "k2" "")))+         (Just 10 :: Maybe Int, 20 :: Int)+    [["k1: 10"+     ,"k2: 20"]+    ,["k2: 20"+     ,"k1: 10"]+    ]++  , test (sectionsSpec "test"+            (liftA2 (,) (optSection "k1" "") (reqSection "k2" "")))+         (Nothing :: Maybe Int, 20 :: Int)+    [["k2: 20"]+    ,["{k2: 20}"]+    ]++  -- This isn't a good idea, but it currently works+  , test (sectionsSpec "test"+            (liftA2 (,) (reqSection "k1" "") (reqSection "k1" "")))+         ("first"::Text, 50::Int)+    [["k1: \"first\""+     ,"k1: 50"]+    ]++  , test (sectionsSpec "test" (pure ())) ()+    [["{}"]+    ]+  ]