{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude     #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE StrictData            #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE TupleSections         #-}
{-# LANGUAGE TypeApplications      #-}

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

Module representing the @init@ command, responsible for generating all the
required files (configuration, templates) for the given project, which are then
required by the @run@ or @gen@ commands.
-}

module Headroom.Command.Init
  ( Env(..)
  , Paths(..)
  , commandInit
  , doesAppConfigExist
  , findSupportedFileTypes
  )
where

import           Headroom.Command.Types         ( CommandInitOptions(..) )
import           Headroom.Command.Utils         ( bootstrap )
import           Headroom.Configuration         ( makeHeadersConfig
                                                , parseConfiguration
                                                )
import           Headroom.Configuration.Types   ( Configuration(..)
                                                , LicenseType(..)
                                                )
import           Headroom.Data.Has              ( Has(..) )
import           Headroom.Data.Lens             ( suffixLenses )
import           Headroom.Embedded              ( configFileStub
                                                , defaultConfig
                                                , licenseTemplate
                                                )
import           Headroom.FileSystem            ( FileSystem(..)
                                                , fileExtension
                                                , findFiles
                                                , mkFileSystem
                                                )
import           Headroom.FileType              ( fileTypeByExt )
import           Headroom.FileType.Types        ( FileType(..) )
import           Headroom.Meta                  ( TemplateType )
import           Headroom.Serialization         ( prettyPrintYAML )
import           Headroom.Template              ( Template(..) )
import           Headroom.Types                 ( fromHeadroomError
                                                , toHeadroomError
                                                )
import           Headroom.UI                    ( Progress(..)
                                                , zipWithProgress
                                                )
import           RIO
import qualified RIO.Char                      as C
import           RIO.FilePath                   ( (</>) )
import qualified RIO.List                      as L
import qualified RIO.Map                       as M
import qualified RIO.NonEmpty                  as NE
import qualified RIO.Text                      as T
import qualified RIO.Text.Partial              as TP


-- | /RIO/ Environment for the @init@ command.
data Env = Env
  { Env -> LogFunc
envLogFunc     :: LogFunc
  , Env -> FileSystem (RIO Env)
envFileSystem  :: FileSystem (RIO Env)
  , Env -> CommandInitOptions
envInitOptions :: CommandInitOptions
  , Env -> Paths
envPaths       :: Paths
  }

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

suffixLenses ''Env

instance HasLogFunc Env where
  logFuncL :: (LogFunc -> f LogFunc) -> Env -> f Env
logFuncL = (LogFunc -> f LogFunc) -> Env -> f Env
Lens' Env LogFunc
envLogFuncL

instance Has CommandInitOptions Env where
  hasLens :: (CommandInitOptions -> f CommandInitOptions) -> Env -> f Env
hasLens = (CommandInitOptions -> f CommandInitOptions) -> Env -> f Env
Lens' Env CommandInitOptions
envInitOptionsL

instance Has (FileSystem (RIO Env)) Env where
  hasLens :: (FileSystem (RIO Env) -> f (FileSystem (RIO Env))) -> Env -> f Env
hasLens = (FileSystem (RIO Env) -> f (FileSystem (RIO Env))) -> Env -> f Env
Lens' Env (FileSystem (RIO Env))
envFileSystemL

instance Has Paths Env where
  hasLens :: (Paths -> f Paths) -> Env -> f Env
hasLens = (Paths -> f Paths) -> Env -> f Env
Lens' Env Paths
envPathsL

--------------------------------------------------------------------------------

env' :: CommandInitOptions -> LogFunc -> IO Env
env' :: CommandInitOptions -> LogFunc -> IO Env
env' CommandInitOptions
opts LogFunc
logFunc = do
  let paths :: Paths
paths = Paths :: FilePath -> FilePath -> Paths
Paths { pConfigFile :: FilePath
pConfigFile   = FilePath
".headroom.yaml"
                    , pTemplatesDir :: FilePath
pTemplatesDir = FilePath
"headroom-templates"
                    }
  Env -> IO Env
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Env -> IO Env) -> Env -> IO Env
forall a b. (a -> b) -> a -> b
$ Env :: LogFunc
-> FileSystem (RIO Env) -> CommandInitOptions -> Paths -> Env
Env { envLogFunc :: LogFunc
envLogFunc     = LogFunc
logFunc
             , envFileSystem :: FileSystem (RIO Env)
envFileSystem  = FileSystem (RIO Env)
forall (m :: * -> *). MonadIO m => FileSystem m
mkFileSystem
             , envInitOptions :: CommandInitOptions
envInitOptions = CommandInitOptions
opts
             , envPaths :: Paths
envPaths       = Paths
paths
             }

-- | Handler for @init@ command.
commandInit :: CommandInitOptions
            -- ^ @init@ command options
            -> IO ()
            -- ^ execution result
commandInit :: CommandInitOptions -> IO ()
commandInit CommandInitOptions
opts = (LogFunc -> IO Env) -> Bool -> RIO Env () -> IO ()
forall env a. (LogFunc -> IO env) -> Bool -> RIO env a -> IO a
bootstrap (CommandInitOptions -> LogFunc -> IO Env
env' CommandInitOptions
opts) Bool
False (RIO Env () -> IO ()) -> RIO Env () -> IO ()
forall a b. (a -> b) -> a -> b
$ RIO Env Bool
forall env.
(HasLogFunc env, Has (FileSystem (RIO env)) env, Has Paths env) =>
RIO env Bool
doesAppConfigExist RIO Env Bool -> (Bool -> RIO Env ()) -> RIO Env ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Bool
False -> do
    [FileType]
fileTypes <- RIO Env [FileType]
forall env.
(Has CommandInitOptions env, HasLogFunc env) =>
RIO env [FileType]
findSupportedFileTypes
    RIO Env ()
forall env.
(HasLogFunc env, Has (FileSystem (RIO env)) env, Has Paths env) =>
RIO env ()
makeTemplatesDir
    [FileType] -> RIO Env ()
forall env.
(Has CommandInitOptions env, HasLogFunc env, Has Paths env) =>
[FileType] -> RIO env ()
createTemplates [FileType]
fileTypes
    RIO Env ()
forall env.
(Has CommandInitOptions env, HasLogFunc env, Has Paths env) =>
RIO env ()
createConfigFile
  Bool
True -> do
    Paths
paths <- RIO Env Paths
forall a t (m :: * -> *). (Has a t, MonadReader t m) => m a
viewL
    CommandInitError -> RIO Env ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (CommandInitError -> RIO Env ())
-> (FilePath -> CommandInitError) -> FilePath -> RIO Env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> CommandInitError
AppConfigAlreadyExists (FilePath -> RIO Env ()) -> FilePath -> RIO Env ()
forall a b. (a -> b) -> a -> b
$ Paths -> FilePath
pConfigFile Paths
paths

-- | Recursively scans provided source paths for known file types for which
-- templates can be generated.
findSupportedFileTypes :: (Has CommandInitOptions env, HasLogFunc env)
                       => RIO env [FileType]
findSupportedFileTypes :: RIO env [FileType]
findSupportedFileTypes = do
  CommandInitOptions
opts           <- RIO env CommandInitOptions
forall a t (m :: * -> *). (Has a t, MonadReader t m) => m a
viewL
  HeadersConfig 'Partial
pHeadersConfig <- Configuration 'Partial -> HeadersConfig 'Partial
forall (p :: Phase). Configuration p -> HeadersConfig p
cLicenseHeaders (Configuration 'Partial -> HeadersConfig 'Partial)
-> RIO env (Configuration 'Partial)
-> RIO env (HeadersConfig 'Partial)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> RIO env (Configuration 'Partial)
forall (m :: * -> *).
MonadThrow m =>
ByteString -> m (Configuration 'Partial)
parseConfiguration ByteString
forall a. IsString a => a
defaultConfig
  CtHeadersConfig
headersConfig  <- HeadersConfig 'Partial -> RIO env CtHeadersConfig
forall (m :: * -> *).
MonadThrow m =>
HeadersConfig 'Partial -> m CtHeadersConfig
makeHeadersConfig HeadersConfig 'Partial
pHeadersConfig
  [FileType]
fileTypes      <- do
    [[FilePath]]
allFiles <- (FilePath -> RIO env [FilePath])
-> [FilePath] -> RIO env [[FilePath]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\FilePath
path -> FindFilesFn (RIO env)
forall (m :: * -> *). MonadIO m => FindFilesFn m
findFiles FilePath
path (Bool -> FilePath -> Bool
forall a b. a -> b -> a
const Bool
True))
                     (CommandInitOptions -> [FilePath]
cioSourcePaths CommandInitOptions
opts)
    let allFileTypes :: [Maybe FileType]
allFileTypes = (FilePath -> Maybe FileType) -> [FilePath] -> [Maybe FileType]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> Maybe Text
fileExtension (FilePath -> Maybe Text)
-> (Text -> Maybe FileType) -> FilePath -> Maybe FileType
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> CtHeadersConfig -> Text -> Maybe FileType
fileTypeByExt CtHeadersConfig
headersConfig)
                            ([[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[FilePath]]
allFiles)
    [FileType] -> RIO env [FileType]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FileType] -> RIO env [FileType])
-> ([Maybe FileType] -> [FileType])
-> [Maybe FileType]
-> RIO env [FileType]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FileType] -> [FileType]
forall a. Eq a => [a] -> [a]
L.nub ([FileType] -> [FileType])
-> ([Maybe FileType] -> [FileType])
-> [Maybe FileType]
-> [FileType]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe FileType] -> [FileType]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe FileType] -> RIO env [FileType])
-> [Maybe FileType] -> RIO env [FileType]
forall a b. (a -> b) -> a -> b
$ [Maybe FileType]
allFileTypes
  case [FileType]
fileTypes of
    [] -> CommandInitError -> RIO env [FileType]
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM CommandInitError
NoProvidedSourcePaths
    [FileType]
_  -> do
      Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Found supported file types: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> [FileType] -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow [FileType]
fileTypes
      [FileType] -> RIO env [FileType]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [FileType]
fileTypes

createTemplates :: (Has CommandInitOptions env, HasLogFunc env, Has Paths env)
                => [FileType]
                -> RIO env ()
createTemplates :: [FileType] -> RIO env ()
createTemplates [FileType]
fileTypes = do
  CommandInitOptions
opts       <- RIO env CommandInitOptions
forall a t (m :: * -> *). (Has a t, MonadReader t m) => m a
viewL
  Paths {FilePath
pTemplatesDir :: FilePath
pConfigFile :: FilePath
pTemplatesDir :: Paths -> FilePath
pConfigFile :: Paths -> FilePath
..} <- RIO env Paths
forall a t (m :: * -> *). (Has a t, MonadReader t m) => m a
viewL
  ((Progress, (LicenseType, FileType)) -> RIO env ())
-> [(Progress, (LicenseType, FileType))] -> RIO env ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Progress
p, (LicenseType, FileType)
lf) -> FilePath -> (LicenseType, FileType) -> Progress -> RIO env ()
forall env.
HasLogFunc env =>
FilePath -> (LicenseType, FileType) -> Progress -> RIO env ()
createTemplate FilePath
pTemplatesDir (LicenseType, FileType)
lf Progress
p)
        ([(LicenseType, FileType)] -> [(Progress, (LicenseType, FileType))]
forall a. [a] -> [(Progress, a)]
zipWithProgress ([(LicenseType, FileType)]
 -> [(Progress, (LicenseType, FileType))])
-> [(LicenseType, FileType)]
-> [(Progress, (LicenseType, FileType))]
forall a b. (a -> b) -> a -> b
$ (FileType -> (LicenseType, FileType))
-> [FileType] -> [(LicenseType, FileType)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CommandInitOptions -> LicenseType
cioLicenseType CommandInitOptions
opts, ) [FileType]
fileTypes)

createTemplate :: (HasLogFunc env)
               => FilePath
               -> (LicenseType, FileType)
               -> Progress
               -> RIO env ()
createTemplate :: FilePath -> (LicenseType, FileType) -> Progress -> RIO env ()
createTemplate FilePath
templatesDir (LicenseType
licenseType, FileType
fileType) Progress
progress = do
  let extension :: Text
extension = NonEmpty Text -> Text
forall a. NonEmpty a -> a
NE.head (NonEmpty Text -> Text) -> NonEmpty Text -> Text
forall a b. (a -> b) -> a -> b
$ Template TemplateType => NonEmpty Text
forall t. Template t => NonEmpty Text
templateExtensions @TemplateType
      file :: FilePath
file = ((Char -> Char) -> FilePath -> FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
C.toLower (FilePath -> FilePath)
-> (FileType -> FilePath) -> FileType -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileType -> FilePath
forall a. Show a => a -> FilePath
show (FileType -> FilePath) -> FileType -> FilePath
forall a b. (a -> b) -> a -> b
$ FileType
fileType) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"." FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
T.unpack Text
extension
      filePath :: FilePath
filePath  = FilePath
templatesDir FilePath -> FilePath -> FilePath
</> FilePath
file
      template :: Text
template  = LicenseType -> FileType -> Text
forall a. IsString a => LicenseType -> FileType -> a
licenseTemplate LicenseType
licenseType FileType
fileType
  Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
forall a b. (a -> b) -> a -> b
$ [Utf8Builder] -> Utf8Builder
forall a. Monoid a => [a] -> a
mconcat
    [Progress -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Progress
progress, Utf8Builder
" Creating template file in ", FilePath -> Utf8Builder
forall a. IsString a => FilePath -> a
fromString FilePath
filePath]
  FilePath -> Text -> RIO env ()
forall (m :: * -> *). MonadIO m => FilePath -> Text -> m ()
writeFileUtf8 FilePath
filePath Text
template

createConfigFile :: (Has CommandInitOptions env, HasLogFunc env, Has Paths env)
                 => RIO env ()
createConfigFile :: RIO env ()
createConfigFile = do
  CommandInitOptions
opts         <- RIO env CommandInitOptions
forall a t (m :: * -> *). (Has a t, MonadReader t m) => m a
viewL
  p :: Paths
p@Paths {FilePath
pTemplatesDir :: FilePath
pConfigFile :: FilePath
pTemplatesDir :: Paths -> FilePath
pConfigFile :: Paths -> FilePath
..} <- RIO env Paths
forall a t (m :: * -> *). (Has a t, MonadReader t m) => m a
viewL
  Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Creating YAML config file in " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> FilePath -> Utf8Builder
forall a. IsString a => FilePath -> a
fromString FilePath
pConfigFile
  FilePath -> Text -> RIO env ()
forall (m :: * -> *). MonadIO m => FilePath -> Text -> m ()
writeFileUtf8 FilePath
pConfigFile (CommandInitOptions -> Paths -> Text
configuration CommandInitOptions
opts Paths
p)
 where
  configuration :: CommandInitOptions -> Paths -> Text
configuration CommandInitOptions
opts Paths
paths =
    let withSourcePaths :: Text -> Text
withSourcePaths = Text -> Text -> Text -> Text
TP.replace
          Text
"source-paths: []"
          (Text -> [FilePath] -> Text
forall a. ToJSON a => Text -> a -> Text
toYamlList Text
"source-paths" ([FilePath] -> Text) -> [FilePath] -> Text
forall a b. (a -> b) -> a -> b
$ CommandInitOptions -> [FilePath]
cioSourcePaths CommandInitOptions
opts)
        withTemplatePaths :: Text -> Text
withTemplatePaths = Text -> Text -> Text -> Text
TP.replace
          Text
"template-paths: []"
          (Text -> [FilePath] -> Text
forall a. ToJSON a => Text -> a -> Text
toYamlList Text
"template-paths" [Paths -> FilePath
pTemplatesDir Paths
paths])
    in  Text -> Text
withTemplatePaths (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
withSourcePaths (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
forall a. IsString a => a
configFileStub
  toYamlList :: Text -> a -> Text
toYamlList Text
field a
list =
    Text -> Text
T.stripEnd (Text -> Text) -> (Map Text a -> Text) -> Map Text a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text a -> Text
forall a. ToJSON a => a -> Text
prettyPrintYAML (Map Text a -> Text) -> Map Text a -> Text
forall a b. (a -> b) -> a -> b
$ [(Text, a)] -> Map Text a
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Text
field :: Text, a
list)]

-- | Checks whether application config file already exists.
doesAppConfigExist :: ( HasLogFunc env
                      , Has (FileSystem (RIO env)) env
                      , Has Paths env
                      )
                   => RIO env Bool
doesAppConfigExist :: RIO env Bool
doesAppConfigExist = do
  FileSystem {GetCurrentDirectoryFn (RIO env)
DoesFileExistFn (RIO env)
ListFilesFn (RIO env)
CreateDirectoryFn (RIO env)
LoadFileFn (RIO env)
FindFilesByExtsFn (RIO env)
FindFilesFn (RIO env)
FindFilesByTypesFn (RIO env)
fsLoadFile :: forall (m :: * -> *). FileSystem m -> LoadFileFn m
fsListFiles :: forall (m :: * -> *). FileSystem m -> ListFilesFn m
fsGetCurrentDirectory :: forall (m :: * -> *). FileSystem m -> GetCurrentDirectoryFn m
fsFindFilesByTypes :: forall (m :: * -> *). FileSystem m -> FindFilesByTypesFn m
fsFindFilesByExts :: forall (m :: * -> *). FileSystem m -> FindFilesByExtsFn m
fsFindFiles :: forall (m :: * -> *). FileSystem m -> FindFilesFn m
fsDoesFileExist :: forall (m :: * -> *). FileSystem m -> DoesFileExistFn m
fsCreateDirectory :: forall (m :: * -> *). FileSystem m -> CreateDirectoryFn m
fsLoadFile :: LoadFileFn (RIO env)
fsListFiles :: ListFilesFn (RIO env)
fsGetCurrentDirectory :: GetCurrentDirectoryFn (RIO env)
fsFindFilesByTypes :: FindFilesByTypesFn (RIO env)
fsFindFilesByExts :: FindFilesByExtsFn (RIO env)
fsFindFiles :: FindFilesFn (RIO env)
fsDoesFileExist :: DoesFileExistFn (RIO env)
fsCreateDirectory :: CreateDirectoryFn (RIO env)
..} <- RIO env (FileSystem (RIO env))
forall a t (m :: * -> *). (Has a t, MonadReader t m) => m a
viewL
  Paths {FilePath
pTemplatesDir :: FilePath
pConfigFile :: FilePath
pTemplatesDir :: Paths -> FilePath
pConfigFile :: Paths -> FilePath
..}      <- RIO env Paths
forall a t (m :: * -> *). (Has a t, MonadReader t m) => m a
viewL
  Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo Utf8Builder
"Verifying that there's no existing Headroom configuration..."
  DoesFileExistFn (RIO env)
fsDoesFileExist FilePath
pConfigFile

-- | Creates directory for template files.
makeTemplatesDir :: ( HasLogFunc env
                    , Has (FileSystem (RIO env)) env
                    , Has Paths env
                    )
                 => RIO env ()
makeTemplatesDir :: RIO env ()
makeTemplatesDir = do
  FileSystem {GetCurrentDirectoryFn (RIO env)
DoesFileExistFn (RIO env)
ListFilesFn (RIO env)
CreateDirectoryFn (RIO env)
LoadFileFn (RIO env)
FindFilesByExtsFn (RIO env)
FindFilesFn (RIO env)
FindFilesByTypesFn (RIO env)
fsLoadFile :: LoadFileFn (RIO env)
fsListFiles :: ListFilesFn (RIO env)
fsGetCurrentDirectory :: GetCurrentDirectoryFn (RIO env)
fsFindFilesByTypes :: FindFilesByTypesFn (RIO env)
fsFindFilesByExts :: FindFilesByExtsFn (RIO env)
fsFindFiles :: FindFilesFn (RIO env)
fsDoesFileExist :: DoesFileExistFn (RIO env)
fsCreateDirectory :: CreateDirectoryFn (RIO env)
fsLoadFile :: forall (m :: * -> *). FileSystem m -> LoadFileFn m
fsListFiles :: forall (m :: * -> *). FileSystem m -> ListFilesFn m
fsGetCurrentDirectory :: forall (m :: * -> *). FileSystem m -> GetCurrentDirectoryFn m
fsFindFilesByTypes :: forall (m :: * -> *). FileSystem m -> FindFilesByTypesFn m
fsFindFilesByExts :: forall (m :: * -> *). FileSystem m -> FindFilesByExtsFn m
fsFindFiles :: forall (m :: * -> *). FileSystem m -> FindFilesFn m
fsDoesFileExist :: forall (m :: * -> *). FileSystem m -> DoesFileExistFn m
fsCreateDirectory :: forall (m :: * -> *). FileSystem m -> CreateDirectoryFn m
..} <- RIO env (FileSystem (RIO env))
forall a t (m :: * -> *). (Has a t, MonadReader t m) => m a
viewL
  Paths {FilePath
pTemplatesDir :: FilePath
pConfigFile :: FilePath
pTemplatesDir :: Paths -> FilePath
pConfigFile :: Paths -> FilePath
..}      <- RIO env Paths
forall a t (m :: * -> *). (Has a t, MonadReader t m) => m a
viewL
  Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Creating directory for templates in " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> FilePath -> Utf8Builder
forall a. IsString a => FilePath -> a
fromString FilePath
pTemplatesDir
  CreateDirectoryFn (RIO env)
fsCreateDirectory FilePath
pTemplatesDir


---------------------------------  Error Types  --------------------------------

-- | Exception specific to the "Headroom.Command.Init" module
data CommandInitError
  = AppConfigAlreadyExists FilePath
  -- ^ application configuration file already exists
  | NoProvidedSourcePaths
  -- ^ no paths to source code files provided
  | NoSupportedFileType
  -- ^ no supported file types found on source paths
  deriving (CommandInitError -> CommandInitError -> Bool
(CommandInitError -> CommandInitError -> Bool)
-> (CommandInitError -> CommandInitError -> Bool)
-> Eq CommandInitError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommandInitError -> CommandInitError -> Bool
$c/= :: CommandInitError -> CommandInitError -> Bool
== :: CommandInitError -> CommandInitError -> Bool
$c== :: CommandInitError -> CommandInitError -> Bool
Eq, Int -> CommandInitError -> FilePath -> FilePath
[CommandInitError] -> FilePath -> FilePath
CommandInitError -> FilePath
(Int -> CommandInitError -> FilePath -> FilePath)
-> (CommandInitError -> FilePath)
-> ([CommandInitError] -> FilePath -> FilePath)
-> Show CommandInitError
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [CommandInitError] -> FilePath -> FilePath
$cshowList :: [CommandInitError] -> FilePath -> FilePath
show :: CommandInitError -> FilePath
$cshow :: CommandInitError -> FilePath
showsPrec :: Int -> CommandInitError -> FilePath -> FilePath
$cshowsPrec :: Int -> CommandInitError -> FilePath -> FilePath
Show)

instance Exception CommandInitError where
  displayException :: CommandInitError -> FilePath
displayException = CommandInitError -> FilePath
displayException'
  toException :: CommandInitError -> SomeException
toException      = CommandInitError -> SomeException
forall e. Exception e => e -> SomeException
toHeadroomError
  fromException :: SomeException -> Maybe CommandInitError
fromException    = SomeException -> Maybe CommandInitError
forall e. Exception e => SomeException -> Maybe e
fromHeadroomError

displayException' :: CommandInitError -> String
displayException' :: CommandInitError -> FilePath
displayException' = Text -> FilePath
T.unpack (Text -> FilePath)
-> (CommandInitError -> Text) -> CommandInitError -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
  AppConfigAlreadyExists FilePath
path -> FilePath -> Text
appConfigAlreadyExists FilePath
path
  CommandInitError
NoProvidedSourcePaths       -> Text
noProvidedSourcePaths
  CommandInitError
NoSupportedFileType         -> Text
noSupportedFileType
 where
  appConfigAlreadyExists :: FilePath -> Text
appConfigAlreadyExists FilePath
path =
    [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"Configuration file '", FilePath -> Text
T.pack FilePath
path, Text
"' already exists"]
  noProvidedSourcePaths :: Text
noProvidedSourcePaths = Text
"No source code paths (files or directories) defined"
  noSupportedFileType :: Text
noSupportedFileType   = Text
"No supported file type found in scanned source paths"