{-# LANGUAGE FunctionalDependencies  #-}
module HaskellCI.Config.Dump where

import HaskellCI.Prelude

import qualified Distribution.Compat.Newtype as C
import qualified Distribution.FieldGrammar   as C
import qualified Distribution.Pretty         as C

import HaskellCI.OptionsGrammar

-- TODO: with Cabal-2.6 this can be prettier, using Pretty.Field
newtype DumpGrammar s a = DG { forall s a. DumpGrammar s a -> [String]
runDG :: [String] }
  deriving (forall a b. (a -> b) -> DumpGrammar s a -> DumpGrammar s b)
-> (forall a b. a -> DumpGrammar s b -> DumpGrammar s a)
-> Functor (DumpGrammar s)
forall a b. a -> DumpGrammar s b -> DumpGrammar s a
forall a b. (a -> b) -> DumpGrammar s a -> DumpGrammar s b
forall s a b. a -> DumpGrammar s b -> DumpGrammar s a
forall s a b. (a -> b) -> DumpGrammar s a -> DumpGrammar s b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall s a b. (a -> b) -> DumpGrammar s a -> DumpGrammar s b
fmap :: forall a b. (a -> b) -> DumpGrammar s a -> DumpGrammar s b
$c<$ :: forall s a b. a -> DumpGrammar s b -> DumpGrammar s a
<$ :: forall a b. a -> DumpGrammar s b -> DumpGrammar s a
Functor

instance Applicative (DumpGrammar s) where
    pure :: forall a. a -> DumpGrammar s a
pure a
_ = [String] -> DumpGrammar s a
forall s a. [String] -> DumpGrammar s a
DG []
    DG [String]
f <*> :: forall a b.
DumpGrammar s (a -> b) -> DumpGrammar s a -> DumpGrammar s b
<*> DG [String]
x = [String] -> DumpGrammar s b
forall s a. [String] -> DumpGrammar s a
DG ([String]
f [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
x)

instance C.FieldGrammar C.Pretty DumpGrammar where
    blurFieldGrammar :: forall a b d. ALens' a b -> DumpGrammar b d -> DumpGrammar a d
blurFieldGrammar ALens' a b
_ = DumpGrammar b d -> DumpGrammar a d
forall a b. Coercible a b => a -> b
coerce

    uniqueFieldAla :: forall b a s.
(Pretty b, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> DumpGrammar s a
uniqueFieldAla FieldName
_ a -> b
_ ALens' s a
_ = [String] -> DumpGrammar s a
forall s a. [String] -> DumpGrammar s a
DG []

    booleanFieldDef :: forall s. FieldName -> ALens' s Bool -> Bool -> DumpGrammar s Bool
booleanFieldDef FieldName
fn ALens' s Bool
_ Bool
def = [String] -> DumpGrammar s Bool
forall s a. [String] -> DumpGrammar s a
DG
        [ FieldName -> String
fromUTF8BS FieldName
fn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Bool -> String
forall a. Pretty a => a -> String
C.prettyShow Bool
def
        , String
""
        ]

    optionalFieldAla :: forall b a s.
(Pretty b, Newtype a b) =>
FieldName
-> (a -> b) -> ALens' s (Maybe a) -> DumpGrammar s (Maybe a)
optionalFieldAla FieldName
fn a -> b
_ ALens' s (Maybe a)
_ = [String] -> DumpGrammar s (Maybe a)
forall s a. [String] -> DumpGrammar s a
DG
        [ FieldName -> String
fromUTF8BS FieldName
fn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":"
        , String
""
        ]

    optionalFieldDefAla :: forall b a s.
(Pretty b, Newtype a b, Eq a) =>
FieldName -> (a -> b) -> ALens' s a -> a -> DumpGrammar s a
optionalFieldDefAla FieldName
fn a -> b
c ALens' s a
_ a
def = [String] -> DumpGrammar s a
forall s a. [String] -> DumpGrammar s a
DG
        [ FieldName -> String
fromUTF8BS FieldName
fn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ b -> String
forall a. Pretty a => a -> String
C.prettyShow ((a -> b) -> a -> b
forall o n. Newtype o n => (o -> n) -> o -> n
C.pack' a -> b
c a
def)
        , String
""
        ]

    monoidalFieldAla :: forall b a s.
(Pretty b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> DumpGrammar s a
monoidalFieldAla FieldName
fn a -> b
_ ALens' s a
_ = [String] -> DumpGrammar s a
forall s a. [String] -> DumpGrammar s a
DG
        [ FieldName -> String
fromUTF8BS FieldName
fn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":"
        , String
""
        ]

    freeTextField :: forall s.
FieldName
-> ALens' s (Maybe String) -> DumpGrammar s (Maybe String)
freeTextField FieldName
fn ALens' s (Maybe String)
_ = [String] -> DumpGrammar s (Maybe String)
forall s a. [String] -> DumpGrammar s a
DG
        [ FieldName -> String
fromUTF8BS FieldName
fn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":"
        , String
""
        ]

    freeTextFieldDef :: forall s. FieldName -> ALens' s String -> DumpGrammar s String
freeTextFieldDef FieldName
fn ALens' s String
_ = [String] -> DumpGrammar s String
forall s a. [String] -> DumpGrammar s a
DG
        [ FieldName -> String
fromUTF8BS FieldName
fn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":"
        , String
""
        ]

    freeTextFieldDefST :: forall s.
FieldName -> ALens' s ShortText -> DumpGrammar s ShortText
freeTextFieldDefST FieldName
fn ALens' s ShortText
_ = [String] -> DumpGrammar s ShortText
forall s a. [String] -> DumpGrammar s a
DG
        [ FieldName -> String
fromUTF8BS FieldName
fn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":"
        , String
""
        ]

    prefixedFields :: forall s.
FieldName
-> ALens' s [(String, String)] -> DumpGrammar s [(String, String)]
prefixedFields FieldName
_ ALens' s [(String, String)]
_   = [(String, String)] -> DumpGrammar s [(String, String)]
forall a. a -> DumpGrammar s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    knownField :: forall s. FieldName -> DumpGrammar s ()
knownField FieldName
_         = () -> DumpGrammar s ()
forall a. a -> DumpGrammar s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    deprecatedSince :: forall s a.
CabalSpecVersion -> String -> DumpGrammar s a -> DumpGrammar s a
deprecatedSince CabalSpecVersion
_  String
_ = DumpGrammar s a -> DumpGrammar s a
forall a. a -> a
id
    availableSince :: forall a s.
CabalSpecVersion -> a -> DumpGrammar s a -> DumpGrammar s a
availableSince CabalSpecVersion
_ a
_   = DumpGrammar s a -> DumpGrammar s a
forall a. a -> a
id
    removedIn :: forall s a.
CabalSpecVersion -> String -> DumpGrammar s a -> DumpGrammar s a
removedIn CabalSpecVersion
_ String
_        = DumpGrammar s a -> DumpGrammar s a
forall a. a -> a
id
    hiddenField :: forall s a. DumpGrammar s a -> DumpGrammar s a
hiddenField          = DumpGrammar s a -> DumpGrammar s a
forall a. a -> a
id

instance OptionsGrammar C.Pretty DumpGrammar where
    metahelp :: forall s a. String -> String -> DumpGrammar s a -> DumpGrammar s a
metahelp String
_ = String -> DumpGrammar s a -> DumpGrammar s a
forall s a. String -> DumpGrammar s a -> DumpGrammar s a
forall (c :: * -> Constraint) (p :: * -> * -> *) s a.
OptionsGrammar c p =>
String -> p s a -> p s a
help

    help :: forall s a. String -> DumpGrammar s a -> DumpGrammar s a
help String
h (DG [String]
xs) = [String] -> DumpGrammar s a
forall s a. [String] -> DumpGrammar s a
DG ([String] -> DumpGrammar s a) -> [String] -> DumpGrammar s a
forall a b. (a -> b) -> a -> b
$
        (String
"-- " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
h) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
xs