{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications  #-}
module HaskellCI.Config.Doctest where

import HaskellCI.Prelude

import Distribution.Version (majorBoundVersion)

import qualified Distribution.FieldGrammar      as C
import qualified Distribution.Types.PackageName as C

import HaskellCI.OptionsGrammar

data DoctestConfig = DoctestConfig
    { DoctestConfig -> VersionRange
cfgDoctestEnabled       :: !VersionRange
    , DoctestConfig -> [String]
cfgDoctestOptions       :: [String]
    , DoctestConfig -> VersionRange
cfgDoctestVersion       :: !VersionRange
    , DoctestConfig -> [PackageName]
cfgDoctestFilterEnvPkgs :: ![C.PackageName]
    , DoctestConfig -> [PackageName]
cfgDoctestFilterSrcPkgs :: ![C.PackageName]
    }
  deriving (Int -> DoctestConfig -> ShowS
[DoctestConfig] -> ShowS
DoctestConfig -> String
(Int -> DoctestConfig -> ShowS)
-> (DoctestConfig -> String)
-> ([DoctestConfig] -> ShowS)
-> Show DoctestConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DoctestConfig -> ShowS
showsPrec :: Int -> DoctestConfig -> ShowS
$cshow :: DoctestConfig -> String
show :: DoctestConfig -> String
$cshowList :: [DoctestConfig] -> ShowS
showList :: [DoctestConfig] -> ShowS
Show, (forall x. DoctestConfig -> Rep DoctestConfig x)
-> (forall x. Rep DoctestConfig x -> DoctestConfig)
-> Generic DoctestConfig
forall x. Rep DoctestConfig x -> DoctestConfig
forall x. DoctestConfig -> Rep DoctestConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DoctestConfig -> Rep DoctestConfig x
from :: forall x. DoctestConfig -> Rep DoctestConfig x
$cto :: forall x. Rep DoctestConfig x -> DoctestConfig
to :: forall x. Rep DoctestConfig x -> DoctestConfig
Generic, Get DoctestConfig
[DoctestConfig] -> Put
DoctestConfig -> Put
(DoctestConfig -> Put)
-> Get DoctestConfig
-> ([DoctestConfig] -> Put)
-> Binary DoctestConfig
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
$cput :: DoctestConfig -> Put
put :: DoctestConfig -> Put
$cget :: Get DoctestConfig
get :: Get DoctestConfig
$cputList :: [DoctestConfig] -> Put
putList :: [DoctestConfig] -> Put
Binary)

-------------------------------------------------------------------------------
-- Default
-------------------------------------------------------------------------------

defaultDoctestVersion :: VersionRange
defaultDoctestVersion :: VersionRange
defaultDoctestVersion = Version -> VersionRange
majorBoundVersion ([Int] -> Version
mkVersion [Int
0,Int
22,Int
0])

-------------------------------------------------------------------------------
-- Grammar
-------------------------------------------------------------------------------

doctestConfigGrammar
    :: (OptionsGrammar c g, Applicative (g DoctestConfig))
    => g DoctestConfig DoctestConfig
doctestConfigGrammar :: forall (c :: * -> Constraint) (g :: * -> * -> *).
(OptionsGrammar c g, Applicative (g DoctestConfig)) =>
g DoctestConfig DoctestConfig
doctestConfigGrammar = VersionRange
-> [String]
-> VersionRange
-> [PackageName]
-> [PackageName]
-> DoctestConfig
DoctestConfig
    (VersionRange
 -> [String]
 -> VersionRange
 -> [PackageName]
 -> [PackageName]
 -> DoctestConfig)
-> g DoctestConfig VersionRange
-> g DoctestConfig
     ([String]
      -> VersionRange -> [PackageName] -> [PackageName] -> DoctestConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldName
-> ALens' DoctestConfig VersionRange
-> VersionRange
-> g DoctestConfig VersionRange
forall s.
FieldName
-> ALens' s VersionRange -> VersionRange -> g s VersionRange
forall (c :: * -> Constraint) (p :: * -> * -> *) s.
OptionsGrammar c p =>
FieldName
-> ALens' s VersionRange -> VersionRange -> p s VersionRange
rangeField         FieldName
"doctest"                                              (forall (name :: Symbol) r a (f :: * -> *).
(HasField name r a, Functor f) =>
(a -> f a) -> r -> f r
field @"cfgDoctestEnabled") VersionRange
noVersion
        g DoctestConfig VersionRange
-> (g DoctestConfig VersionRange -> g DoctestConfig VersionRange)
-> g DoctestConfig VersionRange
forall a b. a -> (a -> b) -> b
^^^ String
-> g DoctestConfig VersionRange -> g DoctestConfig VersionRange
forall s a. String -> g s a -> g s a
forall (c :: * -> Constraint) (p :: * -> * -> *) s a.
OptionsGrammar c p =>
String -> p s a -> p s a
help String
"Enable Doctest job"
    g DoctestConfig
  ([String]
   -> VersionRange -> [PackageName] -> [PackageName] -> DoctestConfig)
-> g DoctestConfig [String]
-> g DoctestConfig
     (VersionRange -> [PackageName] -> [PackageName] -> DoctestConfig)
forall a b.
g DoctestConfig (a -> b) -> g DoctestConfig a -> g DoctestConfig b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([String] -> List NoCommaFSep Token' String)
-> ALens' DoctestConfig [String]
-> g DoctestConfig [String]
forall b a s.
(c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
C.monoidalFieldAla FieldName
"doctest-options" (NoCommaFSep
-> (String -> Token') -> [String] -> List NoCommaFSep Token' String
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
C.alaList' NoCommaFSep
C.NoCommaFSep String -> Token'
C.Token')  (forall (name :: Symbol) r a (f :: * -> *).
(HasField name r a, Functor f) =>
(a -> f a) -> r -> f r
field @"cfgDoctestOptions")
        g DoctestConfig [String]
-> (g DoctestConfig [String] -> g DoctestConfig [String])
-> g DoctestConfig [String]
forall a b. a -> (a -> b) -> b
^^^ String
-> String -> g DoctestConfig [String] -> g DoctestConfig [String]
forall s a. String -> String -> g s a -> g s a
forall (c :: * -> Constraint) (p :: * -> * -> *) s a.
OptionsGrammar c p =>
String -> String -> p s a -> p s a
metahelp String
"OPTS" String
"Additional Doctest options"
    g DoctestConfig
  (VersionRange -> [PackageName] -> [PackageName] -> DoctestConfig)
-> g DoctestConfig VersionRange
-> g DoctestConfig
     ([PackageName] -> [PackageName] -> DoctestConfig)
forall a b.
g DoctestConfig (a -> b) -> g DoctestConfig a -> g DoctestConfig b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ALens' DoctestConfig VersionRange
-> VersionRange
-> g DoctestConfig VersionRange
forall (c :: * -> Constraint) (g :: * -> * -> *) s a.
(FieldGrammar c g, Functor (g s), c (Identity a), Eq a) =>
FieldName -> ALens' s a -> a -> g s a
C.optionalFieldDef FieldName
"doctest-version"                                      (forall (name :: Symbol) r a (f :: * -> *).
(HasField name r a, Functor f) =>
(a -> f a) -> r -> f r
field @"cfgDoctestVersion") VersionRange
defaultDoctestVersion
        g DoctestConfig VersionRange
-> (g DoctestConfig VersionRange -> g DoctestConfig VersionRange)
-> g DoctestConfig VersionRange
forall a b. a -> (a -> b) -> b
^^^ String
-> String
-> g DoctestConfig VersionRange
-> g DoctestConfig VersionRange
forall s a. String -> String -> g s a -> g s a
forall (c :: * -> Constraint) (p :: * -> * -> *) s a.
OptionsGrammar c p =>
String -> String -> p s a -> p s a
metahelp String
"RANGE" String
"Doctest version"
    g DoctestConfig ([PackageName] -> [PackageName] -> DoctestConfig)
-> g DoctestConfig [PackageName]
-> g DoctestConfig ([PackageName] -> DoctestConfig)
forall a b.
g DoctestConfig (a -> b) -> g DoctestConfig a -> g DoctestConfig b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([PackageName]
    -> List NoCommaFSep (Identity PackageName) PackageName)
-> ALens' DoctestConfig [PackageName]
-> g DoctestConfig [PackageName]
forall b a s.
(c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
C.monoidalFieldAla FieldName
"doctest-filter-packages" (NoCommaFSep
-> [PackageName]
-> List NoCommaFSep (Identity PackageName) PackageName
forall sep a. sep -> [a] -> List sep (Identity a) a
C.alaList NoCommaFSep
C.NoCommaFSep)    (forall (name :: Symbol) r a (f :: * -> *).
(HasField name r a, Functor f) =>
(a -> f a) -> r -> f r
field @"cfgDoctestFilterEnvPkgs")
        g DoctestConfig [PackageName]
-> (g DoctestConfig [PackageName] -> g DoctestConfig [PackageName])
-> g DoctestConfig [PackageName]
forall a b. a -> (a -> b) -> b
^^^ String
-> String
-> g DoctestConfig [PackageName]
-> g DoctestConfig [PackageName]
forall s a. String -> String -> g s a -> g s a
forall (c :: * -> Constraint) (p :: * -> * -> *) s a.
OptionsGrammar c p =>
String -> String -> p s a -> p s a
metahelp String
"PKGS" String
"Filter packages from .ghc.environment file"
    g DoctestConfig ([PackageName] -> DoctestConfig)
-> g DoctestConfig [PackageName] -> g DoctestConfig DoctestConfig
forall a b.
g DoctestConfig (a -> b) -> g DoctestConfig a -> g DoctestConfig b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([PackageName]
    -> List NoCommaFSep (Identity PackageName) PackageName)
-> ALens' DoctestConfig [PackageName]
-> g DoctestConfig [PackageName]
forall b a s.
(c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
C.monoidalFieldAla FieldName
"doctest-skip" (NoCommaFSep
-> [PackageName]
-> List NoCommaFSep (Identity PackageName) PackageName
forall sep a. sep -> [a] -> List sep (Identity a) a
C.alaList NoCommaFSep
C.NoCommaFSep)               (forall (name :: Symbol) r a (f :: * -> *).
(HasField name r a, Functor f) =>
(a -> f a) -> r -> f r
field @"cfgDoctestFilterSrcPkgs")
        g DoctestConfig [PackageName]
-> (g DoctestConfig [PackageName] -> g DoctestConfig [PackageName])
-> g DoctestConfig [PackageName]
forall a b. a -> (a -> b) -> b
^^^ String
-> String
-> g DoctestConfig [PackageName]
-> g DoctestConfig [PackageName]
forall s a. String -> String -> g s a -> g s a
forall (c :: * -> Constraint) (p :: * -> * -> *) s a.
OptionsGrammar c p =>
String -> String -> p s a -> p s a
metahelp String
"PKGS" String
"Skip doctests for these packages"