{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE StrictData        #-}
-- | @travis.yaml@ structure.
module HaskellCI.Travis.Yaml where

import HaskellCI.Prelude

import qualified Data.Aeson         as Aeson
import qualified Data.List.NonEmpty as NE

import HaskellCI.Config.Ubuntu
import HaskellCI.List
import HaskellCI.Sh
import HaskellCI.YamlSyntax

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

data Travis = Travis
    { Travis -> Ubuntu
travisUbuntu        :: !Ubuntu
    , Travis -> String
travisLanguage      :: !String
    , Travis -> TravisGit
travisGit           :: !TravisGit
    , Travis -> TravisCache
travisCache         :: !TravisCache
    , Travis -> TravisBranches
travisBranches      :: !TravisBranches
    , Travis -> TravisNotifications
travisNotifications :: !TravisNotifications
    , Travis -> [String]
travisServices      :: ![String]
    , Travis -> TravisAddons
travisAddons        :: !TravisAddons
    , Travis -> TravisMatrix
travisMatrix        :: !TravisMatrix
    , Travis -> [Sh]
travisBeforeCache   :: ![Sh]
    , Travis -> [Sh]
travisBeforeInstall :: ![Sh]
    , Travis -> [Sh]
travisInstall       :: ![Sh]
    , Travis -> [Sh]
travisScript        :: ![Sh]
    }
  deriving Int -> Travis -> ShowS
[Travis] -> ShowS
Travis -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Travis] -> ShowS
$cshowList :: [Travis] -> ShowS
show :: Travis -> String
$cshow :: Travis -> String
showsPrec :: Int -> Travis -> ShowS
$cshowsPrec :: Int -> Travis -> ShowS
Show

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

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

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

data TravisNotifications = TravisNotifications
    { TravisNotifications -> Maybe TravisIRC
tnIRC   :: Maybe TravisIRC
    , TravisNotifications -> Bool
tnEmail :: Bool
    }
  deriving Int -> TravisNotifications -> ShowS
[TravisNotifications] -> ShowS
TravisNotifications -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TravisNotifications] -> ShowS
$cshowList :: [TravisNotifications] -> ShowS
show :: TravisNotifications -> String
$cshow :: TravisNotifications -> String
showsPrec :: Int -> TravisNotifications -> ShowS
$cshowsPrec :: Int -> TravisNotifications -> ShowS
Show

data TravisIRC = TravisIRC
    { TravisIRC -> [String]
tiChannels :: [String]
    , TravisIRC -> Bool
tiSkipJoin :: Bool
    , TravisIRC -> [String]
tiTemplate :: [String]
    , TravisIRC -> Maybe String
tiNick     :: Maybe String
    , TravisIRC -> Maybe String
tiPassword :: Maybe String
    }
  deriving Int -> TravisIRC -> ShowS
[TravisIRC] -> ShowS
TravisIRC -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TravisIRC] -> ShowS
$cshowList :: [TravisIRC] -> ShowS
show :: TravisIRC -> String
$cshow :: TravisIRC -> String
showsPrec :: Int -> TravisIRC -> ShowS
$cshowsPrec :: Int -> TravisIRC -> ShowS
Show

data TravisMatrix = TravisMatrix
    { TravisMatrix -> [TravisJob]
tmInclude       :: [TravisJob]
    , TravisMatrix -> [TravisAllowFailure]
tmAllowFailures :: [TravisAllowFailure]
    }
  deriving Int -> TravisMatrix -> ShowS
[TravisMatrix] -> ShowS
TravisMatrix -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TravisMatrix] -> ShowS
$cshowList :: [TravisMatrix] -> ShowS
show :: TravisMatrix -> String
$cshow :: TravisMatrix -> String
showsPrec :: Int -> TravisMatrix -> ShowS
$cshowsPrec :: Int -> TravisMatrix -> ShowS
Show

data TravisJob = TravisJob
    { TravisJob -> String
tjCompiler :: String
    , TravisJob -> Maybe String
tjEnv      :: Maybe String
    , TravisJob -> TravisAddons
tjAddons   :: TravisAddons
    , TravisJob -> String
tjOS       :: String
    }
  deriving Int -> TravisJob -> ShowS
[TravisJob] -> ShowS
TravisJob -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TravisJob] -> ShowS
$cshowList :: [TravisJob] -> ShowS
show :: TravisJob -> String
$cshow :: TravisJob -> String
showsPrec :: Int -> TravisJob -> ShowS
$cshowsPrec :: Int -> TravisJob -> ShowS
Show

data TravisAddons = TravisAddons
    { TravisAddons -> TravisApt
taApt          :: TravisApt
    , TravisAddons -> Maybe String
taPostgres     :: Maybe String
    , TravisAddons -> Bool
taGoogleChrome :: Bool
    }
  deriving Int -> TravisAddons -> ShowS
[TravisAddons] -> ShowS
TravisAddons -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TravisAddons] -> ShowS
$cshowList :: [TravisAddons] -> ShowS
show :: TravisAddons -> String
$cshow :: TravisAddons -> String
showsPrec :: Int -> TravisAddons -> ShowS
$cshowsPrec :: Int -> TravisAddons -> ShowS
Show

data TravisApt = TravisApt
    { TravisApt -> [String]
taPackages :: [String]
    , TravisApt -> [TravisAptSource]
taSources  :: [TravisAptSource]
    }
  deriving Int -> TravisApt -> ShowS
[TravisApt] -> ShowS
TravisApt -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TravisApt] -> ShowS
$cshowList :: [TravisApt] -> ShowS
show :: TravisApt -> String
$cshow :: TravisApt -> String
showsPrec :: Int -> TravisApt -> ShowS
$cshowsPrec :: Int -> TravisApt -> ShowS
Show

data TravisAptSource
    = TravisAptSource String
    | TravisAptSourceLine String (Maybe String) -- ^ sourceline with optional key
  deriving Int -> TravisAptSource -> ShowS
[TravisAptSource] -> ShowS
TravisAptSource -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TravisAptSource] -> ShowS
$cshowList :: [TravisAptSource] -> ShowS
show :: TravisAptSource -> String
$cshow :: TravisAptSource -> String
showsPrec :: Int -> TravisAptSource -> ShowS
$cshowsPrec :: Int -> TravisAptSource -> ShowS
Show

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

-------------------------------------------------------------------------------
-- Serialisation helpers (move to Travis.Yaml?)
-------------------------------------------------------------------------------

(^^^) :: ([String], String, Yaml [String]) -> String -> ([String], String, Yaml [String])
([String]
a,String
b,Yaml [String]
c) ^^^ :: ([String], String, Yaml [String])
-> String -> ([String], String, Yaml [String])
^^^ String
d = (String
d forall a. a -> [a] -> [a]
: [String]
a, String
b, Yaml [String]
c)

shListToYaml :: [Sh] -> Yaml [String]
shListToYaml :: [Sh] -> Yaml [String]
shListToYaml [Sh]
shs = forall ann. ann -> [Yaml ann] -> Yaml ann
YList [] forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ forall ann. ann -> String -> Yaml ann
YString [String]
cs String
x forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. IsString a => String -> a
fromString [String]
xs
    | ([String]
cs, String
x :| [String]
xs) <- [Sh] -> [([String], NonEmpty String)]
gr [Sh]
shs
    ]
  where
    gr :: [Sh] -> [([String], NonEmpty String)]
    gr :: [Sh] -> [([String], NonEmpty String)]
gr [] = []
    gr (Sh String
x : [Sh]
rest) = case [Sh] -> [([String], NonEmpty String)]
gr [Sh]
rest of
        ([], NonEmpty String
xs) : [([String], NonEmpty String)]
xss -> ([], forall a. a -> NonEmpty a -> NonEmpty a
NE.cons String
x NonEmpty String
xs) forall a. a -> [a] -> [a]
: [([String], NonEmpty String)]
xss
        [([String], NonEmpty String)]
xss            -> ([], forall (f :: * -> *) a. Applicative f => a -> f a
pure String
x) forall a. a -> [a] -> [a]
: [([String], NonEmpty String)]
xss

    gr (Comment String
c : [Sh]
rest) = case [Sh] -> [([String], NonEmpty String)]
gr [Sh]
rest of
        ([String]
cs, NonEmpty String
xs) : [([String], NonEmpty String)]
xss -> (String
c forall a. a -> [a] -> [a]
: [String]
cs, NonEmpty String
xs) forall a. a -> [a] -> [a]
: [([String], NonEmpty String)]
xss
        []             -> [] -- end of comments are lost

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

instance ToYaml Travis where
    toYaml :: Travis -> Yaml [String]
toYaml Travis {String
[String]
[Sh]
Ubuntu
TravisAddons
TravisMatrix
TravisNotifications
TravisBranches
TravisCache
TravisGit
travisScript :: [Sh]
travisInstall :: [Sh]
travisBeforeInstall :: [Sh]
travisBeforeCache :: [Sh]
travisMatrix :: TravisMatrix
travisAddons :: TravisAddons
travisServices :: [String]
travisNotifications :: TravisNotifications
travisBranches :: TravisBranches
travisCache :: TravisCache
travisGit :: TravisGit
travisLanguage :: String
travisUbuntu :: Ubuntu
travisScript :: Travis -> [Sh]
travisInstall :: Travis -> [Sh]
travisBeforeInstall :: Travis -> [Sh]
travisBeforeCache :: Travis -> [Sh]
travisMatrix :: Travis -> TravisMatrix
travisAddons :: Travis -> TravisAddons
travisServices :: Travis -> [String]
travisNotifications :: Travis -> TravisNotifications
travisBranches :: Travis -> TravisBranches
travisCache :: Travis -> TravisCache
travisGit :: Travis -> TravisGit
travisLanguage :: Travis -> String
travisUbuntu :: Travis -> Ubuntu
..} = forall ann. ann -> [(ann, String, Yaml ann)] -> Yaml ann
ykeyValuesFilt []
        -- version forces validation
        -- https://blog.travis-ci.com/2019-10-24-build-config-validation
        [ String
"version"        String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall a. IsString a => String -> a
fromString String
"~> 1.0"
        , String
"language"       String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall a. IsString a => String -> a
fromString String
travisLanguage
        , String
"os"             String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall a. IsString a => String -> a
fromString String
"linux"
        , String
"dist"           String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall a. IsString a => String -> a
fromString (Ubuntu -> String
showUbuntu Ubuntu
travisUbuntu)
        , String
"git"            String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall a. ToYaml a => a -> Yaml [String]
toYaml TravisGit
travisGit
        , String
"branches"       String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall a. ToYaml a => a -> Yaml [String]
toYaml TravisBranches
travisBranches
        , String
"notifications"  String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall a. ToYaml a => a -> Yaml [String]
toYaml TravisNotifications
travisNotifications
        , String
"services"       String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall ann. ann -> [Yaml ann] -> Yaml ann
YList [] (forall a b. (a -> b) -> [a] -> [b]
map forall a. IsString a => String -> a
fromString [String]
travisServices)
        , String
"addons"         String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall a. ToYaml a => a -> Yaml [String]
toYaml TravisAddons
travisAddons
        , String
"cache"          String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall a. ToYaml a => a -> Yaml [String]
toYaml TravisCache
travisCache
        , String
"before_cache"   String -> Yaml [String] -> ([String], String, Yaml [String])
~> [Sh] -> Yaml [String]
shListToYaml [Sh]
travisBeforeCache
        , String
"jobs"           String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall a. ToYaml a => a -> Yaml [String]
toYaml TravisMatrix
travisMatrix
        , String
"before_install" String -> Yaml [String] -> ([String], String, Yaml [String])
~> [Sh] -> Yaml [String]
shListToYaml [Sh]
travisBeforeInstall
        , String
"install"        String -> Yaml [String] -> ([String], String, Yaml [String])
~> [Sh] -> Yaml [String]
shListToYaml [Sh]
travisInstall
        , String
"script"         String -> Yaml [String] -> ([String], String, Yaml [String])
~> [Sh] -> Yaml [String]
shListToYaml [Sh]
travisScript
        ]

instance ToYaml TravisGit where
    toYaml :: TravisGit -> Yaml [String]
toYaml TravisGit {Bool
tgSubmodules :: Bool
tgSubmodules :: TravisGit -> Bool
..} = forall ann. ann -> [(ann, String, Yaml ann)] -> Yaml ann
ykeyValuesFilt []
        [ String
"submodules" String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall a. ToYaml a => a -> Yaml [String]
toYaml Bool
tgSubmodules
          ([String], String, Yaml [String])
-> String -> ([String], String, Yaml [String])
^^^ String
"whether to recursively clone submodules"
        ]

instance ToYaml TravisBranches where
    toYaml :: TravisBranches -> Yaml [String]
toYaml TravisBranches {[String]
tbOnly :: [String]
tbOnly :: TravisBranches -> [String]
..} = forall ann. ann -> [(ann, String, Yaml ann)] -> Yaml ann
ykeyValuesFilt []
        [ String
"only" 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]
tbOnly)
        ]

instance ToYaml TravisNotifications where
    toYaml :: TravisNotifications -> Yaml [String]
toYaml TravisNotifications {Bool
Maybe TravisIRC
tnEmail :: Bool
tnIRC :: Maybe TravisIRC
tnEmail :: TravisNotifications -> Bool
tnIRC :: TravisNotifications -> Maybe TravisIRC
..} = 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 (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe TravisIRC
tnIRC forall a b. (a -> b) -> a -> b
$ \TravisIRC
y -> forall x. x -> ListBuilder x ()
item forall a b. (a -> b) -> a -> b
$ String
"irc" String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall a. ToYaml a => a -> Yaml [String]
toYaml TravisIRC
y
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
tnEmail forall a b. (a -> b) -> a -> b
$ forall x. x -> ListBuilder x ()
item forall a b. (a -> b) -> a -> b
$ String
"email" String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall a. ToYaml a => a -> Yaml [String]
toYaml Bool
False

instance ToYaml TravisIRC where
    toYaml :: TravisIRC -> Yaml [String]
toYaml TravisIRC {Bool
[String]
Maybe String
tiPassword :: Maybe String
tiNick :: Maybe String
tiTemplate :: [String]
tiSkipJoin :: Bool
tiChannels :: [String]
tiPassword :: TravisIRC -> Maybe String
tiNick :: TravisIRC -> Maybe String
tiTemplate :: TravisIRC -> [String]
tiSkipJoin :: TravisIRC -> Bool
tiChannels :: TravisIRC -> [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
"channels"  String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall ann. ann -> [Yaml ann] -> Yaml ann
YList [] (forall a b. (a -> b) -> [a] -> [b]
map forall a. IsString a => String -> a
fromString [String]
tiChannels)
        forall x. x -> ListBuilder x ()
item forall a b. (a -> b) -> a -> b
$ String
"skip_join" String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall a. ToYaml a => a -> Yaml [String]
toYaml Bool
tiSkipJoin
        forall x. x -> ListBuilder x ()
item forall a b. (a -> b) -> a -> b
$ String
"template"  String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall ann. ann -> [Yaml ann] -> Yaml ann
YList [] (forall a b. (a -> b) -> [a] -> [b]
map forall a. IsString a => String -> a
fromString [String]
tiTemplate)
        forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe String
tiNick forall a b. (a -> b) -> a -> b
$ \String
n ->
            forall x. x -> ListBuilder x ()
item forall a b. (a -> b) -> a -> b
$ String
"nick" String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall a. IsString a => String -> a
fromString String
n
        forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe String
tiPassword forall a b. (a -> b) -> a -> b
$ \String
p ->
            forall x. x -> ListBuilder x ()
item forall a b. (a -> b) -> a -> b
$ String
"password" String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall a. IsString a => String -> a
fromString String
p

instance ToYaml TravisCache where
    toYaml :: TravisCache -> Yaml [String]
toYaml TravisCache {[String]
tcDirectories :: [String]
tcDirectories :: TravisCache -> [String]
..} = forall ann. ann -> [(ann, String, Yaml ann)] -> Yaml ann
ykeyValuesFilt []
        [ String
"directories" String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall ann. ann -> [Yaml ann] -> Yaml ann
ylistFilt []
            [ forall a. IsString a => String -> a
fromString String
d
            | String
d <- [String]
tcDirectories
            ]
        ]

instance ToYaml TravisMatrix where
    toYaml :: TravisMatrix -> Yaml [String]
toYaml TravisMatrix {[TravisAllowFailure]
[TravisJob]
tmAllowFailures :: [TravisAllowFailure]
tmInclude :: [TravisJob]
tmAllowFailures :: TravisMatrix -> [TravisAllowFailure]
tmInclude :: TravisMatrix -> [TravisJob]
..} = 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 [TravisJob]
tmInclude)
        , String
"allow_failures" 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 [TravisAllowFailure]
tmAllowFailures)
        ]

instance ToYaml TravisJob where
    toYaml :: TravisJob -> Yaml [String]
toYaml TravisJob {String
Maybe String
TravisAddons
tjOS :: String
tjAddons :: TravisAddons
tjEnv :: Maybe String
tjCompiler :: String
tjOS :: TravisJob -> String
tjAddons :: TravisJob -> TravisAddons
tjEnv :: TravisJob -> Maybe String
tjCompiler :: TravisJob -> 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
"compiler" String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall a. IsString a => String -> a
fromString String
tjCompiler
        forall x. x -> ListBuilder x ()
item forall a b. (a -> b) -> a -> b
$ String
"addons"   String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall a. ToYaml a => a -> Yaml [String]
toYaml (forall a. ToJSON a => a -> Value
Aeson.toJSON TravisAddons
tjAddons)
        forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe String
tjEnv forall a b. (a -> b) -> a -> b
$ \String
e ->
            forall x. x -> ListBuilder x ()
item forall a b. (a -> b) -> a -> b
$ String
"env" String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall a. IsString a => String -> a
fromString String
e
        forall x. x -> ListBuilder x ()
item forall a b. (a -> b) -> a -> b
$ String
"os" String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall a. IsString a => String -> a
fromString String
tjOS

instance ToYaml TravisAllowFailure where
    toYaml :: TravisAllowFailure -> Yaml [String]
toYaml TravisAllowFailure {String
tafCompiler :: String
tafCompiler :: TravisAllowFailure -> String
..} = 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 String
tafCompiler
        ]

instance ToYaml TravisAddons where
    toYaml :: TravisAddons -> Yaml [String]
toYaml TravisAddons {Bool
Maybe String
TravisApt
taGoogleChrome :: Bool
taPostgres :: Maybe String
taApt :: TravisApt
taGoogleChrome :: TravisAddons -> Bool
taPostgres :: TravisAddons -> Maybe String
taApt :: TravisAddons -> TravisApt
..} = 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
        -- no apt on purpose
        forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe String
taPostgres forall a b. (a -> b) -> a -> b
$ \String
p ->
            forall x. x -> ListBuilder x ()
item forall a b. (a -> b) -> a -> b
$ String
"postgresql" String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall a. IsString a => String -> a
fromString String
p
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
taGoogleChrome forall a b. (a -> b) -> a -> b
$
            forall x. x -> ListBuilder x ()
item forall a b. (a -> b) -> a -> b
$ String
"google" String -> Yaml [String] -> ([String], String, Yaml [String])
~> forall a. IsString a => String -> a
fromString String
"stable"

-------------------------------------------------------------------------------
-- ToJSON
-------------------------------------------------------------------------------

instance Aeson.ToJSON TravisAddons where
    -- no postgresql on purpose
    toJSON :: TravisAddons -> Value
toJSON TravisAddons {Bool
Maybe String
TravisApt
taGoogleChrome :: Bool
taPostgres :: Maybe String
taApt :: TravisApt
taGoogleChrome :: TravisAddons -> Bool
taPostgres :: TravisAddons -> Maybe String
taApt :: TravisAddons -> TravisApt
..} = [Pair] -> Value
Aeson.object
        [ Key
"apt" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Aeson..= TravisApt
taApt
        ]

instance Aeson.ToJSON TravisApt where
    toJSON :: TravisApt -> Value
toJSON TravisApt {[String]
[TravisAptSource]
taSources :: [TravisAptSource]
taPackages :: [String]
taSources :: TravisApt -> [TravisAptSource]
taPackages :: TravisApt -> [String]
..} = [Pair] -> Value
Aeson.object
        [ Key
"packages" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Aeson..= [String]
taPackages
        , Key
"sources"  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Aeson..= [TravisAptSource]
taSources
        ]

instance Aeson.ToJSON TravisAptSource where
    toJSON :: TravisAptSource -> Value
toJSON (TravisAptSource String
s) = forall a. ToJSON a => a -> Value
Aeson.toJSON String
s
    toJSON (TravisAptSourceLine String
sl Maybe String
Nothing) = [Pair] -> Value
Aeson.object
        [ Key
"sourceline" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Aeson..= String
sl
        ]
    toJSON (TravisAptSourceLine String
sl (Just String
key_url)) = [Pair] -> Value
Aeson.object
        [ Key
"sourceline" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Aeson..= String
sl
        , Key
"key_url"    forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Aeson..= String
key_url
        ]