{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module Headroom.Command.Gen
( commandGen
, parseGenMode
)
where
import Headroom.Command.Types ( Command(..)
, CommandGenOptions(..)
)
import Headroom.Command.Utils ( bootstrap )
import Headroom.Configuration.Types ( GenMode(..) )
import Headroom.Data.Lens ( suffixLensesFor )
import Headroom.Embedded ( configFileStub
, licenseTemplate
)
import Headroom.Types ( fromHeadroomError
, toHeadroomError
)
import Prelude ( putStrLn )
import RIO
import qualified RIO.Text as T
data Env = Env
{ envLogFunc :: !LogFunc
, envGenOptions :: !CommandGenOptions
}
suffixLensesFor ["envLogFunc"] ''Env
instance HasLogFunc Env where
logFuncL = envLogFuncL
env' :: CommandGenOptions -> LogFunc -> IO Env
env' opts logFunc = pure $ Env { envLogFunc = logFunc, envGenOptions = opts }
parseGenMode :: MonadThrow m
=> Command
-> m GenMode
parseGenMode = \case
Gen True Nothing -> pure GenConfigFile
Gen False (Just license) -> pure $ GenLicense license
_ -> throwM NoGenModeSelected
commandGen :: CommandGenOptions
-> IO ()
commandGen opts = bootstrap (env' opts) False $ case cgoGenMode opts of
GenConfigFile -> liftIO printConfigFile
GenLicense (lType, fType) -> liftIO . putStrLn $ licenseTemplate lType fType
printConfigFile :: IO ()
printConfigFile = putStrLn configFileStub
data CommandGenError = NoGenModeSelected
deriving (Eq, Show)
instance Exception CommandGenError where
displayException = displayException'
toException = toHeadroomError
fromException = fromHeadroomError
displayException' :: CommandGenError -> String
displayException' = T.unpack . \case
NoGenModeSelected -> mconcat
[ "Please select at least one option what to generate "
, "(see --help for details)"
]