-- | Top-level module for achille, providing the CLI and task runner.
module Achille
    ( module Achille.Config
    , module Achille.Timestamped
    , module Achille.Recipe
    , module Achille.Task
    , AchilleCommand
    , achilleCLI
    , achille
    , achilleWith
    ) where


import Control.Monad           (void, mapM_)
import Control.Monad.IO.Class  (MonadIO)
import System.Directory        (removePathForcibly)
import System.FilePath.Glob    (compile)
import Options.Applicative

import qualified System.Process as Process

import Achille.Config
import Achille.Timestamped
import Achille.Recipe
import Achille.Task


-- | CLI commands.
data AchilleCommand
    = Build [String]  -- ^ Build the site once
    | Deploy          -- ^ Deploy to the server
    | Clean           -- ^ Delete all artefacts
    deriving (AchilleCommand -> AchilleCommand -> Bool
(AchilleCommand -> AchilleCommand -> Bool)
-> (AchilleCommand -> AchilleCommand -> Bool) -> Eq AchilleCommand
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AchilleCommand -> AchilleCommand -> Bool
$c/= :: AchilleCommand -> AchilleCommand -> Bool
== :: AchilleCommand -> AchilleCommand -> Bool
$c== :: AchilleCommand -> AchilleCommand -> Bool
Eq, Int -> AchilleCommand -> ShowS
[AchilleCommand] -> ShowS
AchilleCommand -> String
(Int -> AchilleCommand -> ShowS)
-> (AchilleCommand -> String)
-> ([AchilleCommand] -> ShowS)
-> Show AchilleCommand
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AchilleCommand] -> ShowS
$cshowList :: [AchilleCommand] -> ShowS
show :: AchilleCommand -> String
$cshow :: AchilleCommand -> String
showsPrec :: Int -> AchilleCommand -> ShowS
$cshowsPrec :: Int -> AchilleCommand -> ShowS
Show)


-- | CLI parser.
achilleCLI :: Parser AchilleCommand
achilleCLI :: Parser AchilleCommand
achilleCLI = Mod CommandFields AchilleCommand -> Parser AchilleCommand
forall a. Mod CommandFields a -> Parser a
subparser (Mod CommandFields AchilleCommand -> Parser AchilleCommand)
-> Mod CommandFields AchilleCommand -> Parser AchilleCommand
forall a b. (a -> b) -> a -> b
$
      String
-> ParserInfo AchilleCommand -> Mod CommandFields AchilleCommand
forall a. String -> ParserInfo a -> Mod CommandFields a
command "build"  (Parser AchilleCommand
-> InfoMod AchilleCommand -> ParserInfo AchilleCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
info ([String] -> AchilleCommand
Build ([String] -> AchilleCommand)
-> Parser [String] -> Parser AchilleCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String -> Parser [String]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ReadM String -> Mod ArgumentFields String -> Parser String
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument ReadM String
forall s. IsString s => ReadM s
str (String -> Mod ArgumentFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar "FILES")))  (String -> InfoMod AchilleCommand
forall a. String -> InfoMod a
progDesc "Build the site once" ))
   Mod CommandFields AchilleCommand
-> Mod CommandFields AchilleCommand
-> Mod CommandFields AchilleCommand
forall a. Semigroup a => a -> a -> a
<> String
-> ParserInfo AchilleCommand -> Mod CommandFields AchilleCommand
forall a. String -> ParserInfo a -> Mod CommandFields a
command "deploy" (Parser AchilleCommand
-> InfoMod AchilleCommand -> ParserInfo AchilleCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
info (AchilleCommand -> Parser AchilleCommand
forall (f :: * -> *) a. Applicative f => a -> f a
pure AchilleCommand
Deploy) (String -> InfoMod AchilleCommand
forall a. String -> InfoMod a
progDesc "Server go brrr"      ))
   Mod CommandFields AchilleCommand
-> Mod CommandFields AchilleCommand
-> Mod CommandFields AchilleCommand
forall a. Semigroup a => a -> a -> a
<> String
-> ParserInfo AchilleCommand -> Mod CommandFields AchilleCommand
forall a. String -> ParserInfo a -> Mod CommandFields a
command "clean"  (Parser AchilleCommand
-> InfoMod AchilleCommand -> ParserInfo AchilleCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
info (AchilleCommand -> Parser AchilleCommand
forall (f :: * -> *) a. Applicative f => a -> f a
pure AchilleCommand
Clean)  (String -> InfoMod AchilleCommand
forall a. String -> InfoMod a
progDesc "Delete all artefacts"))


-- | Main entrypoint for achille. Provides a CLI for running a task.
achille :: Task IO a -> IO ()
achille :: Task IO a -> IO ()
achille = Config -> Task IO a -> IO ()
forall a. Config -> Task IO a -> IO ()
achilleWith Config
forall a. Default a => a
def


-- | CLI for running a task using given options.
achilleWith :: Config -> Task IO a -> IO ()
achilleWith :: Config -> Task IO a -> IO ()
achilleWith config :: Config
config task :: Task IO a
task = ParserPrefs -> ParserInfo AchilleCommand -> IO AchilleCommand
forall a. ParserPrefs -> ParserInfo a -> IO a
customExecParser ParserPrefs
p ParserInfo AchilleCommand
opts IO AchilleCommand -> (AchilleCommand -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Deploy -> (String -> IO ()) -> Maybe String -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
Process.callCommand (Config -> Maybe String
deployCmd Config
config)
    Clean  -> String -> IO ()
removePathForcibly (Config -> String
outputDir Config
config)
           IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO ()
removePathForcibly (Config -> String
cacheFile Config
config)
    Build paths :: [String]
paths -> IO a -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO a -> IO ()) -> IO a -> IO ()
forall a b. (a -> b) -> a -> b
$ [Pattern] -> Config -> Task IO a -> IO a
forall (m :: * -> *) a.
MonadIO m =>
[Pattern] -> Config -> Task m a -> m a
runTask ((String -> Pattern) -> [String] -> [Pattern]
forall a b. (a -> b) -> [a] -> [b]
map String -> Pattern
compile [String]
paths) Config
config Task IO a
task
    where
        opts :: ParserInfo AchilleCommand
opts = Parser AchilleCommand
-> InfoMod AchilleCommand -> ParserInfo AchilleCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser AchilleCommand
achilleCLI Parser AchilleCommand
-> Parser (AchilleCommand -> AchilleCommand)
-> Parser AchilleCommand
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (AchilleCommand -> AchilleCommand)
forall a. Parser (a -> a)
helper) (InfoMod AchilleCommand -> ParserInfo AchilleCommand)
-> InfoMod AchilleCommand -> ParserInfo AchilleCommand
forall a b. (a -> b) -> a -> b
$ InfoMod AchilleCommand
forall a. InfoMod a
fullDesc InfoMod AchilleCommand
-> InfoMod AchilleCommand -> InfoMod AchilleCommand
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod AchilleCommand
forall a. String -> InfoMod a
header String
desc
        p :: ParserPrefs
p    = PrefsMod -> ParserPrefs
prefs PrefsMod
showHelpOnEmpty
        desc :: String
desc = "A static site generator for fun and profit"