{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications  #-}
module HaskellCI.Config.Docspec (
    DocspecConfig (..),
    docspecConfigGrammar,
) where

import HaskellCI.Prelude

import qualified Distribution.FieldGrammar    as C

import HaskellCI.OptionsGrammar

data DocspecConfig = DocspecConfig
    { DocspecConfig -> VersionRange
cfgDocspecEnabled :: !VersionRange
    , DocspecConfig -> [String]
cfgDocspecOptions :: [String]
    , DocspecConfig -> String
cfgDocspecUrl     :: String
    , DocspecConfig -> String
cfgDocspecHash    :: String
    }
  deriving (Int -> DocspecConfig -> ShowS
[DocspecConfig] -> ShowS
DocspecConfig -> String
(Int -> DocspecConfig -> ShowS)
-> (DocspecConfig -> String)
-> ([DocspecConfig] -> ShowS)
-> Show DocspecConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DocspecConfig -> ShowS
showsPrec :: Int -> DocspecConfig -> ShowS
$cshow :: DocspecConfig -> String
show :: DocspecConfig -> String
$cshowList :: [DocspecConfig] -> ShowS
showList :: [DocspecConfig] -> ShowS
Show, (forall x. DocspecConfig -> Rep DocspecConfig x)
-> (forall x. Rep DocspecConfig x -> DocspecConfig)
-> Generic DocspecConfig
forall x. Rep DocspecConfig x -> DocspecConfig
forall x. DocspecConfig -> Rep DocspecConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DocspecConfig -> Rep DocspecConfig x
from :: forall x. DocspecConfig -> Rep DocspecConfig x
$cto :: forall x. Rep DocspecConfig x -> DocspecConfig
to :: forall x. Rep DocspecConfig x -> DocspecConfig
Generic, Get DocspecConfig
[DocspecConfig] -> Put
DocspecConfig -> Put
(DocspecConfig -> Put)
-> Get DocspecConfig
-> ([DocspecConfig] -> Put)
-> Binary DocspecConfig
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
$cput :: DocspecConfig -> Put
put :: DocspecConfig -> Put
$cget :: Get DocspecConfig
get :: Get DocspecConfig
$cputList :: [DocspecConfig] -> Put
putList :: [DocspecConfig] -> Put
Binary)

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

defaultDocspecConfig :: DocspecConfig
defaultDocspecConfig :: DocspecConfig
defaultDocspecConfig = DocspecConfig
    { cfgDocspecEnabled :: VersionRange
cfgDocspecEnabled = VersionRange
noVersion
    , cfgDocspecOptions :: [String]
cfgDocspecOptions = []
    , cfgDocspecUrl :: String
cfgDocspecUrl     = String
"https://github.com/phadej/cabal-extras/releases/download/cabal-docspec-0.0.0.20231219/cabal-docspec-0.0.0.20231219-x86_64-linux.xz"
    , cfgDocspecHash :: String
cfgDocspecHash    = String
"8b60448275466bbe2b9409741b5dd07a41c541283017b95b44efe6e31379d067"
    }

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

docspecConfigGrammar
    :: (OptionsGrammar c g, Applicative (g DocspecConfig))
    => g DocspecConfig DocspecConfig
docspecConfigGrammar :: forall (c :: * -> Constraint) (g :: * -> * -> *).
(OptionsGrammar c g, Applicative (g DocspecConfig)) =>
g DocspecConfig DocspecConfig
docspecConfigGrammar = VersionRange -> [String] -> String -> String -> DocspecConfig
DocspecConfig
    (VersionRange -> [String] -> String -> String -> DocspecConfig)
-> g DocspecConfig VersionRange
-> g DocspecConfig ([String] -> String -> String -> DocspecConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldName
-> ALens' DocspecConfig VersionRange
-> VersionRange
-> g DocspecConfig 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
"docspec"                                              (forall (name :: Symbol) r a (f :: * -> *).
(HasField name r a, Functor f) =>
(a -> f a) -> r -> f r
field @"cfgDocspecEnabled") (DocspecConfig -> VersionRange
cfgDocspecEnabled DocspecConfig
defaultDocspecConfig)
        g DocspecConfig VersionRange
-> (g DocspecConfig VersionRange -> g DocspecConfig VersionRange)
-> g DocspecConfig VersionRange
forall a b. a -> (a -> b) -> b
^^^ String
-> g DocspecConfig VersionRange -> g DocspecConfig 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 Docspec job"
    g DocspecConfig ([String] -> String -> String -> DocspecConfig)
-> g DocspecConfig [String]
-> g DocspecConfig (String -> String -> DocspecConfig)
forall a b.
g DocspecConfig (a -> b) -> g DocspecConfig a -> g DocspecConfig b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([String] -> List NoCommaFSep Token' String)
-> ALens' DocspecConfig [String]
-> g DocspecConfig [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
"docspec-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 @"cfgDocspecOptions")
        g DocspecConfig [String]
-> (g DocspecConfig [String] -> g DocspecConfig [String])
-> g DocspecConfig [String]
forall a b. a -> (a -> b) -> b
^^^ String
-> String -> g DocspecConfig [String] -> g DocspecConfig [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 Docspec options"
    g DocspecConfig (String -> String -> DocspecConfig)
-> g DocspecConfig String
-> g DocspecConfig (String -> DocspecConfig)
forall a b.
g DocspecConfig (a -> b) -> g DocspecConfig a -> g DocspecConfig b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> (String -> Token')
-> ALens' DocspecConfig String
-> String
-> g DocspecConfig String
forall b a s.
(c b, Newtype a b, Eq a) =>
FieldName -> (a -> b) -> ALens' s a -> a -> g s a
forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Newtype a b, Eq a) =>
FieldName -> (a -> b) -> ALens' s a -> a -> g s a
C.optionalFieldDefAla FieldName
"docspec-url"      String -> Token'
C.Token'                            (forall (name :: Symbol) r a (f :: * -> *).
(HasField name r a, Functor f) =>
(a -> f a) -> r -> f r
field @"cfgDocspecUrl") (DocspecConfig -> String
cfgDocspecUrl DocspecConfig
defaultDocspecConfig)
        g DocspecConfig String
-> (g DocspecConfig String -> g DocspecConfig String)
-> g DocspecConfig String
forall a b. a -> (a -> b) -> b
^^^ String
-> String -> g DocspecConfig String -> g DocspecConfig 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
"URL" String
"URL to download cabal-docspec"
    g DocspecConfig (String -> DocspecConfig)
-> g DocspecConfig String -> g DocspecConfig DocspecConfig
forall a b.
g DocspecConfig (a -> b) -> g DocspecConfig a -> g DocspecConfig b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> (String -> Token')
-> ALens' DocspecConfig String
-> String
-> g DocspecConfig String
forall b a s.
(c b, Newtype a b, Eq a) =>
FieldName -> (a -> b) -> ALens' s a -> a -> g s a
forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Newtype a b, Eq a) =>
FieldName -> (a -> b) -> ALens' s a -> a -> g s a
C.optionalFieldDefAla FieldName
"docspec-hash"     String -> Token'
C.Token'                            (forall (name :: Symbol) r a (f :: * -> *).
(HasField name r a, Functor f) =>
(a -> f a) -> r -> f r
field @"cfgDocspecHash") (DocspecConfig -> String
cfgDocspecHash DocspecConfig
defaultDocspecConfig)
        g DocspecConfig String
-> (g DocspecConfig String -> g DocspecConfig String)
-> g DocspecConfig String
forall a b. a -> (a -> b) -> b
^^^ String
-> String -> g DocspecConfig String -> g DocspecConfig 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
"HASH" String
"SHA256 of cabal-docspec"