{-|
Module      : Headroom.Command.Init.Env
Description : Environment for the Init command
Copyright   : (c) 2019-2020 Vaclav Svejcar
License     : BSD-3
Maintainer  : vaclav.svejcar@gmail.com
Stability   : experimental
Portability : POSIX

Data types and instances for the /Init/ command environment.
-}
{-# LANGUAGE NoImplicitPrelude #-}
module Headroom.Command.Init.Env where

import           Headroom.License               ( LicenseType )
import           RIO


-- | /RIO/ Environment for the /Init/ command.
data Env = Env
  { Env -> LogFunc
envLogFunc     :: !LogFunc
  , Env -> InitOptions
envInitOptions :: !InitOptions
  , Env -> Paths
envPaths       :: !Paths
  }

-- | Options for the /Init/ command.
data InitOptions = InitOptions
  { InitOptions -> [FilePath]
ioSourcePaths :: ![FilePath]
  , InitOptions -> LicenseType
ioLicenseType :: !LicenseType
  }
  deriving Int -> InitOptions -> ShowS
[InitOptions] -> ShowS
InitOptions -> FilePath
(Int -> InitOptions -> ShowS)
-> (InitOptions -> FilePath)
-> ([InitOptions] -> ShowS)
-> Show InitOptions
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [InitOptions] -> ShowS
$cshowList :: [InitOptions] -> ShowS
show :: InitOptions -> FilePath
$cshow :: InitOptions -> FilePath
showsPrec :: Int -> InitOptions -> ShowS
$cshowsPrec :: Int -> InitOptions -> ShowS
Show

-- | Paths to various locations of file system.
data Paths = Paths
  { Paths -> FilePath
pCurrentDir   :: !FilePath
  , Paths -> FilePath
pConfigFile   :: !FilePath
  , Paths -> FilePath
pTemplatesDir :: !FilePath
  }

instance HasLogFunc Env where
  logFuncL :: (LogFunc -> f LogFunc) -> Env -> f Env
logFuncL = (Env -> LogFunc) -> (Env -> LogFunc -> Env) -> Lens' Env LogFunc
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Env -> LogFunc
envLogFunc (\x :: Env
x y :: LogFunc
y -> Env
x { envLogFunc :: LogFunc
envLogFunc = LogFunc
y })

-- | Environment value with /Init/ command options.
class HasInitOptions env where
  initOptionsL :: Lens' env InitOptions

-- | Environment value with 'Paths'.
class HasPaths env where
  pathsL :: Lens' env Paths

instance HasInitOptions Env where
  initOptionsL :: (InitOptions -> f InitOptions) -> Env -> f Env
initOptionsL = (Env -> InitOptions)
-> (Env -> InitOptions -> Env) -> Lens' Env InitOptions
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Env -> InitOptions
envInitOptions (\x :: Env
x y :: InitOptions
y -> Env
x { envInitOptions :: InitOptions
envInitOptions = InitOptions
y })

instance HasPaths Env where
  pathsL :: (Paths -> f Paths) -> Env -> f Env
pathsL = (Env -> Paths) -> (Env -> Paths -> Env) -> Lens' Env Paths
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Env -> Paths
envPaths (\x :: Env
x y :: Paths
y -> Env
x { envPaths :: Paths
envPaths = Paths
y })