config-schema-1.1.0.0/0000755000000000000000000000000007346545000012543 5ustar0000000000000000config-schema-1.1.0.0/ChangeLog.md0000755000000000000000000000376307346545000014730 0ustar0000000000000000# Revision history for config-schema ## 1.1.0.0 * Simplify field types of `ValueSpecMismatch` * More aggressively eliminate `TypeMismatch` and `WrongAtom` when other, more specific errors, are available. ## 1.0.0.0 * Rename `ValueSpec` to `PrimValueSpec` * Rename `ValueSpecs` to `ValueSpec` * Rename `SectionSpec` to `PrimSectionSpec` * Rename `SectionSpecs` to `SectionsSpec` * Rename `Spec` class to `HasSpec` * Rename `valuesSpec` to `anySpec` * Custom specifications changed type to expose an error message. * Move spec types to `Config.Schema.Types`. Now `Config.Schema.Spec` has only the exports needed for building specs and not defining new spec consumers. * Improve schema mismatch type and errors in `Config.Schema.Load.Error` ## 0.5.0.1 * Support GHC 8.4.1 ## 0.5.0.0 * Add Spec instances for Int and Word types. All instances including the previous Int instance now validate ranges. * Changed argument order for `loadValueFromFile` ## 0.4.1.0 * Add `loadValueFromFile` and `SchemaError`. This is intended as a quick way to get a configuration file loaded with all errors being thrown as exceptions. ## 0.4.0.0 * Parameterize the Load module on a position type * Allow Docs module to process recursively defined specifications as long as a named section breaks the loop. * Add parentheses to docs when needed ## 0.3.1.1 -- 2017-05-17 * Add support for GHC 7.10.3 ## 0.3.1.0 -- 2017-05-16 * Allow `generateDocs` to work on any ValueSpec, rather than top-level empty-named section specs. ## 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` * Add `fractionalSpec` * Add `nonemptySpec` and `oneOrNonemptySpec` * `loadValue` returns a `NonEmpty LoadError` ## 0.1.0.0 -- 2017-05-06 * First version. Released on an unsuspecting world. config-schema-1.1.0.0/LICENSE0000644000000000000000000000133207346545000013547 0ustar0000000000000000Copyright (c) 2017 Eric Mertens Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above copyright notice and this permission notice appear in all copies. THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. config-schema-1.1.0.0/README.md0000755000000000000000000000576507346545000014042 0ustar0000000000000000config-schema ============= [![Hackage](https://img.shields.io/hackage/v/config-schema.svg)](https://hackage.haskell.org/package/config-schema) [![Build Status](https://secure.travis-ci.org/glguy/config-schema.png?branch=master)](http://travis-ci.org/glguy/config-schema) Live Demo -------- The config-value and config-schema packages are available in a [live demo](https://glguy.net/config-demo/). About -------- This package allows the user to define configuration schemas suitable for matching against configuration files written in the [config-value](https://hackage.haskell.org/package/config-value) format. These schemas allow the user to extract an arbitrary Haskell value from an interpretation of a configuration file. It also allows the user to programatically generate documentation for the configuration files accepted by the loader. ```haskell {-# Language OverloadedStrings, ApplicativeDo #-} module Example where import qualified Data.Text as Text import Data.Text (Text) import Data.Monoid ((<>)) import Data.Functor.Alt (()) import Data.List.NonEmpty (NonEmpty) import Config import Config.Schema exampleFile :: Text exampleFile = " name: \"Johny Appleseed\" \n\ \ age : 99 \n\ \ happy: yes \n\ \ kids: \n\ \ * name: \"Bob\" \n\ \ * name: \"Tom\" \n" exampleValue :: Value Position Right exampleValue = parse exampleFile exampleSpec :: ValueSpec Text exampleSpec = sectionsSpec "" $ do name <- reqSection "name" "Full name" age <- reqSection "age" "Age of user" happy <- optSection' "happy" yesOrNo "Current happiness status" kids <- reqSection' "kids" (oneOrList kidSpec) "All children's names" return $ let happyText = case happy of Just True -> " and is happy" Just False -> " and is not happy" Nothing -> " and is private" in name <> " is " <> Text.pack (show (age::Integer)) <> " years old and has kids " <> Text.intercalate ", " kids <> happyText kidSpec :: ValueSpec Text kidSpec = sectionsSpec "kid" (reqSection "name" "Kid's name") -- | Matches the 'yes' and 'no' atoms yesOrNo :: ValueSpec Bool yesOrNo = True <$ atomSpec "yes" False <$ atomSpec "no" printDoc :: IO () printDoc = print (generateDocs exampleSpec) -- *Example> printDoc -- Top-level configuration file fields: -- name: REQUIRED text -- Full name -- age: REQUIRED integer -- Age of user -- happy: `yes` or `no` -- Current happiness status -- kids: REQUIRED kid or list of kid -- All children -- -- kid -- name: REQUIRED text -- Kid's name example :: Either (NonEmpty (LoadError Position)) Text example = loadValue exampleSpec exampleValue -- *Example> exampleVal -- Right "Johny Appleseed is 99 years old and has kids Bob, Tom and is happy" ``` config-schema-1.1.0.0/Setup.hs0000644000000000000000000000005607346545000014200 0ustar0000000000000000import Distribution.Simple main = defaultMain config-schema-1.1.0.0/config-schema.cabal0000644000000000000000000000416407346545000016237 0ustar0000000000000000cabal-version: 2.2 name: config-schema version: 1.1.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. These schemas can be used to be process a configuration file into a Haskell value, or to automatically generate documentation for the file format. license: ISC license-file: LICENSE author: Eric Mertens maintainer: emertens@gmail.com copyright: Eric Mertens 2017 category: Language build-type: Simple extra-source-files: ChangeLog.md README.md homepage: https://github.com/glguy/config-schema bug-reports: https://github.com/glguy/config-schema/issues tested-with: GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.4, GHC==8.6.5 source-repository head type: git location: https://github.com/glguy/config-schema library exposed-modules: Config.Schema Config.Schema.Docs Config.Schema.Load Config.Schema.Load.Error Config.Schema.Spec Config.Schema.Types build-depends: base >=4.8 && <4.13, config-value >=0.6 && <0.7, containers >=0.5 && <0.7, free >=4.12 && <5.2, kan-extensions >=5.0.2 && <5.3, pretty >=1.1.2 && <1.2, semigroupoids >=5.1 && <5.4, text >=1.2 && <1.3, transformers >=0.4 && <0.6, if flag(use-semigroups) build-depends: base <4.9, semigroups >=0.18 && <0.19 else build-depends: base >= 4.9 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 flag use-semigroups default: False manual: False config-schema-1.1.0.0/src/Config/0000755000000000000000000000000007346545000014537 5ustar0000000000000000config-schema-1.1.0.0/src/Config/Schema.hs0000644000000000000000000000175307346545000016301 0ustar0000000000000000{-| Module : Config.Schema Description : Top-level module rexporting child modules Copyright : (c) Eric Mertens, 2017 License : ISC Maintainer : emertens@gmail.com This package makes it possible to define schemas for configuration files. These schemas can be used to generate a validating configuration file loader, and to produce documentation about the supported format. For documentation on the file format, see the module. "Config.Schema.Spec" provides definitions used to make new schemas. "Config.Schema.Load" uses schemas to match schemas against configuration values. "Config.Schema.Docs" generates textual documentation for a schema. -} module Config.Schema ( module Config.Schema.Spec , module Config.Schema.Docs , module Config.Schema.Load ) where import Config.Schema.Docs import Config.Schema.Load import Config.Schema.Spec config-schema-1.1.0.0/src/Config/Schema/0000755000000000000000000000000007346545000015737 5ustar0000000000000000config-schema-1.1.0.0/src/Config/Schema/Docs.hs0000644000000000000000000001445307346545000017172 0ustar0000000000000000{-# Language RecursiveDo, OverloadedStrings, GADTs, GeneralizedNewtypeDeriving #-} {-| Module : Config.Schema.Docs Description : Documentation generation for config schemas Copyright : (c) Eric Mertens, 2017 License : ISC Maintainer : emertens@gmail.com This module generates a simple textual documentation format for a configuration schema. Each subsection and named value specification will generate it's own top-level component in the documentation. This module is only one of the ways one could generate documentation for a particular configuration specification. All of the defintions would would need to be able to generate another form are exported by "Config.Schema.Spec". @ configSpec :: ValueSpec (Text,Maybe Int) configSpec = sectionsSpec "" $ liftA2 (,) (reqSection "username" "Name used to login") (optSection "attempts" "Number of login attempts") generateDocs configSpec -- Top-level configuration file fields: -- username: REQUIRED text -- Name used to login -- attempts: integer -- Number of login attempts @ -} module Config.Schema.Docs ( generateDocs ) where import Control.Applicative (liftA2) import Control.Monad (unless) import Control.Monad.Trans.State.Strict (runState, get, put, State) import Data.List (intersperse) import Data.List.NonEmpty (NonEmpty((:|))) import Data.Map (Map) import Data.Monoid (Monoid(..)) import qualified Data.Map as Map import qualified Data.Semigroup as S import Data.Text (Text) import qualified Data.Text as Text import Text.PrettyPrint (Doc, fsep, text, (<>), ($+$), (<+>), nest, empty, hsep, parens) import Prelude hiding ((<>)) import Config.Schema.Spec import Config.Schema.Types -- | Default documentation generator. generateDocs :: ValueSpec a -> Doc generateDocs spec = vcat' docLines where sectionLines :: (Text, Doc) -> [Doc] sectionLines (name, fields) = [text "", txt name, nest 4 fields] (topDoc, topMap) = runDocBuilder (valuesDoc False spec) docLines = case runValueSpec_ (pure . SomeSpec) spec of -- single, top-level sections spec SomeSpec (SectionsSpec name _) :| [] | Just top <- Map.lookup name topMap -> txt "Top-level configuration file fields:" : nest 4 top : concatMap sectionLines (Map.toList (Map.delete name topMap)) -- otherwise _ -> txt "Top-level configuration file format:" : nest 4 topDoc : concatMap sectionLines (Map.toList topMap) -- | Forget the type of the value spec data SomeSpec where SomeSpec :: PrimValueSpec a -> SomeSpec -- | Compute the documentation for a list of sections, store the -- documentation in the sections map and return the name of the section. sectionsDoc :: Text -> SectionsSpec 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 :: PrimSectionSpec a -> DocBuilder Doc sectionDoc s = case s of ReqSection name desc w -> aux "REQUIRED" name desc <$> valuesDoc False w OptSection name desc w -> aux empty name desc <$> valuesDoc False w where aux req name desc val = (txt name <> ":") <+> req <+> val $+$ if Text.null desc then empty else nest 4 (fsep (txt <$> Text.splitOn " " desc)) -- line wrap logic -- | Compute the documentation line for a particular value specification. -- Any sections contained in the specification will be stored in the -- sections map. -- -- Set nested to 'True' when using valuesDoc in a nested context and -- parentheses would be needed in the case of multiple alternatives. valuesDoc :: Bool {- ^ nested -} -> ValueSpec a -> DocBuilder Doc valuesDoc nested = fmap (disjunction nested) . sequenceA . runValueSpec_ (fmap pure valueDoc) -- | Combine a list of text with the word @or@. disjunction :: Bool {- ^ nested -} -> [Doc] -> Doc disjunction _ [x] = x disjunction True xs = parens (hsep (intersperse "or" xs)) disjunction False xs = hsep (intersperse "or" xs) -- | Compute the documentation fragment for an individual value specification. valueDoc :: PrimValueSpec a -> DocBuilder Doc valueDoc w = case w of TextSpec -> pure "text" IntegerSpec -> pure "integer" RationalSpec -> pure "number" AtomSpec a -> pure ("`" <> txt a <> "`") AnyAtomSpec -> pure "atom" SectionsSpec l s -> sectionsDoc l s NamedSpec l s -> emitDoc l (valuesDoc False s) CustomSpec l w' -> (txt l <+>) <$> valuesDoc True w' ListSpec ws -> ("list of" <+>) <$> valuesDoc True ws AssocSpec ws -> ("association list of" <+>) <$> valuesDoc True ws -- | A writer-like type. A mapping of section names and documentation -- lines is accumulated. newtype DocBuilder a = DocBuilder (State (Map Text Doc) a) deriving (Functor, Applicative, Monad) runDocBuilder :: DocBuilder a -> (a, Map Text Doc) runDocBuilder (DocBuilder b) = runState b mempty -- | lifts underlying 'S.Semigroup' instance instance S.Semigroup a => S.Semigroup (DocBuilder a) where (<>) = liftA2 (S.<>) -- | lifts underlying 'Monoid' instance instance (S.Semigroup a, Monoid a) => Monoid (DocBuilder a) where mempty = pure mempty mappend = (S.<>) -- | Given a section name and section body, store the body -- in the map of sections and return the section name. emitDoc :: Text {- ^ section name -} -> DocBuilder Doc {- ^ section body -} -> DocBuilder Doc {- ^ section name doc -} emitDoc l (DocBuilder sub) = DocBuilder $ do m <- get unless (Map.member l m) $ do rec put $! Map.insert l val m val <- sub return () return (txt l) -- by using a recursively defined do block and -- inserting the element /before/ executing the @sub@ -- action we ensure that @sub@ doesn't attempt to -- also explore elements named @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 config-schema-1.1.0.0/src/Config/Schema/Load.hs0000644000000000000000000001457007346545000017161 0ustar0000000000000000{-# Language GADTs #-} {-| Module : Config.Schema.Load Description : Operations to extract a value from a configuration. Copyright : (c) Eric Mertens, 2017 License : ISC Maintainer : emertens@gmail.com This module automates the extraction of a decoded value from a configuration value according to a specification as built using "Config.Schema.Spec". -} module Config.Schema.Load ( loadValue , loadValueFromFile -- * Errors , ValueSpecMismatch(..) , PrimMismatch(..) , Problem(..) ) where import Control.Exception (throwIO) import Control.Monad (zipWithM) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.State (StateT(..), runStateT, state) import Control.Monad.Trans.Except (Except, runExcept, throwE, withExcept) import Data.Ratio (numerator, denominator) import Data.List.NonEmpty (NonEmpty) import qualified Data.List.NonEmpty as NonEmpty import Data.Text (Text) import qualified Data.Text.IO as Text import Config import Config.Schema.Types import Config.Schema.Load.Error -- | Match a 'Value' against a 'ValueSpec' and return either -- the interpretation of that value or the list of errors -- encountered. loadValue :: ValueSpec a {- ^ specification -} -> Value p {- ^ value -} -> Either (ValueSpecMismatch p) a {- ^ errors or decoded value -} loadValue spec val = runExcept (getValue spec val) -- | Read a configuration file, parse it, and validate it according -- to the given specification. -- -- Throws 'IOError', 'ParseError', or 'ValueSpecMismatch' loadValueFromFile :: ValueSpec a {- ^ specification -} -> FilePath {- ^ filename -} -> IO a loadValueFromFile spec path = do txt <- Text.readFile path let exceptIO m = either throwIO return m val <- exceptIO (parse txt) exceptIO (loadValue spec val) getSection :: PrimSectionSpec a -> StateT [Section p] (Except (Problem p)) a getSection (ReqSection k _ w) = do mb <- state (lookupSection k) lift $ case mb of Just v -> getValue' (SubkeyProblem k) w v Nothing -> throwE (MissingSection k) getSection (OptSection k _ w) = do mb <- state (lookupSection k) lift (traverse (getValue' (SubkeyProblem k) w) mb) getSections :: SectionsSpec a -> [Section p] -> Except (Problem p) a getSections spec xs = do (a,leftovers) <- runStateT (runSections getSection spec) xs case NonEmpty.nonEmpty leftovers of Nothing -> return a Just ss -> throwE (UnusedSections (fmap sectionName ss)) getValue :: ValueSpec a -> Value p -> Except (ValueSpecMismatch p) a getValue s v = withExcept (ValueSpecMismatch (valueAnn v) (describeValue v)) (runValueSpec (getValue1 v) s) -- | Match a 'Value' against a 'ValueSpec' given a wrapper for any nested -- mismatch errors that might occur. getValue' :: (ValueSpecMismatch p -> Problem p) -> ValueSpec a -> Value p -> Except (Problem p) a getValue' p s v = withExcept (p . ValueSpecMismatch (valueAnn v) (describeValue v)) (runValueSpec (getValue1 v) s) getValue1 :: Value p -> PrimValueSpec a -> Except (NonEmpty (PrimMismatch p)) a getValue1 v prim = withExcept (pure . PrimMismatch (describeSpec prim)) (getValue2 v prim) -- | Match a primitive value specification against a single value. getValue2 :: Value p -> PrimValueSpec a -> Except (Problem p) a getValue2 (Text _ t) TextSpec = pure t getValue2 (Number _ _ n) IntegerSpec = pure n getValue2 (Floating _ a b) IntegerSpec | Just i <- floatingToInteger a b = pure i getValue2 (Number _ _ n) RationalSpec = pure (fromInteger n) getValue2 (Floating _ a b) RationalSpec = pure (floatingToRational a b) getValue2 (List _ xs) (ListSpec w) = getList w xs getValue2 (Atom _ b) AnyAtomSpec = pure (atomName b) getValue2 (Atom _ b) (AtomSpec a) | a == atomName b = pure () | otherwise = throwE WrongAtom getValue2 (Sections _ s) (SectionsSpec _ w) = getSections w s getValue2 (Sections _ s) (AssocSpec w) = getAssoc w s getValue2 v (NamedSpec _ w) = getValue' NestedProblem w v getValue2 v (CustomSpec _ w) = getCustom w v getValue2 _ _ = throwE TypeMismatch -- | 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 :: ValueSpec a -> [Value p] -> Except (Problem p) [a] getList w = zipWithM (\i -> getValue' (ListElementProblem i) w) [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 :: ValueSpec a -> [Section p] -> Except (Problem p) [(Text,a)] getAssoc w = traverse $ \(Section _ k v) -> (,) k <$> getValue' (SubkeyProblem k) w v -- | Match a value against its specification. If 'Just' is matched -- return the value. If 'Nothing is matched, report an error. getCustom :: ValueSpec (Either Text a) {- ^ specification -} -> Value p {- ^ value -} -> Except (Problem p) a getCustom w v = either (throwE . CustomProblem) pure =<< getValue' NestedProblem w v -- | Extract a section from a list of sections by name. lookupSection :: Text {- ^ section name -} -> [Section p] {- ^ available sections -} -> (Maybe (Value p), [Section p]) {- ^ found value and remaining sections -} lookupSection _ [] = (Nothing, []) lookupSection key (s@(Section _ k v):xs) | key == k = (Just v, xs) | otherwise = case lookupSection key xs of (res, xs') -> (res, s:xs') ------------------------------------------------------------------------ -- | Interpret a @config-value@ floating point number as a 'Rational'. floatingToRational :: Integer -> Integer -> Rational floatingToRational x y = fromInteger x * 10^^y -- | Interpret a @config-value@ floating point number as an 'Integer' -- if possible. floatingToInteger :: Integer -> Integer -> Maybe Integer floatingToInteger x y | denominator r == 1 = Just (numerator r) | otherwise = Nothing where r = floatingToRational x y config-schema-1.1.0.0/src/Config/Schema/Load/0000755000000000000000000000000007346545000016616 5ustar0000000000000000config-schema-1.1.0.0/src/Config/Schema/Load/Error.hs0000644000000000000000000001764507346545000020260 0ustar0000000000000000{-# Language GADTs, OverloadedStrings #-} {-| Module : Config.Schema.Load.Error Description : Error types and rendering for Load module Copyright : (c) Eric Mertens, 2019 License : ISC Maintainer : emertens@gmail.com This module provides a complete skeleton of the failures that occurred when trying to match a 'Value' against a 'ValueSpec' allowing custom error rendering to be implemented. The structure is you get a single value and a list of one-or-more primitive specifications that it failed to match along with an enumeration of why that specification failed to match. Some failures are due to failures in nested specifications, so the whole error structure can form a tree. -} module Config.Schema.Load.Error ( -- * Error types ValueSpecMismatch(..) , PrimMismatch(..) , Problem(..) , ErrorAnnotation(..) -- * Detailed rendering , prettyValueSpecMismatch , prettyPrimMismatch , prettyProblem -- * Summaries , describeSpec , describeValue ) where import Control.Exception import Data.Text (Text) import Data.Foldable (toList) import qualified Data.Text as Text import Data.List.NonEmpty (NonEmpty((:|))) import qualified Data.List.NonEmpty as NonEmpty import Data.Typeable (Typeable) import Text.PrettyPrint (Doc, fsep, ($+$), nest, text, vcat, (<+>), empty, punctuate, comma, int, colon, hcat) import Data.Monoid ((<>)) import Config import Config.Schema.Types -- | Newtype wrapper for schema load errors. data ValueSpecMismatch p = -- | Problem value and list of specification failures ValueSpecMismatch p Text (NonEmpty (PrimMismatch p)) deriving Show -- | 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 PrimMismatch p = -- | spec description and problem PrimMismatch Text (Problem p) deriving Show -- | Problems that can be encountered when matching a 'Value' against a 'ValueSpec'. data Problem p = MissingSection Text -- ^ missing section name | UnusedSections (NonEmpty Text) -- ^ unused section names | SubkeyProblem Text (ValueSpecMismatch p) -- ^ nested error in given section | ListElementProblem Int (ValueSpecMismatch p) -- ^ nested error in given list element | NestedProblem (ValueSpecMismatch p) -- ^ generic nested error | TypeMismatch -- ^ value and spec type mismatch | CustomProblem Text -- ^ custom spec error message | WrongAtom -- ^ atoms didn't match deriving Show -- | Describe outermost shape of a 'PrimValueSpec' describeSpec :: PrimValueSpec a -> Text describeSpec TextSpec = "text" describeSpec IntegerSpec = "integer" describeSpec RationalSpec = "number" describeSpec AnyAtomSpec = "atom" describeSpec (AtomSpec a) = "atom `" <> a <> "`" describeSpec (ListSpec _) = "list" describeSpec (SectionsSpec name _) = name describeSpec (AssocSpec _) = "sections" describeSpec (CustomSpec name _) = name describeSpec (NamedSpec name _) = name -- | Describe outermost shape of a 'Value' describeValue :: Value p -> Text describeValue Text{} = "text" describeValue Number{} = "integer" describeValue Floating{} = "number" describeValue (Atom _ a) = "atom `" <> atomName a <> "`" describeValue Sections{} = "sections" describeValue List{} = "list" -- | Bottom-up transformation of a 'ValueSpecMismatch' rewriteMismatch :: (ValueSpecMismatch p -> ValueSpecMismatch p) -> ValueSpecMismatch p -> ValueSpecMismatch p rewriteMismatch f (ValueSpecMismatch p v prims) = f (ValueSpecMismatch p v (fmap aux1 prims)) where aux1 (PrimMismatch spec prob) = PrimMismatch spec (aux2 prob) aux2 (SubkeyProblem x y) = SubkeyProblem x (rewriteMismatch f y) aux2 (ListElementProblem x y) = ListElementProblem x (rewriteMismatch f y) aux2 (NestedProblem y) = NestedProblem (rewriteMismatch f y) aux2 prob = prob -- | Single-step rewrite that removes type-mismatch problems if there -- are non-mismatches available to focus on. removeTypeMismatch1 :: ValueSpecMismatch p -> ValueSpecMismatch p removeTypeMismatch1 (ValueSpecMismatch p v xs) | Just xs' <- NonEmpty.nonEmpty (NonEmpty.filter (not . isTypeMismatch) xs) = ValueSpecMismatch p v xs' removeTypeMismatch1 v = v isTypeMismatch :: PrimMismatch p -> Bool isTypeMismatch (PrimMismatch _ prob) = case prob of WrongAtom -> True TypeMismatch -> True NestedProblem x -> go x SubkeyProblem _ x -> go x ListElementProblem _ x -> go x _ -> False where go (ValueSpecMismatch _ _ xs) = all isTypeMismatch xs -- | Single-step rewrite that removes mismatches with only a single, -- nested mismatch below them. focusMismatch1 :: ValueSpecMismatch p -> ValueSpecMismatch p focusMismatch1 x@(ValueSpecMismatch _ _ prims) | PrimMismatch _ problem :| [] <- prims , Just sub <- simplify1 problem = sub | otherwise = x where simplify1 (SubkeyProblem _ p) = Just p simplify1 (ListElementProblem _ p) = Just p simplify1 (NestedProblem p) = Just p simplify1 _ = Nothing -- | Pretty-printer for 'ValueSpecMismatch' showing the position -- and type of value that failed to match along with details about -- each specification that it didn't match. prettyValueSpecMismatch :: ErrorAnnotation p => ValueSpecMismatch p -> Doc prettyValueSpecMismatch (ValueSpecMismatch p v es) = heading $+$ errors where heading = displayAnnotation p <> text (Text.unpack v) errors = vcat (map prettyPrimMismatch (toList es)) -- | Pretty-printer for 'PrimMismatch' showing a summary of the primitive -- specification that didn't match followed by a more detailed error when -- appropriate. prettyPrimMismatch :: ErrorAnnotation p => PrimMismatch p -> Doc prettyPrimMismatch (PrimMismatch spec problem) = case prettyProblem problem of (summary, detail) -> (text "*" <+> text (Text.unpack spec) <+> summary) $+$ nest 4 detail -- | Pretty-printer for 'Problem' that generates a summary line -- as well as a detailed description (depending on the error) prettyProblem :: ErrorAnnotation p => Problem p -> (Doc, Doc) {- ^ summary, detailed -} prettyProblem p = case p of TypeMismatch -> ( text "- type mismatch" , empty) WrongAtom -> ( text "- wrong atom" , empty) MissingSection name -> ( text "- missing section:" <+> text (Text.unpack name) , empty) UnusedSections names -> ( text "- unexpected sections:" <+> fsep (punctuate comma (map (text . Text.unpack) (toList names))) , empty) CustomProblem e -> ( text "-" <+> text (Text.unpack e) , empty) SubkeyProblem name e -> ( text "- problem in section:" <+> text (Text.unpack name) , prettyValueSpecMismatch e) NestedProblem e -> ( empty , prettyValueSpecMismatch e) ListElementProblem i e -> ( text "- problem in element:" <+> int i , prettyValueSpecMismatch e) -- | Class for rendering position annotations within the 'prettyValueSpecMismatch' class (Typeable a, Show a) => ErrorAnnotation a where displayAnnotation :: a -> Doc -- | Renders a 'Position' as @line:column:@ instance ErrorAnnotation Position where displayAnnotation pos = hcat [int (posLine pos), colon, int (posColumn pos), colon] -- | Renders as an empty document instance ErrorAnnotation () where displayAnnotation _ = empty -- | 'displayException' implemented with 'prettyValueSpecMismatch' instance ErrorAnnotation p => Exception (ValueSpecMismatch p) where displayException = show . prettyValueSpecMismatch . rewriteMismatch (focusMismatch1 . removeTypeMismatch1) config-schema-1.1.0.0/src/Config/Schema/Spec.hs0000644000000000000000000002612707346545000017175 0ustar0000000000000000{-# Language FlexibleInstances, OverloadedStrings #-} {-| Module : Config.Schema.Spec Description : Operations for describing a configuration file format. Copyright : (c) Eric Mertens, 2017 License : ISC Maintainer : emertens@gmail.com This module provides a set of types and operations for defining configuration file schemas. These specifications are can be consumed by "Config.Schema.Load" and "Config.Schema.Docs". This is the schema system used by the @glirc@ IRC client . For a significant example, visit the "Client.Configuration" and "Client.Configuration.Colors" modules. -} module Config.Schema.Spec ( -- * Specifying values -- $values ValueSpec , sectionsSpec , assocSpec , atomSpec , anyAtomSpec , listSpec , customSpec , namedSpec , HasSpec(..) -- * Specifying sections -- $sections , SectionsSpec , reqSection , optSection , reqSection' , optSection' -- * Derived specifications , oneOrList , yesOrNoSpec , stringSpec , numSpec , fractionalSpec , nonemptySpec , oneOrNonemptySpec ) where import Data.Bits (Bits, toIntegralSized) import Data.Functor.Alt (Alt(..)) import Data.Int import Data.List.NonEmpty (NonEmpty) import qualified Data.List.NonEmpty as NonEmpty import Data.Text (Text) import qualified Data.Text as Text import Data.Word import Config.Schema.Types ------------------------------------------------------------------------ -- 'ValueSpec' builders ------------------------------------------------------------------------ -- $values -- -- 'ValueSpec' allows you to define specifications that will match -- parsed config-value configuration files. 'ValueSpec' allows -- us to define the shape of configuration values that will match -- the specification as well as a way to process those matches. -- -- Below we have an example configuration record that can be matched -- from a configuration file. -- -- More documentation for defining key-value pairs is available below. -- -- This configuration file expects either a given username or allows -- the user to ask for a random username. The ('') operator allows -- us to combine two alternatives as seen below. The config-value -- language distinguishes between atoms like @random@ and strings like -- @"random"@ allowing unambiguous special cases to be added in addition -- to free-form text. -- -- @ -- {-\# Language RecordWildCards, OverloadedStrings, ApplicativeDo \#-} -- module Example where -- -- import "Config.Schema" -- import "Data.Functor.Alt" (('')) -- import "Data.Maybe" ('Data.Maybe.fromMaybe') -- import "Data.Text" ('Text') -- -- data Config = Config -- { userName :: UserName -- , retries :: 'Int' -- } -- -- data UserName = Random | Given 'Text' -- -- userNameSpec :: ValueSpec UserName -- userNameSpec = Random '<$' 'atomSpec' \"random\" -- '' Given '<$>' 'anySpec' -- matches string literals -- -- nameExample :: 'ValueSpec' Config -- nameExample = 'sectionsSpec' \"config\" '$' -- -- do userName <- 'reqSection'' \"username\" userNameSpec \"Configured user name\" -- -- retries <- 'Data.Maybe.fromMaybe' 3 -- '<$>' 'optSection' \"retries\" \"Number of attempts (default: 3)\" -- -- 'pure' Config{..} -- @ -- -- Examples: -- -- > username: random -- > retries: 5 -- > -- Generates: Config { userName = Random, retries = 5 } -- -- We can omit the retries: -- -- > username: random -- > -- Generates: Config { userName = Random, retries = 3 } -- -- We can specify a specific username as a string literal instead -- of using the atom @random@: -- -- > username: "me" -- > -- Generates: Config { userName = Given "me", retries = 3 } -- -- Sections can be reordered: -- -- > retries: 5 -- > username: random -- > -- Generates: Config { userName = Random, retries = 5 } -- | Class of value specifications that don't require arguments. class HasSpec a where anySpec :: ValueSpec a instance HasSpec Text where anySpec = primValueSpec TextSpec instance HasSpec Integer where anySpec = primValueSpec IntegerSpec instance HasSpec Rational where anySpec = primValueSpec RationalSpec instance HasSpec Int where anySpec = sizedBitsSpec "machine-bit signed" instance HasSpec Int8 where anySpec = sizedBitsSpec "8-bit signed" instance HasSpec Int16 where anySpec = sizedBitsSpec "16-bit signed" instance HasSpec Int32 where anySpec = sizedBitsSpec "32-bit signed" instance HasSpec Int64 where anySpec = sizedBitsSpec "64-bit signed" instance HasSpec Word where anySpec = sizedBitsSpec "machine-bit unsigned" instance HasSpec Word8 where anySpec = sizedBitsSpec "8-bit unsigned" instance HasSpec Word16 where anySpec = sizedBitsSpec "16-bit unsigned" instance HasSpec Word32 where anySpec = sizedBitsSpec "32-bit unsigned" instance HasSpec Word64 where anySpec = sizedBitsSpec "64-bit unsigned" instance HasSpec a => HasSpec [a] where anySpec = primValueSpec (ListSpec anySpec) instance (HasSpec a, HasSpec b) => HasSpec (Either a b) where anySpec = Left <$> anySpec Right <$> anySpec sizedBitsSpec :: (Integral a, Bits a) => Text -> ValueSpec a sizedBitsSpec name = customSpec name (primValueSpec IntegerSpec) check where check i = case toIntegralSized i of Nothing -> Left "out of bounds" Just j -> Right j -- | Specification for matching a particular atom. atomSpec :: Text -> ValueSpec () atomSpec = primValueSpec . AtomSpec -- | Specification for matching any atom. Matched atom is returned. anyAtomSpec :: ValueSpec Text anyAtomSpec = primValueSpec AnyAtomSpec -- | Specification for matching any text as a 'String' stringSpec :: ValueSpec String stringSpec = Text.unpack <$> anySpec -- | Specification for matching any integral number. numSpec :: Num a => ValueSpec a numSpec = fromInteger <$> anySpec -- | Specification for matching any fractional number. -- -- @since 0.2.0.0 fractionalSpec :: Fractional a => ValueSpec a fractionalSpec = fromRational <$> anySpec -- | Specification for matching a list of values each satisfying a -- given element specification. listSpec :: ValueSpec a -> ValueSpec [a] listSpec = primValueSpec . ListSpec -- | Named subsection value specification. The unique identifier will be used -- for generating a documentation section for this specification and should -- be unique within the scope of the specification being built. sectionsSpec :: Text {- ^ unique documentation identifier -} -> SectionsSpec a {- ^ underlying specification -} -> ValueSpec a sectionsSpec i s = primValueSpec (SectionsSpec 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 :: ValueSpec a {- ^ underlying specification -} -> ValueSpec [(Text,a)] assocSpec = primValueSpec . AssocSpec -- | Named value specification. This is useful for factoring complicated -- value specifications out in the documentation to avoid repetition of -- complex specifications. namedSpec :: Text {- ^ name -} -> ValueSpec a {- ^ underlying specification -} -> ValueSpec a namedSpec n s = primValueSpec (NamedSpec n s) -- | Specification that matches either a single element or multiple -- elements in a list. This can be convenient for allowing the user -- to avoid having to specify singleton lists in the configuration file. oneOrList :: ValueSpec a -> ValueSpec [a] oneOrList s = pure <$> s listSpec s -- | The custom specification allows an arbitrary function to be used -- to validate the value extracted by a specification. If 'Nothing' -- is returned the value is considered to have failed validation. customSpec :: Text -> ValueSpec a -> (a -> Either Text b) -> ValueSpec b customSpec lbl w f = primValueSpec (CustomSpec lbl (f <$> w)) -- | Specification for using @yes@ and @no@ to represent booleans 'True' -- and 'False' respectively yesOrNoSpec :: ValueSpec Bool yesOrNoSpec = True <$ atomSpec (Text.pack "yes") False <$ atomSpec (Text.pack "no") -- | Matches a non-empty list. -- -- @since 0.2.0.0 nonemptySpec :: ValueSpec a -> ValueSpec (NonEmpty a) nonemptySpec s = customSpec "nonempty" (listSpec s) check where check xs = case NonEmpty.nonEmpty xs of Nothing -> Left "empty list" Just xxs -> Right xxs -- | Matches a single element or a non-empty list. -- -- @since 0.2.0.0 oneOrNonemptySpec :: ValueSpec a -> ValueSpec (NonEmpty a) oneOrNonemptySpec s = pure <$> s nonemptySpec s ------------------------------------------------------------------------ -- 'SectionsSpec' builders ------------------------------------------------------------------------ -- $sections -- Sections specifications allow you to define an unordered collection -- of required and optional sections using a convenient 'Applicative' -- do-notation syntax. -- -- Let's consider an example of a way to specify a name given a base -- and optional suffix. -- -- @ -- {-\# Language OverloadedStrings, ApplicativeDo \#-} -- module Example where -- -- import "Config.Schema" -- import "Data.Text" ('Text') -- -- nameExample :: 'ValueSpec' 'Text' -- nameExample = -- 'sectionsSpec' \"name\" '$' -- do x <- 'reqSection' \"base\" \"Base name\" -- y <- 'optSection' \"suffix\" \"Optional name suffix\" -- 'pure' ('maybe' x (x '<>') y) -- @ -- -- Example configuration components and their extracted values. -- -- > base: "VAR" -- > optional: "1" -- > -- Generates: VAR1 -- -- Order doesn't matter -- -- > optional: "1" -- > base: "VAR" -- > -- Generates: VAR1 -- -- Optional fields can be omitted -- -- > base: "VAR" -- > -- Generates: VAR -- -- Unexpected sections will generate errors to help detect typos -- -- > base: "VAR" -- > extra: 0 -- > -- Failure due to unexpected extra section -- -- All required sections must appear for successful match -- -- > optional: "1" -- > -- Failure due to missing required section -- | Specification for a required section with an implicit value specification. reqSection :: HasSpec a => Text {- ^ section name -} -> Text {- ^ description -} -> SectionsSpec a reqSection n = reqSection' n anySpec -- | Specification for a required section with an explicit value specification. reqSection' :: Text {- ^ section name -} -> ValueSpec a {- ^ value specification -} -> Text {- ^ description -} -> SectionsSpec a reqSection' n w i = primSectionsSpec (ReqSection n i w) -- | Specification for an optional section with an implicit value specification. optSection :: HasSpec a => Text {- ^ section name -} -> Text {- ^ description -} -> SectionsSpec (Maybe a) optSection n = optSection' n anySpec -- | Specification for an optional section with an explicit value specification. optSection' :: Text {- ^ section name -} -> ValueSpec a {- ^ value specification -} -> Text {- ^ description -} -> SectionsSpec (Maybe a) optSection' n w i = primSectionsSpec (OptSection n i w) config-schema-1.1.0.0/src/Config/Schema/Types.hs0000644000000000000000000001636407346545000017411 0ustar0000000000000000{-# Language CPP, KindSignatures, RankNTypes, GADTs, DeriveTraversable, GeneralizedNewtypeDeriving #-} {-| Module : Config.Schema.Types Description : Types for describing a configuration file format. Copyright : (c) Eric Mertens, 2017 License : ISC Maintainer : emertens@gmail.com This module defines the syntax of value specifications. Specifications can be defined using "Config.Schema.Spec" and can be consumed with "Config.Schema.Load" and "Config.Schema.Doc". This module defines high-level 'ValueSpec' and @SectionsSpec@ types that are intended to be used by normal library users. This types are implemented in terms of primitive 'PrimValueSpec' and 'PrimSectionSpec' types. These primitives are what consumers of specifications will need to use. -} module Config.Schema.Types ( -- * Value specification ValueSpec , PrimValueSpec(..) , primValueSpec , runValueSpec , runValueSpec_ -- * Unordered section-value pairs specification , SectionsSpec , PrimSectionSpec(..) , primSectionsSpec , runSections , runSections_ ) where import Control.Applicative (Const(..)) import Control.Applicative.Free (Ap, liftAp, runAp, runAp_) import Data.Functor.Alt (Alt(..)) import Data.Functor.Coyoneda (Coyoneda(..), liftCoyoneda, lowerCoyoneda, hoistCoyoneda) import Data.List.NonEmpty (NonEmpty) import Data.Semigroup.Foldable (asum1, foldMap1) import Data.Text (Text) #if !MIN_VERSION_base(4,11,0) import Data.Semigroup (Semigroup) #endif ------------------------------------------------------------------------ -- Specifications for values ------------------------------------------------------------------------ -- | The primitive specification descriptions for values. Specifications -- built from these primitive cases are found in 'ValueSpec'. data PrimValueSpec :: * -> * where -- | Matches any string literal TextSpec :: PrimValueSpec Text -- | Matches integral numbers IntegerSpec :: PrimValueSpec Integer -- | Matches any number RationalSpec :: PrimValueSpec Rational -- | Matches any atom AnyAtomSpec :: PrimValueSpec Text -- | Specific atom to be matched AtomSpec :: Text -> PrimValueSpec () -- | Matches a list of the underlying specification ListSpec :: ValueSpec a -> PrimValueSpec [a] -- | Documentation identifier and sections specification SectionsSpec :: Text -> SectionsSpec a -> PrimValueSpec a -- | Matches an arbitrary list of sections. Similar to 'SectionsSpec' -- except that that the section names are user-defined. AssocSpec :: ValueSpec a -> PrimValueSpec [(Text,a)] -- | Documentation text and underlying specification. This specification -- will match values where the underlying specification returns a -- 'Right' value. Otherwise a 'Left' should contain a short failure -- explanation. CustomSpec :: Text -> ValueSpec (Either Text a) -> PrimValueSpec a -- | Label used to hide complex specifications in documentation. NamedSpec :: Text -> ValueSpec a -> PrimValueSpec a -- | Non-empty disjunction of value specifications. This type is the primary -- way to specify expected values. -- -- Multiple specifications can be combined using this type's 'Alt' instance. -- -- To create 'ValueSpec' values see "Config.Schema.Spec" newtype ValueSpec a = MkValueSpec { unValueSpec :: NonEmpty (Coyoneda PrimValueSpec a) } deriving (Functor) -- | Lift a primitive value specification to 'ValueSpec'. -- -- @since 0.2.0.0 primValueSpec :: PrimValueSpec a -> ValueSpec a primValueSpec = MkValueSpec . pure . liftCoyoneda -- | Given an interpretation of a primitive value specification, extract a list of -- the possible interpretations of a disjunction of value specifications. Each of -- these primitive interpretations will be combined using the provided 'Alt' instance. runValueSpec :: Alt f => (forall x. PrimValueSpec x -> f x) -> ValueSpec a -> f a runValueSpec f = asum1 . fmap (runCoyoneda f) . unValueSpec -- | Given an interpretation of a primitive value specification, extract a list of -- the possible interpretations of a disjunction of value specifications. Each of -- these primitive interpretations will be combined using the provided 'Semigroup' instance. runValueSpec_ :: Semigroup m => (forall x. PrimValueSpec x -> m) -> ValueSpec a -> m runValueSpec_ f = foldMap1 (runCoyoneda_ f) . unValueSpec -- 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) -- | Left-biased choice between two specifications instance Alt ValueSpec where MkValueSpec x MkValueSpec y = MkValueSpec (x y) ------------------------------------------------------------------------ -- Specifications for sections ------------------------------------------------------------------------ -- | Specifications for single configuration sections. -- -- The fields are section name, documentation text, value specification. -- Use 'ReqSection' for required key-value pairs and 'OptSection' for -- optional ones. data PrimSectionSpec :: * -> * where -- | Required section: Name, Documentation, Specification ReqSection :: Text -> Text -> ValueSpec a -> PrimSectionSpec a -- | Optional section: Name, Documentation, Specification OptSection :: Text -> Text -> ValueSpec a -> PrimSectionSpec (Maybe a) -- | A list of section specifications used to process a whole group of -- key-value pairs. Multiple section specifications can be combined -- using this type's 'Applicative' instance. -- -- To create @SectionsSpec@ values see "Config.Schema.Spec" newtype SectionsSpec a = MkSectionsSpec (Ap PrimSectionSpec a) deriving (Functor, Applicative) -- | Lift a single specification into a list of specifications. -- -- @since 0.2.0.0 primSectionsSpec :: PrimSectionSpec a -> SectionsSpec a primSectionsSpec = MkSectionsSpec . liftAp -- | Given an function that handles a single, primitive section specification; -- 'runSections' will generate one that processes a whole @SectionsSpec@. -- -- The results from each section will be sequence together using the 'Applicative' -- instance in of the result type, and the results can be indexed by the type -- parameter of the specification. -- -- For an example use of 'runSections', see "Config.Schema.Load". runSections :: Applicative f => (forall x. PrimSectionSpec x -> f x) -> SectionsSpec a -> f a runSections f (MkSectionsSpec s) = runAp f s -- | Given an function that handles a single, primitive section specification; -- 'runSections_' will generate one that processes a whole @SectionsSpec@. -- -- The results from each section will be sequence together using the 'Monoid' -- instance in of the result type, and the results will not be indexed by the -- type parameter of the specifications. -- -- For an example use of 'runSections_', see "Config.Schema.Docs". runSections_ :: Monoid m => (forall x. PrimSectionSpec x -> m) -> SectionsSpec a -> m runSections_ f (MkSectionsSpec s) = runAp_ f s config-schema-1.1.0.0/tests/0000755000000000000000000000000007346545000013705 5ustar0000000000000000config-schema-1.1.0.0/tests/Main.hs0000644000000000000000000000641207346545000015130 0ustar0000000000000000{-# 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 => ValueSpec 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 anySpec ("Hello world"::Text) [["\"Hello world\""] ,["\"H\\101l\\&l\\o157 \\" ," \\w\\x6frld\""] ] , test anySpec (1234::Integer) [["1234"] ,["1234.0"] ] , test anySpec (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 anySpec) ([]::[Integer]) [["[]"] ,["[ ]"]] , test (listSpec anyAtomSpec) ["ḿyatoḿ"] [["[ḿyatoḿ]"] ,[" [ ḿyatoḿ ] "] ,["* ḿyatoḿ"] ] , test anySpec [1,2,3::Int] [["[1,2,3]"] ,["[1,2,3,]"] ,["* 1" ,"* 2" ,"* 3"] ] , test (listSpec anySpec) [[1,2],[3,4::Int]] [["[[1,2,],[3,4]]"] ,["*[1,2]" ,"*[3,4]"] ,["**1" ," *2" ,"* *3" ," *4" ] ] , test (assocSpec anySpec) ([]::[(Text,Int)]) [["{}"] ,["{ }"] ] , test (assocSpec anySpec) [("k1",10::Int), ("k2",20)] [["{k1: 10, k2: 20}"] ,["{k1: 10, k2: 20,}"] ,["k1 : 10" ,"k2: 20"] ] , test anySpec [ 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 ())) () [["{}"] ] ]