{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE StrictData        #-}
module HaskellCI.GitHub.Yaml where

import HaskellCI.Prelude

import qualified Data.Map.Strict as M

import HaskellCI.Compiler
import HaskellCI.List
import HaskellCI.Sh
import HaskellCI.YamlSyntax

-------------------------------------------------------------------------------
-- Data
-------------------------------------------------------------------------------

data GitHub = GitHub
    { GitHub -> String
ghName :: String
    , GitHub -> GitHubOn
ghOn   :: GitHubOn
    , GitHub -> Map String GitHubJob
ghJobs :: M.Map String GitHubJob
    }
  deriving (Int -> GitHub -> ShowS
[GitHub] -> ShowS
GitHub -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GitHub] -> ShowS
$cshowList :: [GitHub] -> ShowS
show :: GitHub -> String
$cshow :: GitHub -> String
showsPrec :: Int -> GitHub -> ShowS
$cshowsPrec :: Int -> GitHub -> ShowS
Show)

newtype GitHubOn = GitHubOn
    { GitHubOn -> [String]
ghBranches :: [String]
    }
  deriving (Int -> GitHubOn -> ShowS
[GitHubOn] -> ShowS
GitHubOn -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GitHubOn] -> ShowS
$cshowList :: [GitHubOn] -> ShowS
show :: GitHubOn -> String
$cshow :: GitHubOn -> String
showsPrec :: Int -> GitHubOn -> ShowS
$cshowsPrec :: Int -> GitHubOn -> ShowS
Show)

data GitHubJob = GitHubJob
    { GitHubJob -> String
ghjName            :: String
    , GitHubJob -> String
ghjRunsOn          :: String
    , GitHubJob -> [String]
ghjNeeds           :: [String]
    , GitHubJob -> Maybe String
ghjIf              :: Maybe String
    , GitHubJob -> Maybe String
ghjContainer       :: Maybe String
    , GitHubJob -> Map String GitHubService
ghjServices        :: M.Map String GitHubService
    , GitHubJob -> Maybe String
ghjContinueOnError :: Maybe String
    , GitHubJob -> [GitHubMatrixEntry]
ghjMatrix          :: [GitHubMatrixEntry]
    , GitHubJob -> [GitHubStep]
ghjSteps           :: [GitHubStep]
    , GitHubJob -> Natural
ghjTimeout         :: Natural
    }
  deriving (Int -> GitHubJob -> ShowS
[GitHubJob] -> ShowS
GitHubJob -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GitHubJob] -> ShowS
$cshowList :: [GitHubJob] -> ShowS
show :: GitHubJob -> String
$cshow :: GitHubJob -> String
showsPrec :: Int -> GitHubJob -> ShowS
$cshowsPrec :: Int -> GitHubJob -> ShowS
Show)

data SetupMethod = HVRPPA | GHCUP
  deriving Int -> SetupMethod -> ShowS
[SetupMethod] -> ShowS
SetupMethod -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetupMethod] -> ShowS
$cshowList :: [SetupMethod] -> ShowS
show :: SetupMethod -> String
$cshow :: SetupMethod -> String
showsPrec :: Int -> SetupMethod -> ShowS
$cshowsPrec :: Int -> SetupMethod -> ShowS
Show

data GitHubMatrixEntry = GitHubMatrixEntry
    { GitHubMatrixEntry -> CompilerVersion
ghmeCompiler     :: CompilerVersion
    , GitHubMatrixEntry -> Bool
ghmeAllowFailure :: Bool
    , GitHubMatrixEntry -> SetupMethod
ghmeSetupMethod  :: SetupMethod
    }
  deriving (Int -> GitHubMatrixEntry -> ShowS
[GitHubMatrixEntry] -> ShowS
GitHubMatrixEntry -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GitHubMatrixEntry] -> ShowS
$cshowList :: [GitHubMatrixEntry] -> ShowS
show :: GitHubMatrixEntry -> String
$cshow :: GitHubMatrixEntry -> String
showsPrec :: Int -> GitHubMatrixEntry -> ShowS
$cshowsPrec :: Int -> GitHubMatrixEntry -> ShowS
Show)

data GitHubStep = GitHubStep
    { GitHubStep -> String
ghsName :: String
    , GitHubStep -> Either GitHubRun GitHubUses
ghsStep :: Either GitHubRun GitHubUses
    }
  deriving (Int -> GitHubStep -> ShowS
[GitHubStep] -> ShowS
GitHubStep -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GitHubStep] -> ShowS
$cshowList :: [GitHubStep] -> ShowS
show :: GitHubStep -> String
$cshow :: GitHubStep -> String
showsPrec :: Int -> GitHubStep -> ShowS
$cshowsPrec :: Int -> GitHubStep -> ShowS
Show)

-- | Steps with @run@
data GitHubRun = GitHubRun
    { GitHubRun -> [Sh]
ghsRun :: [Sh]
    , GitHubRun -> Map String String
ghsEnv :: M.Map String String
    }
  deriving (Int -> GitHubRun -> ShowS
[GitHubRun] -> ShowS
GitHubRun -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GitHubRun] -> ShowS
$cshowList :: [GitHubRun] -> ShowS
show :: GitHubRun -> String
$cshow :: GitHubRun -> String
showsPrec :: Int -> GitHubRun -> ShowS
$cshowsPrec :: Int -> GitHubRun -> ShowS
Show)

-- | Steps with @uses@
data GitHubUses = GitHubUses
    { GitHubUses -> String
ghsAction :: String
    , GitHubUses -> Maybe String
ghsIf     :: Maybe String
    , GitHubUses -> Map String String
ghsWith   :: M.Map String String
    }
  deriving (Int -> GitHubUses -> ShowS
[GitHubUses] -> ShowS
GitHubUses -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GitHubUses] -> ShowS
$cshowList :: [GitHubUses] -> ShowS
show :: GitHubUses -> String
$cshow :: GitHubUses -> String
showsPrec :: Int -> GitHubUses -> ShowS
$cshowsPrec :: Int -> GitHubUses -> ShowS
Show)

data GitHubService = GitHubService
    { GitHubService -> String
ghServImage   :: String
    , GitHubService -> Map String String
ghServEnv     :: M.Map String String
    , GitHubService -> Maybe String
ghServOptions :: Maybe String
    }
  deriving (Int -> GitHubService -> ShowS
[GitHubService] -> ShowS
GitHubService -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GitHubService] -> ShowS
$cshowList :: [GitHubService] -> ShowS
show :: GitHubService -> String
$cshow :: GitHubService -> String
showsPrec :: Int -> GitHubService -> ShowS
$cshowsPrec :: Int -> GitHubService -> ShowS
Show)

-------------------------------------------------------------------------------
-- ToYaml
-------------------------------------------------------------------------------

instance ToYaml GitHub where
    toYaml :: GitHub -> Yaml [String]
toYaml GitHub {String
Map String GitHubJob
GitHubOn
ghJobs :: Map String GitHubJob
ghOn :: GitHubOn
ghName :: String
ghJobs :: GitHub -> Map String GitHubJob
ghOn :: GitHub -> GitHubOn
ghName :: GitHub -> String
..} = forall ann. ann -> [(ann, String, Yaml ann)] -> Yaml ann
ykeyValuesFilt []
        [ String
"name" String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall a. IsString a => String -> a
fromString String
ghName
        , String
"on"   String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall a. ToYaml a => a -> Yaml [String]
toYaml GitHubOn
ghOn
        , String
"jobs" String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall ann. ann -> [(ann, String, Yaml ann)] -> Yaml ann
ykeyValuesFilt []
            [ ([], String
j, forall a. ToYaml a => a -> Yaml [String]
toYaml GitHubJob
job)
            | (String
j, GitHubJob
job) <- forall k a. Map k a -> [(k, a)]
M.toList Map String GitHubJob
ghJobs
            ]
        ]

instance ToYaml GitHubOn where
    toYaml :: GitHubOn -> Yaml [String]
toYaml GitHubOn {[String]
ghBranches :: [String]
ghBranches :: GitHubOn -> [String]
..}
        | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
ghBranches
        = forall ann. ann -> [Yaml ann] -> Yaml ann
ylistFilt [] [Yaml [String]
"push", Yaml [String]
"pull_request"]
        | Bool
otherwise
        = forall ann. ann -> [(ann, String, Yaml ann)] -> Yaml ann
ykeyValuesFilt []
              [ String
"push"         String -> Yaml [String] -> ([String], String, Yaml [String])
~> Yaml [String]
branches
              , String
"pull_request" String -> Yaml [String] -> ([String], String, Yaml [String])
~> Yaml [String]
branches
              ]
      where
        branches :: Yaml [String]
branches = forall ann. ann -> [(ann, String, Yaml ann)] -> Yaml ann
ykeyValuesFilt []
            [ String
"branches" String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall ann. ann -> [Yaml ann] -> Yaml ann
ylistFilt [] (forall a b. (a -> b) -> [a] -> [b]
map forall a. IsString a => String -> a
fromString [String]
ghBranches)
            ]

instance ToYaml GitHubJob where
    toYaml :: GitHubJob -> Yaml [String]
toYaml GitHubJob {Natural
String
[String]
[GitHubStep]
[GitHubMatrixEntry]
Maybe String
Map String GitHubService
ghjTimeout :: Natural
ghjSteps :: [GitHubStep]
ghjMatrix :: [GitHubMatrixEntry]
ghjContinueOnError :: Maybe String
ghjServices :: Map String GitHubService
ghjContainer :: Maybe String
ghjIf :: Maybe String
ghjNeeds :: [String]
ghjRunsOn :: String
ghjName :: String
ghjTimeout :: GitHubJob -> Natural
ghjSteps :: GitHubJob -> [GitHubStep]
ghjMatrix :: GitHubJob -> [GitHubMatrixEntry]
ghjContinueOnError :: GitHubJob -> Maybe String
ghjServices :: GitHubJob -> Map String GitHubService
ghjContainer :: GitHubJob -> Maybe String
ghjIf :: GitHubJob -> Maybe String
ghjNeeds :: GitHubJob -> [String]
ghjRunsOn :: GitHubJob -> String
ghjName :: GitHubJob -> String
..} = forall ann. ann -> [(ann, String, Yaml ann)] -> Yaml ann
ykeyValuesFilt [] forall a b. (a -> b) -> a -> b
$ forall x. ListBuilder x () -> [x]
buildList forall a b. (a -> b) -> a -> b
$ do
        forall x. x -> ListBuilder x ()
item forall a b. (a -> b) -> a -> b
$ String
"name" String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall a. IsString a => String -> a
fromString String
ghjName
        forall x. x -> ListBuilder x ()
item forall a b. (a -> b) -> a -> b
$ String
"runs-on" String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall a. IsString a => String -> a
fromString String
ghjRunsOn
        forall x. x -> ListBuilder x ()
item forall a b. (a -> b) -> a -> b
$ String
"needs" String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall ann. ann -> [Yaml ann] -> Yaml ann
ylistFilt [] (forall a b. (a -> b) -> [a] -> [b]
map forall a. IsString a => String -> a
fromString [String]
ghjNeeds)
        forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe String
ghjIf forall a b. (a -> b) -> a -> b
$ \String
if_ ->
            forall x. x -> ListBuilder x ()
item forall a b. (a -> b) -> a -> b
$ String
"if" String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall a. IsString a => String -> a
fromString String
if_
        forall x. x -> ListBuilder x ()
item forall a b. (a -> b) -> a -> b
$ String
"timeout-minutes" String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall ann. ann -> Integer -> Yaml ann
YNumber [] (forall a. Integral a => a -> Integer
toInteger Natural
ghjTimeout)
        forall x. x -> ListBuilder x ()
item forall a b. (a -> b) -> a -> b
$ String
"container" String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall ann. ann -> [(ann, String, Yaml ann)] -> Yaml ann
ykeyValuesFilt [] (forall x. ListBuilder x () -> [x]
buildList forall a b. (a -> b) -> a -> b
$
            forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe String
ghjContainer forall a b. (a -> b) -> a -> b
$ \String
image -> forall x. x -> ListBuilder x ()
item forall a b. (a -> b) -> a -> b
$ String
"image" String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall a. IsString a => String -> a
fromString String
image)
        forall x. x -> ListBuilder x ()
item forall a b. (a -> b) -> a -> b
$ String
"services" String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall a. ToYaml a => a -> Yaml [String]
toYaml Map String GitHubService
ghjServices
        forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe String
ghjContinueOnError forall a b. (a -> b) -> a -> b
$ \String
continueOnError ->
            forall x. x -> ListBuilder x ()
item forall a b. (a -> b) -> a -> b
$ String
"continue-on-error" String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall a. IsString a => String -> a
fromString String
continueOnError
        forall x. x -> ListBuilder x ()
item forall a b. (a -> b) -> a -> b
$ String
"strategy" String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall ann. ann -> [(ann, String, Yaml ann)] -> Yaml ann
ykeyValuesFilt []
            [ String
"matrix" String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall ann. ann -> [(ann, String, Yaml ann)] -> Yaml ann
ykeyValuesFilt []
                [ String
"include" String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall ann. ann -> [Yaml ann] -> Yaml ann
ylistFilt [] (forall a b. (a -> b) -> [a] -> [b]
map forall a. ToYaml a => a -> Yaml [String]
toYaml [GitHubMatrixEntry]
ghjMatrix)
                ]
            , String
"fail-fast" String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall ann. ann -> Bool -> Yaml ann
YBool [] Bool
False
            ]
        forall x. x -> ListBuilder x ()
item forall a b. (a -> b) -> a -> b
$ String
"steps" String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall ann. ann -> [Yaml ann] -> Yaml ann
ylistFilt [] (forall a b. (a -> b) -> [a] -> [b]
map forall a. ToYaml a => a -> Yaml [String]
toYaml forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter GitHubStep -> Bool
notEmptyStep [GitHubStep]
ghjSteps)

instance ToYaml SetupMethod where
    toYaml :: SetupMethod -> Yaml [String]
toYaml SetupMethod
HVRPPA = Yaml [String]
"hvr-ppa"
    toYaml SetupMethod
GHCUP  = Yaml [String]
"ghcup"

instance ToYaml GitHubMatrixEntry where
    toYaml :: GitHubMatrixEntry -> Yaml [String]
toYaml GitHubMatrixEntry {Bool
CompilerVersion
SetupMethod
ghmeSetupMethod :: SetupMethod
ghmeAllowFailure :: Bool
ghmeCompiler :: CompilerVersion
ghmeSetupMethod :: GitHubMatrixEntry -> SetupMethod
ghmeAllowFailure :: GitHubMatrixEntry -> Bool
ghmeCompiler :: GitHubMatrixEntry -> CompilerVersion
..} = forall ann. ann -> [(ann, String, Yaml ann)] -> Yaml ann
ykeyValuesFilt []
        [ String
"compiler"        String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall a. IsString a => String -> a
fromString (CompilerVersion -> String
dispGhcVersion CompilerVersion
ghmeCompiler)
        , String
"compilerKind"    String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall a. IsString a => String -> a
fromString (CompilerVersion -> String
compilerKind CompilerVersion
ghmeCompiler)
        , String
"compilerVersion" String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall a. IsString a => String -> a
fromString (CompilerVersion -> String
compilerVersion CompilerVersion
ghmeCompiler)
        , String
"setup-method"    String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall a. ToYaml a => a -> Yaml [String]
toYaml SetupMethod
ghmeSetupMethod
        , String
"allow-failure"   String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall a. ToYaml a => a -> Yaml [String]
toYaml Bool
ghmeAllowFailure
        ]

instance ToYaml GitHubStep where
    toYaml :: GitHubStep -> Yaml [String]
toYaml GitHubStep {String
Either GitHubRun GitHubUses
ghsStep :: Either GitHubRun GitHubUses
ghsName :: String
ghsStep :: GitHubStep -> Either GitHubRun GitHubUses
ghsName :: GitHubStep -> String
..} = forall ann. ann -> [(ann, String, Yaml ann)] -> Yaml ann
ykeyValuesFilt [] forall a b. (a -> b) -> a -> b
$
        [ String
"name" String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall a. IsString a => String -> a
fromString String
ghsName
        ] forall a. [a] -> [a] -> [a]
++ case Either GitHubRun GitHubUses
ghsStep of
            Left GitHubRun {[Sh]
Map String String
ghsEnv :: Map String String
ghsRun :: [Sh]
ghsEnv :: GitHubRun -> Map String String
ghsRun :: GitHubRun -> [Sh]
..} ->
                [ String
"run" String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall a. IsString a => String -> a
fromString ([Sh] -> String
shlistToString [Sh]
ghsRun)
                , String
"env" String -> Yaml [String] -> ([String], String, Yaml [String])
~> Map String String -> Yaml [String]
mapToYaml Map String String
ghsEnv
                ]

            Right GitHubUses {String
Maybe String
Map String String
ghsWith :: Map String String
ghsIf :: Maybe String
ghsAction :: String
ghsWith :: GitHubUses -> Map String String
ghsIf :: GitHubUses -> Maybe String
ghsAction :: GitHubUses -> String
..} -> forall x. ListBuilder x () -> [x]
buildList forall a b. (a -> b) -> a -> b
$ do
                forall x. x -> ListBuilder x ()
item forall a b. (a -> b) -> a -> b
$ String
"uses" String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall a. IsString a => String -> a
fromString String
ghsAction
                forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe String
ghsIf forall a b. (a -> b) -> a -> b
$ \String
if_ -> forall x. x -> ListBuilder x ()
item forall a b. (a -> b) -> a -> b
$ String
"if" String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall a. IsString a => String -> a
fromString String
if_
                forall x. x -> ListBuilder x ()
item forall a b. (a -> b) -> a -> b
$ String
"with" String -> Yaml [String] -> ([String], String, Yaml [String])
~> Map String String -> Yaml [String]
mapToYaml Map String String
ghsWith

notEmptyStep :: GitHubStep -> Bool
notEmptyStep :: GitHubStep -> Bool
notEmptyStep (GitHubStep String
_ (Left (GitHubRun [] Map String String
_))) = Bool
False
notEmptyStep GitHubStep
_                                      = Bool
True

instance ToYaml GitHubService where
    toYaml :: GitHubService -> Yaml [String]
toYaml GitHubService {String
Maybe String
Map String String
ghServOptions :: Maybe String
ghServEnv :: Map String String
ghServImage :: String
ghServOptions :: GitHubService -> Maybe String
ghServEnv :: GitHubService -> Map String String
ghServImage :: GitHubService -> String
..} = forall ann. ann -> [(ann, String, Yaml ann)] -> Yaml ann
ykeyValuesFilt [] forall a b. (a -> b) -> a -> b
$ forall x. ListBuilder x () -> [x]
buildList forall a b. (a -> b) -> a -> b
$ do
        forall x. x -> ListBuilder x ()
item forall a b. (a -> b) -> a -> b
$ String
"image" String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall a. IsString a => String -> a
fromString String
ghServImage
        forall x. x -> ListBuilder x ()
item forall a b. (a -> b) -> a -> b
$ String
"env"   String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall a. ToYaml a => a -> Yaml [String]
toYaml (forall ann. ann -> String -> Yaml ann
YString [] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map String String
ghServEnv)
        forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe String
ghServOptions forall a b. (a -> b) -> a -> b
$ \String
opt -> forall x. x -> ListBuilder x ()
item forall a b. (a -> b) -> a -> b
$ String
"options" String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall a. IsString a => String -> a
fromString String
opt

-------------------------------------------------------------------------------
-- Helpers
-------------------------------------------------------------------------------

mapToYaml :: M.Map String String -> Yaml [String]
mapToYaml :: Map String String -> Yaml [String]
mapToYaml Map String String
m = forall ann. ann -> [(ann, String, Yaml ann)] -> Yaml ann
ykeyValuesFilt []
    [ String
k String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall a. IsString a => String -> a
fromString String
v
    | (String
k, String
v) <- forall k a. Map k a -> [(k, a)]
M.toList Map String String
m
    ]