    {-# 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           Config                   (Value)
    import           Config.Number            (Number)
    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 numbers
      NumberSpec :: PrimValueSpec Number

      -- | Matches any atom
      AtomSpec :: PrimValueSpec Text

      -- | 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

      -- | Specific value to be matched
      ExactSpec :: Value () -> PrimValueSpec ()

    -- | 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
      { forall a. ValueSpec a -> NonEmpty (Coyoneda PrimValueSpec a)
    unValueSpec :: NonEmpty (Coyoneda PrimValueSpec a) }
      deriving ((forall a b. (a -> b) -> ValueSpec a -> ValueSpec b)
    -> (forall a b. a -> ValueSpec b -> ValueSpec a)
    -> Functor ValueSpec
    forall a b. a -> ValueSpec b -> ValueSpec a
    forall a b. (a -> b) -> ValueSpec a -> ValueSpec b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall a b. (a -> b) -> ValueSpec a -> ValueSpec b
    fmap :: forall a b. (a -> b) -> ValueSpec a -> ValueSpec b
    $c<$ :: forall a b. a -> ValueSpec b -> ValueSpec a
    <$ :: forall a b. a -> ValueSpec b -> ValueSpec a
    Functor)

    -- | Lift a primitive value specification to 'ValueSpec'.
    --
    -- @since 0.2.0.0
    primValueSpec :: PrimValueSpec a -> ValueSpec a
    primValueSpec :: forall a. PrimValueSpec a -> ValueSpec a
    primValueSpec = NonEmpty (Coyoneda PrimValueSpec a) -> ValueSpec a
    forall a. NonEmpty (Coyoneda PrimValueSpec a) -> ValueSpec a
    MkValueSpec (NonEmpty (Coyoneda PrimValueSpec a) -> ValueSpec a)
    -> (PrimValueSpec a -> NonEmpty (Coyoneda PrimValueSpec a))
    -> PrimValueSpec a
    -> ValueSpec a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Coyoneda PrimValueSpec a -> NonEmpty (Coyoneda PrimValueSpec a)
    forall a. a -> NonEmpty a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Coyoneda PrimValueSpec a -> NonEmpty (Coyoneda PrimValueSpec a))
    -> (PrimValueSpec a -> Coyoneda PrimValueSpec a)
    -> PrimValueSpec a
    -> NonEmpty (Coyoneda PrimValueSpec a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PrimValueSpec a -> Coyoneda PrimValueSpec a
    forall (f :: * -> *) a. f a -> Coyoneda f a
    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 :: forall (f :: * -> *) a.
    Alt f =>
    (forall x. PrimValueSpec x -> f x) -> ValueSpec a -> f a
    runValueSpec forall x. PrimValueSpec x -> f x
    f = NonEmpty (f a) -> f a
    forall (t :: * -> *) (m :: * -> *) a.
    (Foldable1 t, Alt m) =>
    t (m a) -> m a
    asum1 (NonEmpty (f a) -> f a)
    -> (ValueSpec a -> NonEmpty (f a)) -> ValueSpec a -> f a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Coyoneda PrimValueSpec a -> f a)
    -> NonEmpty (Coyoneda PrimValueSpec a) -> NonEmpty (f a)
    forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((forall x. PrimValueSpec x -> f x)
    -> Coyoneda PrimValueSpec a -> f a
    forall (g :: * -> *) (f :: * -> *) b.
    Functor g =>
    (forall a. f a -> g a) -> Coyoneda f b -> g b
    runCoyoneda PrimValueSpec a -> f a
    forall x. PrimValueSpec x -> f x
    f) (NonEmpty (Coyoneda PrimValueSpec a) -> NonEmpty (f a))
    -> (ValueSpec a -> NonEmpty (Coyoneda PrimValueSpec a))
    -> ValueSpec a
    -> NonEmpty (f a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ValueSpec a -> NonEmpty (Coyoneda PrimValueSpec a)
    forall a. ValueSpec a -> NonEmpty (Coyoneda PrimValueSpec a)
    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_ :: forall m a.
    Semigroup m =>
    (forall x. PrimValueSpec x -> m) -> ValueSpec a -> m
    runValueSpec_ forall x. PrimValueSpec x -> m
    f = (Coyoneda PrimValueSpec a -> m)
    -> NonEmpty (Coyoneda PrimValueSpec a) -> m
    forall m a. Semigroup m => (a -> m) -> NonEmpty a -> m
    forall (t :: * -> *) m a.
    (Foldable1 t, Semigroup m) =>
    (a -> m) -> t a -> m
    foldMap1 ((forall x. PrimValueSpec x -> m) -> Coyoneda PrimValueSpec a -> m
    forall (f :: * -> *) m b. (forall a. f a -> m) -> Coyoneda f b -> m
    runCoyoneda_ PrimValueSpec a -> m
    forall x. PrimValueSpec x -> m
    f) (NonEmpty (Coyoneda PrimValueSpec a) -> m)
    -> (ValueSpec a -> NonEmpty (Coyoneda PrimValueSpec a))
    -> ValueSpec a
    -> m
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ValueSpec a -> NonEmpty (Coyoneda PrimValueSpec a)
    forall a. ValueSpec a -> NonEmpty (Coyoneda PrimValueSpec a)
    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 :: forall (g :: * -> *) (f :: * -> *) b.
    Functor g =>
    (forall a. f a -> g a) -> Coyoneda f b -> g b
    runCoyoneda forall a. f a -> g a
    f = Coyoneda g b -> g b
    forall (f :: * -> *) a. Functor f => Coyoneda f a -> f a
    lowerCoyoneda (Coyoneda g b -> g b)
    -> (Coyoneda f b -> Coyoneda g b) -> Coyoneda f b -> g b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (forall a. f a -> g a) -> Coyoneda f b -> Coyoneda g b
    forall (f :: * -> *) (g :: * -> *) b.
    (forall a. f a -> g a) -> Coyoneda f b -> Coyoneda g b
    hoistCoyoneda f a -> g a
    forall a. f a -> g a
    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_ :: forall (f :: * -> *) m b. (forall a. f a -> m) -> Coyoneda f b -> m
    runCoyoneda_ forall a. f a -> m
    f = Const m b -> m
    forall {k} a (b :: k). Const a b -> a
    getConst (Const m b -> m)
    -> (Coyoneda f b -> Const m b) -> Coyoneda f b -> m
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (forall a. f a -> Const m a) -> Coyoneda f b -> Const m b
    forall (g :: * -> *) (f :: * -> *) b.
    Functor g =>
    (forall a. f a -> g a) -> Coyoneda f b -> g b
    runCoyoneda (m -> Const m a
    forall {k} a (b :: k). a -> Const a b
    Const (m -> Const m a) -> (f a -> m) -> f a -> Const m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . f a -> m
    forall a. f a -> m
    f)

    -- | Left-biased choice between two specifications
    instance Alt ValueSpec where MkValueSpec NonEmpty (Coyoneda PrimValueSpec a)
    x <!> :: forall a. ValueSpec a -> ValueSpec a -> ValueSpec a
    <!> MkValueSpec NonEmpty (Coyoneda PrimValueSpec a)
    y = NonEmpty (Coyoneda PrimValueSpec a) -> ValueSpec a
    forall a. NonEmpty (Coyoneda PrimValueSpec a) -> ValueSpec a
    MkValueSpec (NonEmpty (Coyoneda PrimValueSpec a)
    x NonEmpty (Coyoneda PrimValueSpec a)
    -> NonEmpty (Coyoneda PrimValueSpec a)
    -> NonEmpty (Coyoneda PrimValueSpec a)
    forall a. NonEmpty a -> NonEmpty a -> NonEmpty a
    forall (f :: * -> *) a. Alt f => f a -> f a -> f a
    <!> NonEmpty (Coyoneda PrimValueSpec a)
    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 ((forall a b. (a -> b) -> SectionsSpec a -> SectionsSpec b)
    -> (forall a b. a -> SectionsSpec b -> SectionsSpec a)
    -> Functor SectionsSpec
    forall a b. a -> SectionsSpec b -> SectionsSpec a
    forall a b. (a -> b) -> SectionsSpec a -> SectionsSpec b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall a b. (a -> b) -> SectionsSpec a -> SectionsSpec b
    fmap :: forall a b. (a -> b) -> SectionsSpec a -> SectionsSpec b
    $c<$ :: forall a b. a -> SectionsSpec b -> SectionsSpec a
    <$ :: forall a b. a -> SectionsSpec b -> SectionsSpec a
    Functor, Functor SectionsSpec
    Functor SectionsSpec =>
    (forall a. a -> SectionsSpec a)
    -> (forall a b.
        SectionsSpec (a -> b) -> SectionsSpec a -> SectionsSpec b)
    -> (forall a b c.
        (a -> b -> c)
        -> SectionsSpec a -> SectionsSpec b -> SectionsSpec c)
    -> (forall a b. SectionsSpec a -> SectionsSpec b -> SectionsSpec b)
    -> (forall a b. SectionsSpec a -> SectionsSpec b -> SectionsSpec a)
    -> Applicative SectionsSpec
    forall a. a -> SectionsSpec a
    forall a b. SectionsSpec a -> SectionsSpec b -> SectionsSpec a
    forall a b. SectionsSpec a -> SectionsSpec b -> SectionsSpec b
    forall a b.
    SectionsSpec (a -> b) -> SectionsSpec a -> SectionsSpec b
    forall a b c.
    (a -> b -> c) -> SectionsSpec a -> SectionsSpec b -> SectionsSpec c
    forall (f :: * -> *).
    Functor f =>
    (forall a. a -> f a)
    -> (forall a b. f (a -> b) -> f a -> f b)
    -> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
    -> (forall a b. f a -> f b -> f b)
    -> (forall a b. f a -> f b -> f a)
    -> Applicative f
    $cpure :: forall a. a -> SectionsSpec a
    pure :: forall a. a -> SectionsSpec a
    $c<*> :: forall a b.
    SectionsSpec (a -> b) -> SectionsSpec a -> SectionsSpec b
    <*> :: forall a b.
    SectionsSpec (a -> b) -> SectionsSpec a -> SectionsSpec b
    $cliftA2 :: forall a b c.
    (a -> b -> c) -> SectionsSpec a -> SectionsSpec b -> SectionsSpec c
    liftA2 :: forall a b c.
    (a -> b -> c) -> SectionsSpec a -> SectionsSpec b -> SectionsSpec c
    $c*> :: forall a b. SectionsSpec a -> SectionsSpec b -> SectionsSpec b
    *> :: forall a b. SectionsSpec a -> SectionsSpec b -> SectionsSpec b
    $c<* :: forall a b. SectionsSpec a -> SectionsSpec b -> SectionsSpec a
    <* :: forall a b. SectionsSpec a -> SectionsSpec b -> SectionsSpec a
    Applicative)

    -- | Lift a single specification into a list of specifications.
    --
    -- @since 0.2.0.0
    primSectionsSpec :: PrimSectionSpec a -> SectionsSpec a
    primSectionsSpec :: forall a. PrimSectionSpec a -> SectionsSpec a
    primSectionsSpec = Ap PrimSectionSpec a -> SectionsSpec a
    forall a. Ap PrimSectionSpec a -> SectionsSpec a
    MkSectionsSpec (Ap PrimSectionSpec a -> SectionsSpec a)
    -> (PrimSectionSpec a -> Ap PrimSectionSpec a)
    -> PrimSectionSpec a
    -> SectionsSpec a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PrimSectionSpec a -> Ap PrimSectionSpec a
    forall (f :: * -> *) a. f a -> Ap f a
    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 :: forall (f :: * -> *) a.
    Applicative f =>
    (forall x. PrimSectionSpec x -> f x) -> SectionsSpec a -> f a
    runSections forall x. PrimSectionSpec x -> f x
    f (MkSectionsSpec Ap PrimSectionSpec a
    s) = (forall x. PrimSectionSpec x -> f x) -> Ap PrimSectionSpec a -> f a
    forall (g :: * -> *) (f :: * -> *) a.
    Applicative g =>
    (forall x. f x -> g x) -> Ap f a -> g a
    runAp PrimSectionSpec x -> f x
    forall x. PrimSectionSpec x -> f x
    f Ap PrimSectionSpec a
    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_ :: forall m a.
    Monoid m =>
    (forall x. PrimSectionSpec x -> m) -> SectionsSpec a -> m
    runSections_ forall x. PrimSectionSpec x -> m
    f (MkSectionsSpec Ap PrimSectionSpec a
    s) = (forall x. PrimSectionSpec x -> m) -> Ap PrimSectionSpec a -> m
    forall m (f :: * -> *) b.
    Monoid m =>
    (forall a. f a -> m) -> Ap f b -> m
    runAp_ PrimSectionSpec a -> m
    forall x. PrimSectionSpec x -> m
    f Ap PrimSectionSpec a
    s