{-# LANGUAGE OverloadedLabels #-}

module Hinit.Context where

import Control.Algebra
import Control.Effect.Terminal
import Control.Effect.Time
import qualified Data.Map.Strict as M
import Data.Text (Text)
import Hinit.Cli
import Hinit.Cli.Options
import Hinit.Config
import Hinit.Template.Config
import Hinit.Types

opsToCtx :: [Op] -> Context
opsToCtx :: [Op] -> Context
opsToCtx = [(Text, Val)] -> Context
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Text, Val)] -> Context)
-> ([Op] -> [(Text, Val)]) -> [Op] -> Context
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Op -> (Text, Val)) -> [Op] -> [(Text, Val)]
forall a b. (a -> b) -> [a] -> [b]
map Op -> (Text, Val)
toPair

buildContextFromOptions :: forall m sig. Has Terminal sig m => [Option] -> m Context
buildContextFromOptions :: [Option] -> m Context
buildContextFromOptions = ([(Text, Val)] -> Context) -> m [(Text, Val)] -> m Context
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Text, Val)] -> Context
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList (m [(Text, Val)] -> m Context)
-> ([Option] -> m [(Text, Val)]) -> [Option] -> m Context
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Option -> m (Text, Val)) -> [Option] -> m [(Text, Val)]
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Option -> m (Text, Val)
buildContext'
  where
    buildContext' :: Option -> m (Text, Val)
    buildContext' :: Option -> m (Text, Val)
buildContext' BoolOpt {Maybe Bool
Maybe Text
Text
$sel:defB:BoolOpt :: Option -> Maybe Bool
$sel:desc:BoolOpt :: Option -> Maybe Text
$sel:name:BoolOpt :: Option -> Text
defB :: Maybe Bool
desc :: Maybe Text
name :: Text
..} = do
      Val
b <- case Maybe Bool
defB of
        Just Bool
b -> Val -> m Val
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
Bool Bool
b
        Maybe Bool
Nothing -> ValType -> Text -> Maybe Text -> m Val
forall (sig :: (Type -> Type) -> Type -> Type) (m :: Type -> Type).
Has Terminal sig m =>
ValType -> Text -> Maybe Text -> m Val
query ValType
Bool' Text
name Maybe Text
desc
      (Text, Val) -> m (Text, Val)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Text
name, Val
b)
    buildContext' TextOpt {Maybe Text
Text
$sel:defT:BoolOpt :: Option -> Maybe Text
defT :: Maybe Text
desc :: Maybe Text
name :: Text
$sel:desc:BoolOpt :: Option -> Maybe Text
$sel:name:BoolOpt :: Option -> Text
..} = do
      Val
t <- case Maybe Text
defT of
        Just Text
t -> Val -> m Val
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ Text -> Val
Text Text
t
        Maybe Text
Nothing -> ValType -> Text -> Maybe Text -> m Val
forall (sig :: (Type -> Type) -> Type -> Type) (m :: Type -> Type).
Has Terminal sig m =>
ValType -> Text -> Maybe Text -> m Val
query ValType
Text' Text
name Maybe Text
desc
      (Text, Val) -> m (Text, Val)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Text
name, Val
t)

buildContext ::
  (Has Time sig m, Has Terminal sig m) =>
  Config ->
  TemplateConfig ->
  [Op] ->
  Text ->
  m Context
buildContext :: Config -> TemplateConfig -> [Op] -> Text -> m Context
buildContext Config
cfg TemplateConfig {[Pattern]
[Text]
[OptionalIgnores]
[Option]
Maybe Text
$sel:optionals:TemplateConfig :: TemplateConfig -> [OptionalIgnores]
$sel:options:TemplateConfig :: TemplateConfig -> [Option]
$sel:ignores:TemplateConfig :: TemplateConfig -> [Pattern]
$sel:tags:TemplateConfig :: TemplateConfig -> [Text]
$sel:desc:TemplateConfig :: TemplateConfig -> Maybe Text
optionals :: [OptionalIgnores]
options :: [Option]
ignores :: [Pattern]
tags :: [Text]
desc :: Maybe Text
..} [Op]
ops Text
project = do
  (Context
topPrio, Context
custom) <- Text -> Config -> m (Context, Context)
forall (sig :: (Type -> Type) -> Type -> Type) (m :: Type -> Type).
Has Time sig m =>
Text -> Config -> m (Context, Context)
buildContextFromConfig Text
project Config
cfg
  Context
tmplCtx <- [Option] -> m Context
forall (m :: Type -> Type) (sig :: (Type -> Type) -> Type -> Type).
Has Terminal sig m =>
[Option] -> m Context
buildContextFromOptions [Option]
options
  let overrides :: Context
overrides = [Op] -> Context
opsToCtx [Op]
ops
  Context -> m Context
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Context
topPrio Context -> Context -> Context
forall a. Semigroup a => a -> a -> a
<> Context
overrides Context -> Context -> Context
forall a. Semigroup a => a -> a -> a
<> Context
tmplCtx Context -> Context -> Context
forall a. Semigroup a => a -> a -> a
<> Context
custom)