{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE PatternSynonyms #-}
-- | Logic and datatypes for parsing @hie.yaml@ files.
module HIE.Bios.Config(
    readConfig,
    Config(..),
    CradleConfig(..),
    CabalType,
    pattern CabalType,
    cabalComponent,
    cabalProjectFile,
    StackType,
    pattern StackType,
    stackComponent,
    stackYaml,
    CradleTree(..),
    Callable(..)
    ) where

import Control.Exception
import           Data.Maybe (mapMaybe, fromMaybe)
import           Data.Monoid (Last(..))
import           Data.Aeson (JSONPath)
import           Data.Yaml
import           Data.Yaml.Internal (Warning(..))

import           HIE.Bios.Config.YAML (CradleConfigYAML)
import qualified HIE.Bios.Config.YAML as YAML


-- | Configuration that can be used to load a 'Cradle'.
-- A configuration has roughly the following form:
--
-- @
-- cradle:
--   cabal:
--     component: "lib:hie-bios"
-- @
newtype Config a = Config { forall a. Config a -> CradleConfig a
cradle :: CradleConfig a }
    deriving (Int -> Config a -> ShowS
[Config a] -> ShowS
Config a -> String
(Int -> Config a -> ShowS)
-> (Config a -> String) -> ([Config a] -> ShowS) -> Show (Config a)
forall a. Int -> Config a -> ShowS
forall a. [Config a] -> ShowS
forall a. Config a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Int -> Config a -> ShowS
showsPrec :: Int -> Config a -> ShowS
$cshow :: forall a. Config a -> String
show :: Config a -> String
$cshowList :: forall a. [Config a] -> ShowS
showList :: [Config a] -> ShowS
Show, Config a -> Config a -> Bool
(Config a -> Config a -> Bool)
-> (Config a -> Config a -> Bool) -> Eq (Config a)
forall a. Eq a => Config a -> Config a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Config a -> Config a -> Bool
== :: Config a -> Config a -> Bool
$c/= :: forall a. Eq a => Config a -> Config a -> Bool
/= :: Config a -> Config a -> Bool
Eq, (forall a b. (a -> b) -> Config a -> Config b)
-> (forall a b. a -> Config b -> Config a) -> Functor Config
forall a b. a -> Config b -> Config a
forall a b. (a -> b) -> Config a -> Config b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Config a -> Config b
fmap :: forall a b. (a -> b) -> Config a -> Config b
$c<$ :: forall a b. a -> Config b -> Config a
<$ :: forall a b. a -> Config b -> Config a
Functor)

data CradleConfig a =
    CradleConfig
        { forall a. CradleConfig a -> [String]
cradleDependencies :: [FilePath]
        -- ^ Dependencies of a cradle.
        -- Dependencies are expected to be relative to the root directory.
        -- The given files are not required to exist.
        , forall a. CradleConfig a -> CradleTree a
cradleTree :: CradleTree a
        -- ^ Type of the cradle to use. Actions to obtain
        -- compiler flags from are dependant on this field.
        }
        deriving (Int -> CradleConfig a -> ShowS
[CradleConfig a] -> ShowS
CradleConfig a -> String
(Int -> CradleConfig a -> ShowS)
-> (CradleConfig a -> String)
-> ([CradleConfig a] -> ShowS)
-> Show (CradleConfig a)
forall a. Int -> CradleConfig a -> ShowS
forall a. [CradleConfig a] -> ShowS
forall a. CradleConfig a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Int -> CradleConfig a -> ShowS
showsPrec :: Int -> CradleConfig a -> ShowS
$cshow :: forall a. CradleConfig a -> String
show :: CradleConfig a -> String
$cshowList :: forall a. [CradleConfig a] -> ShowS
showList :: [CradleConfig a] -> ShowS
Show, CradleConfig a -> CradleConfig a -> Bool
(CradleConfig a -> CradleConfig a -> Bool)
-> (CradleConfig a -> CradleConfig a -> Bool)
-> Eq (CradleConfig a)
forall a. Eq a => CradleConfig a -> CradleConfig a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => CradleConfig a -> CradleConfig a -> Bool
== :: CradleConfig a -> CradleConfig a -> Bool
$c/= :: forall a. Eq a => CradleConfig a -> CradleConfig a -> Bool
/= :: CradleConfig a -> CradleConfig a -> Bool
Eq, (forall a b. (a -> b) -> CradleConfig a -> CradleConfig b)
-> (forall a b. a -> CradleConfig b -> CradleConfig a)
-> Functor CradleConfig
forall a b. a -> CradleConfig b -> CradleConfig a
forall a b. (a -> b) -> CradleConfig a -> CradleConfig b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> CradleConfig a -> CradleConfig b
fmap :: forall a b. (a -> b) -> CradleConfig a -> CradleConfig b
$c<$ :: forall a b. a -> CradleConfig b -> CradleConfig a
<$ :: forall a b. a -> CradleConfig b -> CradleConfig a
Functor)

data Callable = Program FilePath | Command String
    deriving (Int -> Callable -> ShowS
[Callable] -> ShowS
Callable -> String
(Int -> Callable -> ShowS)
-> (Callable -> String) -> ([Callable] -> ShowS) -> Show Callable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Callable -> ShowS
showsPrec :: Int -> Callable -> ShowS
$cshow :: Callable -> String
show :: Callable -> String
$cshowList :: [Callable] -> ShowS
showList :: [Callable] -> ShowS
Show, Callable -> Callable -> Bool
(Callable -> Callable -> Bool)
-> (Callable -> Callable -> Bool) -> Eq Callable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Callable -> Callable -> Bool
== :: Callable -> Callable -> Bool
$c/= :: Callable -> Callable -> Bool
/= :: Callable -> Callable -> Bool
Eq)

-- | A cabal yaml configuration consists of component configuration and project configuration.
--
-- The former specifies how we can find the compilation flags for any filepath
-- in the project.
-- There might be an explicit mapping from source directories to components,
-- or we let cabal figure it out on its own.
--
-- Project configuration is the 'cabal.project' file, we is by default named
-- 'cabal.project'. We allow to override that name to have an HLS specific
-- project configuration file.
data CabalType
    = CabalType_ { CabalType -> Last String
_cabalComponent :: !(Last String), CabalType -> Last String
_cabalProjectFile :: !(Last FilePath) }
    deriving (CabalType -> CabalType -> Bool
(CabalType -> CabalType -> Bool)
-> (CabalType -> CabalType -> Bool) -> Eq CabalType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CabalType -> CabalType -> Bool
== :: CabalType -> CabalType -> Bool
$c/= :: CabalType -> CabalType -> Bool
/= :: CabalType -> CabalType -> Bool
Eq)

instance Semigroup CabalType where
    CabalType_ Last String
cr Last String
cpr <> :: CabalType -> CabalType -> CabalType
<> CabalType_ Last String
cl Last String
cpl = Last String -> Last String -> CabalType
CabalType_ (Last String
cr Last String -> Last String -> Last String
forall a. Semigroup a => a -> a -> a
<> Last String
cl) (Last String
cpr Last String -> Last String -> Last String
forall a. Semigroup a => a -> a -> a
<> Last String
cpl)

instance Monoid CabalType where
    mempty :: CabalType
mempty = Last String -> Last String -> CabalType
CabalType_ Last String
forall a. Monoid a => a
mempty Last String
forall a. Monoid a => a
mempty

pattern CabalType :: Maybe String -> Maybe FilePath -> CabalType
pattern $mCabalType :: forall {r}.
CabalType
-> (Maybe String -> Maybe String -> r) -> ((# #) -> r) -> r
$bCabalType :: Maybe String -> Maybe String -> CabalType
CabalType { CabalType -> Maybe String
cabalComponent, CabalType -> Maybe String
cabalProjectFile } = CabalType_ (Last cabalComponent) (Last cabalProjectFile)
{-# COMPLETE CabalType #-}

instance Show CabalType where
  show :: CabalType -> String
show = CradleTree Any -> String
forall a. Show a => a -> String
show (CradleTree Any -> String)
-> (CabalType -> CradleTree Any) -> CabalType -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CabalType -> CradleTree Any
forall a. CabalType -> CradleTree a
Cabal

data StackType
    = StackType_ { StackType -> Last String
_stackComponent :: !(Last String) , StackType -> Last String
_stackYaml :: !(Last String) }
    deriving (StackType -> StackType -> Bool
(StackType -> StackType -> Bool)
-> (StackType -> StackType -> Bool) -> Eq StackType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StackType -> StackType -> Bool
== :: StackType -> StackType -> Bool
$c/= :: StackType -> StackType -> Bool
/= :: StackType -> StackType -> Bool
Eq)

instance Semigroup StackType where
    StackType_ Last String
cr Last String
yr <> :: StackType -> StackType -> StackType
<> StackType_ Last String
cl Last String
yl = Last String -> Last String -> StackType
StackType_ (Last String
cr Last String -> Last String -> Last String
forall a. Semigroup a => a -> a -> a
<> Last String
cl) (Last String
yr Last String -> Last String -> Last String
forall a. Semigroup a => a -> a -> a
<> Last String
yl)

instance Monoid StackType where
    mempty :: StackType
mempty = Last String -> Last String -> StackType
StackType_ Last String
forall a. Monoid a => a
mempty Last String
forall a. Monoid a => a
mempty

pattern StackType :: Maybe String -> Maybe FilePath -> StackType
pattern $mStackType :: forall {r}.
StackType
-> (Maybe String -> Maybe String -> r) -> ((# #) -> r) -> r
$bStackType :: Maybe String -> Maybe String -> StackType
StackType { StackType -> Maybe String
stackComponent, StackType -> Maybe String
stackYaml } = StackType_ (Last stackComponent) (Last stackYaml)
{-# COMPLETE StackType #-}

instance Show StackType where
  show :: StackType -> String
show = CradleTree Any -> String
forall a. Show a => a -> String
show (CradleTree Any -> String)
-> (StackType -> CradleTree Any) -> StackType -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackType -> CradleTree Any
forall a. StackType -> CradleTree a
Stack

data CradleTree a
    = Cabal { forall a. CradleTree a -> CabalType
cabalType :: !CabalType }
    | CabalMulti { forall a. CradleTree a -> CabalType
defaultCabal :: !CabalType, forall a. CradleTree a -> [(String, CabalType)]
subCabalComponents :: [ (FilePath, CabalType) ] }
    | Stack { forall a. CradleTree a -> StackType
stackType :: !StackType }
    | StackMulti { forall a. CradleTree a -> StackType
defaultStack :: !StackType, forall a. CradleTree a -> [(String, StackType)]
subStackComponents :: [ (FilePath, StackType) ] }
--  Bazel and Obelisk used to be supported but bit-rotted and no users have complained.
--  They can be added back if a user
--    | Bazel
--    | Obelisk
    | Bios
        { forall a. CradleTree a -> Callable
call :: Callable
        -- ^ Path to program or shell command that retrieves options to compile a file
        , forall a. CradleTree a -> Maybe Callable
depsCall :: Maybe Callable
        -- ^ Optional path to program or shell command to obtain cradle dependencies.
        -- Each cradle dependency is to be expected to be on a separate line
        -- and relative to the root dir of the cradle.
        , forall a. CradleTree a -> Maybe String
ghcPath :: Maybe FilePath
        -- ^ Optional path to the ghc binary
        }
    | Direct { forall a. CradleTree a -> [String]
arguments :: [String] }
    | None
    | Multi [ (FilePath, CradleConfig a) ]
    | Other { forall a. CradleTree a -> a
otherConfig :: a, forall a. CradleTree a -> Value
originalYamlValue :: Value }
    deriving (CradleTree a -> CradleTree a -> Bool
(CradleTree a -> CradleTree a -> Bool)
-> (CradleTree a -> CradleTree a -> Bool) -> Eq (CradleTree a)
forall a. Eq a => CradleTree a -> CradleTree a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => CradleTree a -> CradleTree a -> Bool
== :: CradleTree a -> CradleTree a -> Bool
$c/= :: forall a. Eq a => CradleTree a -> CradleTree a -> Bool
/= :: CradleTree a -> CradleTree a -> Bool
Eq, (forall a b. (a -> b) -> CradleTree a -> CradleTree b)
-> (forall a b. a -> CradleTree b -> CradleTree a)
-> Functor CradleTree
forall a b. a -> CradleTree b -> CradleTree a
forall a b. (a -> b) -> CradleTree a -> CradleTree b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> CradleTree a -> CradleTree b
fmap :: forall a b. (a -> b) -> CradleTree a -> CradleTree b
$c<$ :: forall a b. a -> CradleTree b -> CradleTree a
<$ :: forall a b. a -> CradleTree b -> CradleTree a
Functor)

instance Show (CradleTree a) where
    show :: CradleTree a -> String
show (Cabal CabalType
comp) = String
"Cabal {component = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe String -> String
forall a. Show a => a -> String
show (CabalType -> Maybe String
cabalComponent CabalType
comp) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}"
    show (CabalMulti CabalType
d [(String, CabalType)]
a) = String
"CabalMulti {defaultCabal = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CabalType -> String
forall a. Show a => a -> String
show CabalType
d String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", subCabalComponents = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [(String, CabalType)] -> String
forall a. Show a => a -> String
show [(String, CabalType)]
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}"
    show (Stack StackType
comp) = String
"Stack {component = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe String -> String
forall a. Show a => a -> String
show (StackType -> Maybe String
stackComponent StackType
comp) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", stackYaml = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe String -> String
forall a. Show a => a -> String
show (StackType -> Maybe String
stackYaml StackType
comp) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}"
    show (StackMulti StackType
d [(String, StackType)]
a) = String
"StackMulti {defaultStack = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ StackType -> String
forall a. Show a => a -> String
show StackType
d String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", subStackComponents = "  String -> ShowS
forall a. [a] -> [a] -> [a]
++ [(String, StackType)] -> String
forall a. Show a => a -> String
show [(String, StackType)]
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}"
    show Bios { Callable
call :: forall a. CradleTree a -> Callable
call :: Callable
call, Maybe Callable
depsCall :: forall a. CradleTree a -> Maybe Callable
depsCall :: Maybe Callable
depsCall } = String
"Bios {call = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Callable -> String
forall a. Show a => a -> String
show Callable
call String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", depsCall = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe Callable -> String
forall a. Show a => a -> String
show Maybe Callable
depsCall String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}"
    show (Direct [String]
args) = String
"Direct {arguments = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
args String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}"
    show CradleTree a
None = String
"None"
    show (Multi [(String, CradleConfig a)]
a) = String
"Multi " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [(String, CradleConfig a)] -> String
forall a. Show a => a -> String
show [(String, CradleConfig a)]
a
    show (Other a
_ Value
val) = String
"Other {originalYamlValue = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Value -> String
forall a. Show a => a -> String
show Value
val String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}"

readConfig :: FromJSON a => FilePath -> IO (Config a)
readConfig :: forall a. FromJSON a => String -> IO (Config a)
readConfig String
fp = do
  Either ParseException ([Warning], CradleConfigYAML a)
result <- String
-> IO (Either ParseException ([Warning], CradleConfigYAML a))
forall a.
FromJSON a =>
String -> IO (Either ParseException ([Warning], a))
decodeFileWithWarnings String
fp
  (CradleConfigYAML a -> Config a)
-> IO (CradleConfigYAML a) -> IO (Config a)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CradleConfigYAML a -> Config a
forall a. CradleConfigYAML a -> Config a
fromYAMLConfig (IO (CradleConfigYAML a) -> IO (Config a))
-> IO (CradleConfigYAML a) -> IO (Config a)
forall a b. (a -> b) -> a -> b
$ (ParseException -> IO (CradleConfigYAML a))
-> (([Warning], CradleConfigYAML a) -> IO (CradleConfigYAML a))
-> Either ParseException ([Warning], CradleConfigYAML a)
-> IO (CradleConfigYAML a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParseException -> IO (CradleConfigYAML a)
forall e a. Exception e => e -> IO a
throwIO ([Warning], CradleConfigYAML a) -> IO (CradleConfigYAML a)
forall a.
([Warning], CradleConfigYAML a) -> IO (CradleConfigYAML a)
failOnAnyDuplicate Either ParseException ([Warning], CradleConfigYAML a)
result
  where
    failOnAnyDuplicate :: ([Warning], CradleConfigYAML a) -> IO (CradleConfigYAML a)
    failOnAnyDuplicate :: forall a.
([Warning], CradleConfigYAML a) -> IO (CradleConfigYAML a)
failOnAnyDuplicate ([Warning]
warnings, CradleConfigYAML a
config) = do
        ()
_ <- case (Warning -> Maybe JSONPath) -> [Warning] -> [JSONPath]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Warning -> Maybe JSONPath
failOnDuplicate [Warning]
warnings of
                dups :: [JSONPath]
dups@(JSONPath
_:[JSONPath]
_) -> ParseException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (ParseException -> IO ()) -> ParseException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe YamlException -> ParseException
InvalidYaml (Maybe YamlException -> ParseException)
-> Maybe YamlException -> ParseException
forall a b. (a -> b) -> a -> b
$ YamlException -> Maybe YamlException
forall a. a -> Maybe a
Just (YamlException -> Maybe YamlException)
-> YamlException -> Maybe YamlException
forall a b. (a -> b) -> a -> b
$ String -> YamlException
YamlException
                                      (String -> YamlException) -> String -> YamlException
forall a b. (a -> b) -> a -> b
$ String
"Duplicate keys are not allowed, found: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [JSONPath] -> String
forall a. Show a => a -> String
show [JSONPath]
dups
                [JSONPath]
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        CradleConfigYAML a -> IO (CradleConfigYAML a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CradleConfigYAML a
config
    -- future proofing in case more warnings are added
    failOnDuplicate :: Warning -> Maybe JSONPath
    failOnDuplicate :: Warning -> Maybe JSONPath
failOnDuplicate (DuplicateKey JSONPath
a) = JSONPath -> Maybe JSONPath
forall a. a -> Maybe a
Just JSONPath
a

fromYAMLConfig :: CradleConfigYAML a -> Config a
fromYAMLConfig :: forall a. CradleConfigYAML a -> Config a
fromYAMLConfig CradleConfigYAML a
cradleYAML = CradleConfig a -> Config a
forall a. CradleConfig a -> Config a
Config (CradleConfig a -> Config a) -> CradleConfig a -> Config a
forall a b. (a -> b) -> a -> b
$ [String] -> CradleTree a -> CradleConfig a
forall a. [String] -> CradleTree a -> CradleConfig a
CradleConfig ([String] -> Maybe [String] -> [String]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [String] -> [String]) -> Maybe [String] -> [String]
forall a b. (a -> b) -> a -> b
$ CradleConfigYAML a -> Maybe [String]
forall a. CradleConfigYAML a -> Maybe [String]
YAML.dependencies CradleConfigYAML a
cradleYAML)
                                                  (CradleComponent a -> CradleTree a
forall a. CradleComponent a -> CradleTree a
toCradleTree (CradleComponent a -> CradleTree a)
-> CradleComponent a -> CradleTree a
forall a b. (a -> b) -> a -> b
$ CradleConfigYAML a -> CradleComponent a
forall a. CradleConfigYAML a -> CradleComponent a
YAML.cradle CradleConfigYAML a
cradleYAML)

toCradleTree :: YAML.CradleComponent a -> CradleTree a
toCradleTree :: forall a. CradleComponent a -> CradleTree a
toCradleTree (YAML.Multi [MultiSubComponent a]
cpts)  =
  [(String, CradleConfig a)] -> CradleTree a
forall a. [(String, CradleConfig a)] -> CradleTree a
Multi ([(String, CradleConfig a)] -> CradleTree a)
-> [(String, CradleConfig a)] -> CradleTree a
forall a b. (a -> b) -> a -> b
$ (\(YAML.MultiSubComponent String
fp' CradleConfigYAML a
cfg) -> (String
fp', Config a -> CradleConfig a
forall a. Config a -> CradleConfig a
cradle (Config a -> CradleConfig a) -> Config a -> CradleConfig a
forall a b. (a -> b) -> a -> b
$ CradleConfigYAML a -> Config a
forall a. CradleConfigYAML a -> Config a
fromYAMLConfig CradleConfigYAML a
cfg)) (MultiSubComponent a -> (String, CradleConfig a))
-> [MultiSubComponent a] -> [(String, CradleConfig a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [MultiSubComponent a]
cpts
toCradleTree (YAML.Stack (YAML.StackConfig Maybe String
yaml OneOrManyComponents StackComponent
cpts)) =
  case OneOrManyComponents StackComponent
cpts of
    OneOrManyComponents StackComponent
YAML.NoComponent          -> StackType -> CradleTree a
forall a. StackType -> CradleTree a
Stack (StackType -> CradleTree a) -> StackType -> CradleTree a
forall a b. (a -> b) -> a -> b
$ Maybe String -> Maybe String -> StackType
StackType Maybe String
forall a. Maybe a
Nothing Maybe String
yaml
    (YAML.SingleComponent String
c)  -> StackType -> CradleTree a
forall a. StackType -> CradleTree a
Stack (StackType -> CradleTree a) -> StackType -> CradleTree a
forall a b. (a -> b) -> a -> b
$ Maybe String -> Maybe String -> StackType
StackType (String -> Maybe String
forall a. a -> Maybe a
Just String
c) Maybe String
yaml
    (YAML.ManyComponents [StackComponent]
cs)  -> StackType -> [(String, StackType)] -> CradleTree a
forall a. StackType -> [(String, StackType)] -> CradleTree a
StackMulti (Maybe String -> Maybe String -> StackType
StackType Maybe String
forall a. Maybe a
Nothing Maybe String
yaml)
                                            ((\(YAML.StackComponent String
fp' String
c Maybe String
cYAML) ->
                                              (String
fp', Maybe String -> Maybe String -> StackType
StackType (String -> Maybe String
forall a. a -> Maybe a
Just String
c) Maybe String
cYAML)) (StackComponent -> (String, StackType))
-> [StackComponent] -> [(String, StackType)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [StackComponent]
cs)
toCradleTree (YAML.Cabal (YAML.CabalConfig Maybe String
prjFile OneOrManyComponents CabalComponent
cpts)) =
  case OneOrManyComponents CabalComponent
cpts of
    OneOrManyComponents CabalComponent
YAML.NoComponent          -> CabalType -> CradleTree a
forall a. CabalType -> CradleTree a
Cabal (CabalType -> CradleTree a) -> CabalType -> CradleTree a
forall a b. (a -> b) -> a -> b
$ Maybe String -> Maybe String -> CabalType
CabalType Maybe String
forall a. Maybe a
Nothing Maybe String
prjFile
    (YAML.SingleComponent String
c)  -> CabalType -> CradleTree a
forall a. CabalType -> CradleTree a
Cabal (CabalType -> CradleTree a) -> CabalType -> CradleTree a
forall a b. (a -> b) -> a -> b
$ Maybe String -> Maybe String -> CabalType
CabalType (String -> Maybe String
forall a. a -> Maybe a
Just String
c) Maybe String
prjFile
    (YAML.ManyComponents [CabalComponent]
cs)  -> CabalType -> [(String, CabalType)] -> CradleTree a
forall a. CabalType -> [(String, CabalType)] -> CradleTree a
CabalMulti (Maybe String -> Maybe String -> CabalType
CabalType Maybe String
forall a. Maybe a
Nothing Maybe String
prjFile)
                                            ((\(YAML.CabalComponent String
fp' String
c Maybe String
cPrjFile) ->
                                              (String
fp', Maybe String -> Maybe String -> CabalType
CabalType (String -> Maybe String
forall a. a -> Maybe a
Just String
c) Maybe String
cPrjFile)) (CabalComponent -> (String, CabalType))
-> [CabalComponent] -> [(String, CabalType)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CabalComponent]
cs)
toCradleTree (YAML.Direct DirectConfig
cfg)  = [String] -> CradleTree a
forall a. [String] -> CradleTree a
Direct (DirectConfig -> [String]
YAML.arguments DirectConfig
cfg)
toCradleTree (YAML.Bios BiosConfig
cfg)    = Callable -> Maybe Callable -> Maybe String -> CradleTree a
forall a.
Callable -> Maybe Callable -> Maybe String -> CradleTree a
Bios  (Callable -> Callable
toCallable (Callable -> Callable) -> Callable -> Callable
forall a b. (a -> b) -> a -> b
$ BiosConfig -> Callable
YAML.callable BiosConfig
cfg)
                                        (Callable -> Callable
toCallable (Callable -> Callable) -> Maybe Callable -> Maybe Callable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BiosConfig -> Maybe Callable
YAML.depsCallable BiosConfig
cfg)
                                        (BiosConfig -> Maybe String
YAML.ghcPath BiosConfig
cfg)
toCradleTree (YAML.None NoneConfig
_)      = CradleTree a
forall a. CradleTree a
None
toCradleTree (YAML.Other OtherConfig a
cfg)   = a -> Value -> CradleTree a
forall a. a -> Value -> CradleTree a
Other (OtherConfig a -> a
forall a. OtherConfig a -> a
YAML.otherConfig OtherConfig a
cfg)
                                        (OtherConfig a -> Value
forall a. OtherConfig a -> Value
YAML.originalYamlValue OtherConfig a
cfg)

toCallable :: YAML.Callable -> Callable
toCallable :: Callable -> Callable
toCallable (YAML.Program String
p) = String -> Callable
Program String
p
toCallable (YAML.Shell String
c)   = String -> Callable
Command String
c