packages feed

config-schema (empty) → 0.1.0.0

raw patch · 9 files changed

+769/−0 lines, 9 filesdep +basedep +config-valuedep +containerssetup-changed

Dependencies added: base, config-value, containers, free, kan-extensions, semigroupoids, text, transformers

Files

+ ChangeLog.md view
@@ -0,0 +1,5 @@+# Revision history for config-schema++## 0.1.0.0  -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,13 @@+Copyright (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.
+ README.md view
@@ -0,0 +1,88 @@+config-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)++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 qualified Data.Text.IO as Text+import           Data.Text (Text)+import           Data.Monoid ((<>))+import           Data.Functor.Alt ((<!>))++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+Right exampleValue = parse exampleFile++exampleSpec :: ValueSpecs Text+exampleSpec = sectionsSpec "" $+  do name  <- reqSection  "name" "Full name"+     age   <- reqSection  "age"  "Age of user"+     happy <- optSection' "happy" "Current happiness status" yesOrNo+     kids  <- reqSection' "kids"  "All children" (oneOrList kidSpec)++     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 :: ValueSpecs Text+kidSpec = sectionsSpec "kid" (reqSection "name" "Kid's name")+++-- | Matches the 'yes' and 'no' atoms+yesOrNo :: ValueSpecs Bool+yesOrNo = True  <$ atomSpec "yes" <!>+          False <$ atomSpec "no"+++printDoc :: IO ()+printDoc = Text.putStr (generateDocs exampleSpec)+-- *Example> printDoc+-- 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 [LoadError] Text+example = loadValue exampleSpec exampleValue+-- *Example> exampleVal+-- Right "Johny Appleseed is 99 years old and has kids Bob, Tom and is happy"+```
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ config-schema.cabal view
@@ -0,0 +1,37 @@+name:                config-schema+version:             0.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+cabal-version:       >=1.10+homepage:            https://github.com/glguy/config-schema+bug-reports:         https://github.com/glguy/config-schema/issues++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.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+  hs-source-dirs:       src+  default-language:     Haskell2010+  ghc-options:          -Wall
+ src/Config/Schema.hs view
@@ -0,0 +1,27 @@+{-|+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.++"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
+ src/Config/Schema/Docs.hs view
@@ -0,0 +1,128 @@+{-# Language 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 :: ValueSpecs (Text,Maybe Int)+configSpec = sectionsSpec ""+           $ liftA2 (,)+               (reqSection "username" "Name used to login")+               (optSection "attempts" "Number of login attempts")++generateDocs configSpec++-- Configuration file fields:+--     username: REQUIRED text+--        Name used to login+--     attempts: integer+--        Number of login attempts+@++-}+module Config.Schema.Docs+  ( generateDocs+  ) where++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           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'))++  where+    topname = ""+    Just top = Map.lookup topname m+    DocBuilder (m,"") = valuesDoc spec+    m' = Map.delete topname m++    sectionLines :: (Text, [Text]) -> [Text]+    sectionLines (name, fields)+      = ""+      : name+      : map ("    "<>) 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+++-- | Compute the documentation lines for a single key-value pair.+sectionDoc :: SectionSpec a -> DocBuilder [Text]+sectionDoc s =+  case s of+    ReqSection name desc w -> aux "REQUIRED " name desc <$> valuesDoc w+    OptSection name desc w -> aux ""          name desc <$> valuesDoc w+  where+    aux req name desc val =+      (name <> ": " <> req <> val)+      : if Text.null desc then [] else ["   " <> 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+++-- | Combine a list of text with the word @or@.+disjunction :: NonEmpty Text -> Text+disjunction = Text.intercalate " or " . NonEmpty.toList+++-- | Compute the documentation fragment for an individual value specification.+valueDoc :: ValueSpec a -> DocBuilder Text+valueDoc w =+  case w of+    TextSpec         -> return "text"+    IntegerSpec      -> return "integer"+    RationalSpec     -> return "number"+    AtomSpec a       -> return ("`" <> a <> "`")+    AnyAtomSpec      -> return "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+++-- | A writer-like type. A mapping of section names and documentation+-- lines is accumulated.+newtype DocBuilder a = DocBuilder (Map Text [Text], 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)
+ src/Config/Schema/Load.hs view
@@ -0,0 +1,174 @@+{-# Language OverloadedStrings, GeneralizedNewtypeDeriving, 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++  -- * Errors+  , LoadError(..)+  , Problem(..)+  ) where++import           Control.Applicative              (Alternative, optional)+import           Control.Monad                    (MonadPlus, unless, zipWithM)+import           Control.Monad.Trans.Class        (lift)+import           Control.Monad.Trans.State        (StateT(..), runStateT)+import           Control.Monad.Trans.Except+import           Control.Monad.Trans.Reader+import           Data.Foldable                    (asum)+import           Data.Monoid                      ((<>))+import           Data.Ratio                       (numerator, denominator)+import           Data.Text                        (Text)+import qualified Data.Text as Text++import           Config+import           Config.Schema.Spec+++-- | Match a 'Value' against a 'ValueSpecs' and return either+-- the interpretation of that value or the list of errors+-- encountered.+loadValue ::+  ValueSpecs a         {- ^ specification          -} ->+  Value                {- ^ value                  -} ->+  Either [LoadError] a {- ^ error 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)+     lift (scope k (getValue w v))+getSection (OptSection k _ w) =+  do mb <- optional (StateT (lookupSection 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+++getValue :: ValueSpecs a -> Value -> Load a+getValue s v = asum (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 _              TextSpec           = loadFail (SpecMismatch "text")+getValue1 _              IntegerSpec        = loadFail (SpecMismatch "integer")+getValue1 _              RationalSpec       = loadFail (SpecMismatch "rational")+getValue1 _              ListSpec{}         = loadFail (SpecMismatch "list")+getValue1 _              AnyAtomSpec        = loadFail (SpecMismatch "atom")+getValue1 _              (AtomSpec a)       = loadFail (SpecMismatch ("`" <> a <> "`"))+getValue1 _              (SectionSpecs l _) = loadFail (SpecMismatch l)+++-- | 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 w = zipWithM (\i x -> scope (Text.pack (show i)) (getValue w x)) [1::Int ..]+++-- | 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         -} ->+  Load a+getCustom l w v =+  do x <- getValue w v+     case x of+       Nothing -> loadFail (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)+  | key == k  = pure (v, xs)+  | otherwise = do (v',xs') <- lookupSection key xs+                   return (v',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++------------------------------------------------------------------------+-- Error reporting type+------------------------------------------------------------------------+++-- | Type used to match values against specifiations. This type tracks+-- the current nested fields (updated with scope) and can throw+-- errors using loadFail.+newtype Load a = MkLoad { unLoad :: ReaderT [Text] (Except [LoadError]) a }+  deriving (Functor, Applicative, Monad, Alternative, MonadPlus)++-- | 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)+++-- | Run the Load computation until it produces a result or terminates+-- with a list of errors.+runLoad :: Load a -> Either [LoadError] a+runLoad = runExcept . flip runReaderT [] . unLoad+++-- | 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+  deriving (Eq, Ord, Read, Show)++-- | Push a new key onto the stack of nested fields.+scope :: Text -> Load a -> Load a+scope key (MkLoad m) = MkLoad (local (key:) m)++-- | Abort value specification matching with the given error.+loadFail :: Problem -> Load a+loadFail cause = MkLoad $+  do path <- ask+     lift (throwE [LoadError (reverse path) cause])
+ src/Config/Schema/Spec.hs view
@@ -0,0 +1,295 @@+{-# Language FlexibleInstances, RankNTypes, GADTs, KindSignatures #-}+{-# Language GeneralizedNewtypeDeriving #-}++{-|+Module      : Config.Schema.Spec+Description : Types and 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 schemas can be built up using 'Applicative' operations.++These specifications are suitable for be consumed by "Config.Schema.Load"+and "Config.Schema.Docs".++This is the schema system used by the @glirc@ IRC client+<https://hackage.haskell.org/package/glirc>. For a significant example,+visit the "Client.Configuration" and "Client.Configuration.Colors" modules.++-}+module Config.Schema.Spec+  (+  -- * Specifying sections+    SectionSpecs(..)+  , reqSection+  , optSection+  , reqSection'+  , optSection'++  -- * Specifying values+  , ValueSpecs(..)+  , Spec(..)+  , sectionsSpec+  , atomSpec+  , anyAtomSpec+  , listSpec+  , customSpec+  , namedSpec++  -- * Derived specifications+  , oneOrList+  , numSpec+  , yesOrNoSpec+  , stringSpec++  -- * Executing specifications+  , runSections+  , runSections_+  , runValueSpecs+  , runValueSpecs_++  -- * Primitive specifications+  , SectionSpec(..)+  , ValueSpec(..)++  ) where++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.Alt                 (Alt(..))+import           Data.List.NonEmpty               (NonEmpty)+import           Data.Text                        (Text)+import qualified Data.Text as Text++------------------------------------------------------------------------+-- 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 SectionSpec :: * -> * where++  -- | Required section: Name, Documentation, Specification+  ReqSection :: Text -> Text -> ValueSpecs a -> SectionSpec a++  -- | Optional section: Name, Documentation, Specification+  OptSection :: Text -> Text -> ValueSpecs a -> SectionSpec (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.+newtype SectionSpecs a = MkSectionSpecs (Ap SectionSpec a)+  deriving (Functor, Applicative)+++-- | Lift a single specification into a list of specifications.+sectionSpec :: SectionSpec a -> SectionSpecs a+sectionSpec = MkSectionSpecs . liftAp+++runSections :: Applicative f => (forall x. SectionSpec x -> f x) -> SectionSpecs a -> f a+runSections f (MkSectionSpecs s) = runAp f s+++runSections_ :: Monoid m => (forall x. SectionSpec x -> m) -> SectionSpecs a -> m+runSections_ f (MkSectionSpecs s) = runAp_ f s+++------------------------------------------------------------------------+-- 'SectionSpecs' builders+------------------------------------------------------------------------+++-- | Specification for a required section with an implicit value specification.+reqSection ::+  Spec a =>+  Text {- ^ section name -} ->+  Text {- ^ description  -} ->+  SectionSpecs a+reqSection n i = sectionSpec (ReqSection n i valuesSpec)+++-- | Specification for a required section with an explicit value specification.+reqSection' ::+  Text         {- ^ section name        -} ->+  Text         {- ^ description         -} ->+  ValueSpecs a {- ^ value specification -} ->+  SectionSpecs a+reqSection' n i w = sectionSpec (ReqSection n i w)+++-- | Specification for an optional section with an implicit value specification.+optSection ::+  Spec a =>+  Text {- ^ section name -} ->+  Text {- ^ description  -} ->+  SectionSpecs (Maybe a)+optSection n i = sectionSpec (OptSection n i valuesSpec)+++-- | Specification for an optional section with an explicit value specification.+optSection' ::+  Text         {- ^ section name        -} ->+  Text         {- ^ description         -} ->+  ValueSpecs a {- ^ value specification -} ->+  SectionSpecs (Maybe a)+optSection' n i w = sectionSpec (OptSection n i w)+++------------------------------------------------------------------------+-- Specifications for values+------------------------------------------------------------------------++-- | The primitive specification descriptions for values. Specifications+-- built from these primitive cases are found in 'ValueSpecs'.+data ValueSpec :: * -> * where+  -- | Matches any string literal+  TextSpec :: ValueSpec Text++  -- | Matches integral numbers+  IntegerSpec :: ValueSpec Integer++  -- | Matches any number+  RationalSpec :: ValueSpec Rational++  -- | Matches any atom+  AnyAtomSpec  :: ValueSpec Text++  -- | Specific atom to be matched+  AtomSpec :: Text -> ValueSpec ()++  -- | Matches a list of the underlying specification+  ListSpec :: ValueSpecs a -> ValueSpec [a]++  -- | Documentation identifier and section specification+  SectionSpecs :: Text -> SectionSpecs a -> ValueSpec a++  -- | Documentation text, underlying specification+  CustomSpec :: Text -> ValueSpecs (Maybe a) -> ValueSpec a++  -- | Label used to hide complicated specs in documentation+  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.+newtype ValueSpecs a = MkValueSpecs { unValueSpecs :: Compose 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+++-- | 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)+++-- | Lift a primitive value specification to 'ValueSpecs'.+valueSpec :: ValueSpec a -> ValueSpecs a+valueSpec = MkValueSpecs . Compose . pure . liftCoyoneda+++------------------------------------------------------------------------+-- 'ValueSpecs' builders+------------------------------------------------------------------------+++-- | Class of value specifications that don't require arguments.+class    Spec a       where valuesSpec :: ValueSpecs a+instance Spec Text    where valuesSpec = valueSpec TextSpec+instance Spec Integer where valuesSpec = valueSpec IntegerSpec+instance Spec Rational where valuesSpec = valueSpec RationalSpec+instance Spec Int     where valuesSpec = fromInteger <$> valuesSpec+instance Spec a => Spec [a] where valuesSpec = valueSpec (ListSpec valuesSpec)+instance (Spec a, Spec b) => Spec (Either a b) where+  valuesSpec = Left <$> valuesSpec <!> Right <$> valuesSpec+++-- | Specification for matching a particular atom.+atomSpec :: Text -> ValueSpecs ()+atomSpec = valueSpec . AtomSpec++-- | Specification for matching any atom. Matched atom is returned.+anyAtomSpec :: ValueSpecs Text+anyAtomSpec = valueSpec AnyAtomSpec++-- | Specification for matching any text as a 'String'+stringSpec :: ValueSpecs String+stringSpec = Text.unpack <$> valuesSpec++-- | Specification for matching any integral number.+numSpec :: Num a => ValueSpecs a+numSpec = fromInteger <$> valuesSpec++-- | Specification for matching a list of values each satisfying a+-- given element specification.+listSpec :: ValueSpecs a -> ValueSpecs [a]+listSpec = valueSpec . 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 -} ->+  SectionSpecs a {- ^ underlying specification        -} ->+  ValueSpecs a+sectionsSpec i s = valueSpec (SectionSpecs i s)+++-- | Named value specification. This is useful for factoring complicated+-- value specifications out in the documentation to avoid repetition of+-- complex specifications.+namedSpec ::+  Text         {- ^ name                     -} ->+  ValueSpecs a {- ^ underlying specification -} ->+  ValueSpecs a+namedSpec n s = valueSpec (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 :: ValueSpecs a -> ValueSpecs [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 -> ValueSpecs a -> (a -> Maybe b) -> ValueSpecs b+customSpec lbl w f = valueSpec (CustomSpec lbl (f <$> w))+++-- | Specification for using @yes@ and @no@ to represent booleans 'True'+-- and 'False' respectively+yesOrNoSpec :: ValueSpecs Bool+yesOrNoSpec = True  <$ atomSpec (Text.pack "yes")+          <!> False <$ atomSpec (Text.pack "no")++------------------------------------------------------------------------++-- | 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)