{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE DeriveFunctor #-}
-- | Logic and datatypes for parsing @hie.yaml@ files.
module HIE.Bios.Config(
    readConfig,
    Config(..),
    CradleConfig(..),
    CradleType(..),
    Callable(..)
    ) where

import qualified Data.Text as T
import qualified Data.Vector as V
import qualified Data.HashMap.Strict as Map
import           Data.Foldable (foldrM)
import           Data.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 { 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
showList :: [Config a] -> ShowS
$cshowList :: forall a. [Config a] -> ShowS
show :: Config a -> String
$cshow :: forall a. Config a -> String
showsPrec :: Int -> Config a -> ShowS
$cshowsPrec :: forall a. Int -> 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
/= :: Config a -> Config a -> Bool
$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
Eq, a -> Config b -> Config a
(a -> b) -> Config a -> Config b
(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
<$ :: a -> Config b -> Config a
$c<$ :: forall a b. a -> Config b -> Config a
fmap :: (a -> b) -> Config a -> Config b
$cfmap :: forall a b. (a -> b) -> Config a -> Config b
Functor)

data CradleConfig a =
    CradleConfig
        { 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.
        , CradleConfig a -> CradleType a
cradleType :: CradleType 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
showList :: [CradleConfig a] -> ShowS
$cshowList :: forall a. [CradleConfig a] -> ShowS
show :: CradleConfig a -> String
$cshow :: forall a. CradleConfig a -> String
showsPrec :: Int -> CradleConfig a -> ShowS
$cshowsPrec :: forall a. Int -> 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
/= :: CradleConfig a -> CradleConfig a -> Bool
$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
Eq, a -> CradleConfig b -> CradleConfig a
(a -> b) -> CradleConfig a -> CradleConfig b
(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
<$ :: a -> CradleConfig b -> CradleConfig a
$c<$ :: forall a b. a -> CradleConfig b -> CradleConfig a
fmap :: (a -> b) -> CradleConfig a -> CradleConfig b
$cfmap :: forall a b. (a -> b) -> CradleConfig a -> CradleConfig b
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
showList :: [Callable] -> ShowS
$cshowList :: [Callable] -> ShowS
show :: Callable -> String
$cshow :: Callable -> String
showsPrec :: Int -> Callable -> ShowS
$cshowsPrec :: Int -> Callable -> ShowS
Show, Callable -> Callable -> Bool
(Callable -> Callable -> Bool)
-> (Callable -> Callable -> Bool) -> Eq Callable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Callable -> Callable -> Bool
$c/= :: Callable -> Callable -> Bool
== :: Callable -> Callable -> Bool
$c== :: Callable -> Callable -> Bool
Eq)

data CradleType a
    = Cabal { CradleType a -> Maybe String
component :: Maybe String }
    | CabalMulti [ (FilePath, String) ]
    | Stack { component :: Maybe String }
    | StackMulti [ (FilePath, String) ]
--  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
        { CradleType a -> Callable
call :: Callable
        -- ^ Path to program or shell command that retrieves options to compile a file
        , CradleType 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.
        , CradleType a -> Maybe String
ghcPath :: Maybe FilePath
        -- ^ Optional path to the ghc binary
        }
    | Direct { CradleType a -> [String]
arguments :: [String] }
    | None
    | Multi [ (FilePath, CradleConfig a) ]
    | Other { CradleType a -> a
otherConfig :: a, CradleType a -> Value
originalYamlValue :: Value }
    deriving (CradleType a -> CradleType a -> Bool
(CradleType a -> CradleType a -> Bool)
-> (CradleType a -> CradleType a -> Bool) -> Eq (CradleType a)
forall a. Eq a => CradleType a -> CradleType a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CradleType a -> CradleType a -> Bool
$c/= :: forall a. Eq a => CradleType a -> CradleType a -> Bool
== :: CradleType a -> CradleType a -> Bool
$c== :: forall a. Eq a => CradleType a -> CradleType a -> Bool
Eq, a -> CradleType b -> CradleType a
(a -> b) -> CradleType a -> CradleType b
(forall a b. (a -> b) -> CradleType a -> CradleType b)
-> (forall a b. a -> CradleType b -> CradleType a)
-> Functor CradleType
forall a b. a -> CradleType b -> CradleType a
forall a b. (a -> b) -> CradleType a -> CradleType b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> CradleType b -> CradleType a
$c<$ :: forall a b. a -> CradleType b -> CradleType a
fmap :: (a -> b) -> CradleType a -> CradleType b
$cfmap :: forall a b. (a -> b) -> CradleType a -> CradleType b
Functor)

instance FromJSON a => FromJSON (CradleType a) where
    parseJSON :: Value -> Parser (CradleType a)
parseJSON (Object o :: Object
o) = Object -> Parser (CradleType a)
forall a. FromJSON a => Object -> Parser (CradleType a)
parseCradleType Object
o
    parseJSON _ = String -> Parser (CradleType a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Not a known cradle type. Possible are: cabal, stack, bios, direct, default, none, multi"

instance Show (CradleType a) where
    show :: CradleType a -> String
show (Cabal comp :: Maybe String
comp) = "Cabal {component = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe String -> String
forall a. Show a => a -> String
show Maybe String
comp String -> ShowS
forall a. [a] -> [a] -> [a]
++ "}"
    show (CabalMulti a :: [(String, String)]
a) = "CabalMulti " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [(String, String)] -> String
forall a. Show a => a -> String
show [(String, String)]
a
    show (Stack comp :: Maybe String
comp) = "Stack {component = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe String -> String
forall a. Show a => a -> String
show Maybe String
comp String -> ShowS
forall a. [a] -> [a] -> [a]
++ "}"
    show (StackMulti a :: [(String, String)]
a) = "StackMulti " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [(String, String)] -> String
forall a. Show a => a -> String
show [(String, String)]
a
    show Bios { Callable
call :: Callable
call :: forall a. CradleType a -> Callable
call, Maybe Callable
depsCall :: Maybe Callable
depsCall :: forall a. CradleType a -> Maybe Callable
depsCall } = "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]
++ ", 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]
++ "}"
    show (Direct args :: [String]
args) = "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]
++ "}"
    show None = "None"
    show (Multi a :: [(String, CradleConfig a)]
a) = "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 _ val :: Value
val) = "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]
++ "}"

parseCradleType :: FromJSON a => Object -> Parser (CradleType a)
parseCradleType :: Object -> Parser (CradleType a)
parseCradleType o :: Object
o
    | Just val :: Value
val <- Text -> Object -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup "cabal" Object
o = Value -> Parser (CradleType a)
forall a. Value -> Parser (CradleType a)
parseCabal Value
val
    | Just val :: Value
val <- Text -> Object -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup "stack" Object
o = Value -> Parser (CradleType a)
forall a. Value -> Parser (CradleType a)
parseStack Value
val
--    | Just _val <- Map.lookup "bazel" o = return Bazel
--    | Just _val <- Map.lookup "obelisk" o = return Obelisk
    | Just val :: Value
val <- Text -> Object -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup "bios" Object
o = Value -> Parser (CradleType a)
forall a. Value -> Parser (CradleType a)
parseBios Value
val
    | Just val :: Value
val <- Text -> Object -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup "direct" Object
o = Value -> Parser (CradleType a)
forall a. Value -> Parser (CradleType a)
parseDirect Value
val
    | Just _val :: Value
_val <- Text -> Object -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup "none" Object
o = CradleType a -> Parser (CradleType a)
forall (m :: * -> *) a. Monad m => a -> m a
return CradleType a
forall a. CradleType a
None
    | Just val :: Value
val  <- Text -> Object -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup "multi" Object
o = Value -> Parser (CradleType a)
forall a. FromJSON a => Value -> Parser (CradleType a)
parseMulti Value
val
    | Just val :: Value
val  <- Text -> Object -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup "other" Object
o = a -> Value -> CradleType a
forall a. a -> Value -> CradleType a
Other (a -> Value -> CradleType a)
-> Parser a -> Parser (Value -> CradleType a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value
val Parser (Value -> CradleType a)
-> Parser Value -> Parser (CradleType a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Parser Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
val
parseCradleType o :: Object
o = String -> Parser (CradleType a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (CradleType a))
-> String -> Parser (CradleType a)
forall a b. (a -> b) -> a -> b
$ "Unknown cradle type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Object -> String
forall a. Show a => a -> String
show Object
o

parseStackOrCabal
  :: (Maybe String -> CradleType a)
  -> ([(FilePath, String)] -> CradleType a)
  -> Value
  -> Parser (CradleType a)
parseStackOrCabal :: (Maybe String -> CradleType a)
-> ([(String, String)] -> CradleType a)
-> Value
-> Parser (CradleType a)
parseStackOrCabal singleConstructor :: Maybe String -> CradleType a
singleConstructor _ (Object x :: Object
x)
  | Object -> Int
forall k v. HashMap k v -> Int
Map.size Object
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1, Just (String stackComponent :: Text
stackComponent) <- Text -> Object -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup "component" Object
x
  = CradleType a -> Parser (CradleType a)
forall (m :: * -> *) a. Monad m => a -> m a
return (CradleType a -> Parser (CradleType a))
-> CradleType a -> Parser (CradleType a)
forall a b. (a -> b) -> a -> b
$ Maybe String -> CradleType a
singleConstructor (Maybe String -> CradleType a) -> Maybe String -> CradleType a
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
stackComponent
  | Object -> Bool
forall k v. HashMap k v -> Bool
Map.null Object
x
  = CradleType a -> Parser (CradleType a)
forall (m :: * -> *) a. Monad m => a -> m a
return (CradleType a -> Parser (CradleType a))
-> CradleType a -> Parser (CradleType a)
forall a b. (a -> b) -> a -> b
$ Maybe String -> CradleType a
singleConstructor Maybe String
forall a. Maybe a
Nothing
  | Bool
otherwise
  = String -> Parser (CradleType a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Not a valid Configuration type, following keys are allowed: component"
parseStackOrCabal _ multiConstructor :: [(String, String)] -> CradleType a
multiConstructor (Array x :: Array
x) = do
  let parseOne :: Value -> m (String, String)
parseOne e :: Value
e
        | Object v :: Object
v <- Value
e
        , Just (String prefix :: Text
prefix) <- Text -> Object -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup "path" Object
v
        , Just (String comp :: Text
comp) <- Text -> Object -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup "component" Object
v
        , Object -> Int
forall k v. HashMap k v -> Int
Map.size Object
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 2
        = (String, String) -> m (String, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> String
T.unpack Text
prefix, Text -> String
T.unpack Text
comp)
        | Bool
otherwise
        = String -> m (String, String)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Expected an object with path and component keys"

  [(String, String)]
xs <- (Value -> [(String, String)] -> Parser [(String, String)])
-> [(String, String)] -> Array -> Parser [(String, String)]
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
foldrM (\v :: Value
v cs :: [(String, String)]
cs -> ((String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
: [(String, String)]
cs) ((String, String) -> [(String, String)])
-> Parser (String, String) -> Parser [(String, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (String, String)
forall (m :: * -> *). MonadFail m => Value -> m (String, String)
parseOne Value
v) [] Array
x
  CradleType a -> Parser (CradleType a)
forall (m :: * -> *) a. Monad m => a -> m a
return (CradleType a -> Parser (CradleType a))
-> CradleType a -> Parser (CradleType a)
forall a b. (a -> b) -> a -> b
$ [(String, String)] -> CradleType a
multiConstructor [(String, String)]
xs
parseStackOrCabal singleConstructor :: Maybe String -> CradleType a
singleConstructor _ Null = CradleType a -> Parser (CradleType a)
forall (m :: * -> *) a. Monad m => a -> m a
return (CradleType a -> Parser (CradleType a))
-> CradleType a -> Parser (CradleType a)
forall a b. (a -> b) -> a -> b
$ Maybe String -> CradleType a
singleConstructor Maybe String
forall a. Maybe a
Nothing
parseStackOrCabal _ _ _ = String -> Parser (CradleType a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Configuration is expected to be an object."

parseStack :: Value -> Parser (CradleType a)
parseStack :: Value -> Parser (CradleType a)
parseStack = (Maybe String -> CradleType a)
-> ([(String, String)] -> CradleType a)
-> Value
-> Parser (CradleType a)
forall a.
(Maybe String -> CradleType a)
-> ([(String, String)] -> CradleType a)
-> Value
-> Parser (CradleType a)
parseStackOrCabal Maybe String -> CradleType a
forall a. Maybe String -> CradleType a
Stack [(String, String)] -> CradleType a
forall a. [(String, String)] -> CradleType a
StackMulti

parseCabal :: Value -> Parser (CradleType a)
parseCabal :: Value -> Parser (CradleType a)
parseCabal = (Maybe String -> CradleType a)
-> ([(String, String)] -> CradleType a)
-> Value
-> Parser (CradleType a)
forall a.
(Maybe String -> CradleType a)
-> ([(String, String)] -> CradleType a)
-> Value
-> Parser (CradleType a)
parseStackOrCabal Maybe String -> CradleType a
forall a. Maybe String -> CradleType a
Cabal [(String, String)] -> CradleType a
forall a. [(String, String)] -> CradleType a
CabalMulti

parseBios :: Value -> Parser (CradleType a)
parseBios :: Value -> Parser (CradleType a)
parseBios (Object x :: Object
x) =
    case Maybe Callable
biosCallable of
        Just bc :: Callable
bc -> CradleType a -> Parser (CradleType a)
forall (m :: * -> *) a. Monad m => a -> m a
return (CradleType a -> Parser (CradleType a))
-> CradleType a -> Parser (CradleType a)
forall a b. (a -> b) -> a -> b
$ Callable -> Maybe Callable -> Maybe String -> CradleType a
forall a.
Callable -> Maybe Callable -> Maybe String -> CradleType a
Bios Callable
bc Maybe Callable
biosDepsCallable Maybe String
ghcPath
        _ -> String -> Parser (CradleType a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (CradleType a))
-> String -> Parser (CradleType a)
forall a b. (a -> b) -> a -> b
$ "Not a valid Bios Configuration type, following keys are allowed:" String -> ShowS
forall a. [a] -> [a] -> [a]
++
                    "program or shell, dependency-program or dependency-shell, with-ghc"
    where
        biosCallable :: Maybe Callable
biosCallable =
            Maybe Callable -> Maybe Callable -> Maybe Callable
forall a. Maybe a -> Maybe a -> Maybe a
exclusive
                ((String -> Callable) -> Text -> Maybe Callable
forall t. (String -> t) -> Text -> Maybe t
stringTypeFromMap String -> Callable
Program "program")
                ((String -> Callable) -> Text -> Maybe Callable
forall t. (String -> t) -> Text -> Maybe t
stringTypeFromMap String -> Callable
Command "shell")
        biosDepsCallable :: Maybe Callable
biosDepsCallable =
            Maybe Callable -> Maybe Callable -> Maybe Callable
forall a. Maybe a -> Maybe a -> Maybe a
exclusive
                ((String -> Callable) -> Text -> Maybe Callable
forall t. (String -> t) -> Text -> Maybe t
stringTypeFromMap String -> Callable
Program "dependency-program")
                ((String -> Callable) -> Text -> Maybe Callable
forall t. (String -> t) -> Text -> Maybe t
stringTypeFromMap String -> Callable
Command "dependency-shell")
        ghcPath :: Maybe String
ghcPath =
            ShowS -> Text -> Maybe String
forall t. (String -> t) -> Text -> Maybe t
stringTypeFromMap ShowS
forall a. a -> a
id "with-ghc"

        exclusive :: Maybe a -> Maybe a -> Maybe a
        exclusive :: Maybe a -> Maybe a -> Maybe a
exclusive (Just _) (Just _) = Maybe a
forall a. Maybe a
Nothing
        exclusive l :: Maybe a
l Nothing = Maybe a
l
        exclusive Nothing r :: Maybe a
r = Maybe a
r
        stringTypeFromMap :: (String -> t) -> T.Text -> Maybe t
        stringTypeFromMap :: (String -> t) -> Text -> Maybe t
stringTypeFromMap constructor :: String -> t
constructor name :: Text
name = String -> t
constructor (String -> t) -> Maybe String -> Maybe t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Maybe String
intoString (Value -> Maybe String) -> Maybe Value -> Maybe String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> Object -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup Text
name Object
x)
        intoString :: Value -> Maybe String
        intoString :: Value -> Maybe String
intoString (String s :: Text
s) = String -> Maybe String
forall a. a -> Maybe a
Just (Text -> String
T.unpack Text
s)
        intoString _ = Maybe String
forall a. Maybe a
Nothing

parseBios _ = String -> Parser (CradleType a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Bios Configuration is expected to be an object."

parseDirect :: Value -> Parser (CradleType a)
parseDirect :: Value -> Parser (CradleType a)
parseDirect (Object x :: Object
x)
    | Object -> Int
forall k v. HashMap k v -> Int
Map.size Object
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1
    , Just (Array v :: Array
v) <- Text -> Object -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup "arguments" Object
x
    = CradleType a -> Parser (CradleType a)
forall (m :: * -> *) a. Monad m => a -> m a
return (CradleType a -> Parser (CradleType a))
-> CradleType a -> Parser (CradleType a)
forall a b. (a -> b) -> a -> b
$ [String] -> CradleType a
forall a. [String] -> CradleType a
Direct [Text -> String
T.unpack Text
s | String s :: Text
s <- Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
v]

    | Bool
otherwise
    = String -> Parser (CradleType a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Not a valid Direct Configuration type, following keys are allowed: arguments"
parseDirect _ = String -> Parser (CradleType a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Direct Configuration is expected to be an object."

parseMulti :: FromJSON a => Value -> Parser (CradleType a)
parseMulti :: Value -> Parser (CradleType a)
parseMulti (Array x :: Array
x)
    = [(String, CradleConfig a)] -> CradleType a
forall a. [(String, CradleConfig a)] -> CradleType a
Multi ([(String, CradleConfig a)] -> CradleType a)
-> Parser [(String, CradleConfig a)] -> Parser (CradleType a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser (String, CradleConfig a))
-> [Value] -> Parser [(String, CradleConfig a)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Value -> Parser (String, CradleConfig a)
forall a. FromJSON a => Value -> Parser (String, CradleConfig a)
parsePath (Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
x)
parseMulti _ = String -> Parser (CradleType a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Multi Configuration is expected to be an array."

parsePath :: FromJSON a => Value -> Parser (FilePath, CradleConfig a)
parsePath :: Value -> Parser (String, CradleConfig a)
parsePath (Object v :: Object
v)
  | Just (String path :: Text
path) <- Text -> Object -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup "path" Object
v
  , Just c :: Value
c <- Text -> Object -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup "config" Object
v
  = (Text -> String
T.unpack Text
path,) (CradleConfig a -> (String, CradleConfig a))
-> Parser (CradleConfig a) -> Parser (String, CradleConfig a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (CradleConfig a)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
c
parsePath o :: Value
o = String -> Parser (String, CradleConfig a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ("Multi component is expected to be an object." String -> ShowS
forall a. [a] -> [a] -> [a]
++ Value -> String
forall a. Show a => a -> String
show Value
o)

instance FromJSON a => FromJSON (CradleConfig a) where
    parseJSON :: Value -> Parser (CradleConfig a)
parseJSON (Object val :: Object
val) = do
            CradleType a
crd     <- Object
val Object -> Text -> Parser (CradleType a)
forall a. FromJSON a => Object -> Text -> Parser a
.: "cradle"
            [String]
crdDeps <- case Object -> Int
forall k v. HashMap k v -> Int
Map.size Object
val of
                1 -> [String] -> Parser [String]
forall (m :: * -> *) a. Monad m => a -> m a
return []
                2 -> Object
val Object -> Text -> Parser [String]
forall a. FromJSON a => Object -> Text -> Parser a
.: "dependencies"
                _ -> String -> Parser [String]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Unknown key, following keys are allowed: cradle, dependencies"

            CradleConfig a -> Parser (CradleConfig a)
forall (m :: * -> *) a. Monad m => a -> m a
return (CradleConfig a -> Parser (CradleConfig a))
-> CradleConfig a -> Parser (CradleConfig a)
forall a b. (a -> b) -> a -> b
$ CradleConfig :: forall a. [String] -> CradleType a -> CradleConfig a
CradleConfig { cradleType :: CradleType a
cradleType         = CradleType a
crd
                                  , cradleDependencies :: [String]
cradleDependencies = [String]
crdDeps
                                  }

    parseJSON _ = String -> Parser (CradleConfig a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Expected a cradle: key containing the preferences, possible values: cradle, dependencies"


instance FromJSON a => FromJSON (Config a) where
    parseJSON :: Value -> Parser (Config a)
parseJSON o :: Value
o = CradleConfig a -> Config a
forall a. CradleConfig a -> Config a
Config (CradleConfig a -> Config a)
-> Parser (CradleConfig a) -> Parser (Config a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (CradleConfig a)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
o


-- | Decode given file to a 'Config a' value.
-- Type variable 'a' can be used to extend the 'hie.yaml' file format
-- to extend configuration in the user-library.
-- If the contents of the file is not a valid 'Config a',
-- an 'Control.Exception.IOException' is thrown.
readConfig :: FromJSON a => FilePath -> IO (Config a)
readConfig :: String -> IO (Config a)
readConfig = String -> IO (Config a)
forall (m :: * -> *) a. (MonadIO m, FromJSON a) => String -> m a
decodeFileThrow