--------------------------------------------------------------------------------
-- | Module providing the main hakyll function and command-line argument parsing
module Hakyll.Main
    ( -- * Entry points
      hakyll
    , hakyllWith
    , hakyllWithArgs
    , hakyllWithExitCode
    , hakyllWithExitCodeAndArgs

      -- * Command line argument parsers
    , Options(..)
    , Command(..)
    , optionParser
    , commandParser
    , defaultCommands
    , defaultParser
    , defaultParserPure
    , defaultParserPrefs
    , defaultParserInfo
    ) where


--------------------------------------------------------------------------------
import           System.Environment        (getProgName)
import           System.Exit               (ExitCode (ExitSuccess), exitWith)
import           System.IO.Unsafe          (unsafePerformIO)


--------------------------------------------------------------------------------
import qualified Options.Applicative       as OA


--------------------------------------------------------------------------------
import qualified Hakyll.Check              as Check
import qualified Hakyll.Commands           as Commands
import qualified Hakyll.Core.Configuration as Config
import qualified Hakyll.Core.Logger        as Logger
import           Hakyll.Core.Rules
import           Hakyll.Core.Runtime


--------------------------------------------------------------------------------
-- | This usually is the function with which the user runs the hakyll compiler
hakyll :: Rules a -> IO ()
hakyll :: forall a. Rules a -> IO ()
hakyll = forall a. Configuration -> Rules a -> IO ()
hakyllWith Configuration
Config.defaultConfiguration

--------------------------------------------------------------------------------
-- | A variant of 'hakyll' which allows the user to specify a custom
-- configuration
hakyllWith :: Config.Configuration -> Rules a -> IO ()
hakyllWith :: forall a. Configuration -> Rules a -> IO ()
hakyllWith Configuration
conf Rules a
rules = forall a. Configuration -> Rules a -> IO ExitCode
hakyllWithExitCode Configuration
conf Rules a
rules forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. ExitCode -> IO a
exitWith

--------------------------------------------------------------------------------
-- | A variant of 'hakyll' which returns an 'ExitCode'
hakyllWithExitCode :: Config.Configuration -> Rules a -> IO ExitCode
hakyllWithExitCode :: forall a. Configuration -> Rules a -> IO ExitCode
hakyllWithExitCode Configuration
conf Rules a
rules =  do
    Options
args <- Configuration -> IO Options
defaultParser Configuration
conf
    forall a. Configuration -> Options -> Rules a -> IO ExitCode
hakyllWithExitCodeAndArgs Configuration
conf Options
args Rules a
rules

--------------------------------------------------------------------------------
-- | A variant of 'hakyll' which expects a 'Configuration' and command-line
-- 'Options'. This gives freedom to implement your own parsing.
hakyllWithArgs :: Config.Configuration -> Options -> Rules a -> IO ()
hakyllWithArgs :: forall a. Configuration -> Options -> Rules a -> IO ()
hakyllWithArgs Configuration
conf Options
args Rules a
rules =
    forall a. Configuration -> Options -> Rules a -> IO ExitCode
hakyllWithExitCodeAndArgs Configuration
conf Options
args Rules a
rules forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. ExitCode -> IO a
exitWith

--------------------------------------------------------------------------------
hakyllWithExitCodeAndArgs :: Config.Configuration ->
                              Options -> Rules a -> IO ExitCode
hakyllWithExitCodeAndArgs :: forall a. Configuration -> Options -> Rules a -> IO ExitCode
hakyllWithExitCodeAndArgs Configuration
conf Options
args Rules a
rules = do
    let args' :: Command
args' = Options -> Command
optCommand Options
args
        verbosity' :: Verbosity
verbosity' = if Options -> Bool
verbosity Options
args then Verbosity
Logger.Debug else Verbosity
Logger.Message
        check :: Check
check     =
            if Command -> Bool
internal_links Command
args' then Check
Check.InternalLinks else Check
Check.All

    Logger
logger <- Verbosity -> IO Logger
Logger.new Verbosity
verbosity'
    forall a.
Command
-> Configuration -> Check -> Logger -> Rules a -> IO ExitCode
invokeCommands Command
args' Configuration
conf Check
check Logger
logger Rules a
rules

--------------------------------------------------------------------------------
defaultParser :: Config.Configuration -> IO Options
defaultParser :: Configuration -> IO Options
defaultParser Configuration
conf =
    forall a. ParserPrefs -> ParserInfo a -> IO a
OA.customExecParser ParserPrefs
defaultParserPrefs (Configuration -> ParserInfo Options
defaultParserInfo Configuration
conf)


--------------------------------------------------------------------------------
defaultParserPure :: Config.Configuration -> [String] -> OA.ParserResult Options
defaultParserPure :: Configuration -> [String] -> ParserResult Options
defaultParserPure Configuration
conf =
  forall a. ParserPrefs -> ParserInfo a -> [String] -> ParserResult a
OA.execParserPure ParserPrefs
defaultParserPrefs (Configuration -> ParserInfo Options
defaultParserInfo Configuration
conf)


--------------------------------------------------------------------------------
defaultParserPrefs :: OA.ParserPrefs
defaultParserPrefs :: ParserPrefs
defaultParserPrefs = PrefsMod -> ParserPrefs
OA.prefs PrefsMod
OA.showHelpOnError

--------------------------------------------------------------------------------
defaultParserInfo :: Config.Configuration -> OA.ParserInfo Options
defaultParserInfo :: Configuration -> ParserInfo Options
defaultParserInfo Configuration
conf =
  forall a. Parser a -> InfoMod a -> ParserInfo a
OA.info (forall a. Parser (a -> a)
OA.helper forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Configuration -> Parser Options
optionParser Configuration
conf) (forall a. InfoMod a
OA.fullDesc forall a. Semigroup a => a -> a -> a
<> forall a. String -> InfoMod a
OA.progDesc (
                                                String
progName forall a. [a] -> [a] -> [a]
++ String
" - Static site compiler created with Hakyll"))

--------------------------------------------------------------------------------
invokeCommands :: Command -> Config.Configuration ->
                  Check.Check -> Logger.Logger -> Rules a -> IO ExitCode
invokeCommands :: forall a.
Command
-> Configuration -> Check -> Logger -> Rules a -> IO ExitCode
invokeCommands Command
args Configuration
conf Check
check Logger
logger Rules a
rules =
    case Command
args of
        Build   RunMode
mode   -> forall a.
RunMode -> Configuration -> Logger -> Rules a -> IO ExitCode
Commands.build RunMode
mode Configuration
conf Logger
logger Rules a
rules
        Check   Bool
_      -> Configuration -> Logger -> Check -> IO ExitCode
Commands.check Configuration
conf Logger
logger Check
check
        Command
Clean          -> Configuration -> Logger -> IO ()
Commands.clean Configuration
conf Logger
logger forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ExitCode
ok
        Command
Deploy         -> Configuration -> IO ExitCode
Commands.deploy Configuration
conf
        Preview Int
p      -> forall a. Configuration -> Logger -> Rules a -> Int -> IO ()
Commands.preview Configuration
conf Logger
logger Rules a
rules Int
p forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ExitCode
ok
        Command
Rebuild        -> forall a. Configuration -> Logger -> Rules a -> IO ExitCode
Commands.rebuild Configuration
conf Logger
logger Rules a
rules
        Server  String
_ Int
_    -> Configuration -> Logger -> String -> Int -> IO ()
Commands.server Configuration
conf Logger
logger (Command -> String
host Command
args) (Command -> Int
port Command
args) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ExitCode
ok
        Watch   String
_ Int
p Bool
s  -> forall a.
Configuration
-> Logger -> String -> Int -> Bool -> Rules a -> IO ()
Commands.watch Configuration
conf Logger
logger (Command -> String
host Command
args) Int
p (Bool -> Bool
not Bool
s) Rules a
rules forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ExitCode
ok
    where
        ok :: IO ExitCode
ok = forall (m :: * -> *) a. Monad m => a -> m a
return ExitCode
ExitSuccess


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

-- | The parsed command-line options.
data Options = Options {Options -> Bool
verbosity :: Bool, Options -> Command
optCommand :: Command}
    deriving (Int -> Options -> ShowS
[Options] -> ShowS
Options -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Options] -> ShowS
$cshowList :: [Options] -> ShowS
show :: Options -> String
$cshow :: Options -> String
showsPrec :: Int -> Options -> ShowS
$cshowsPrec :: Int -> Options -> ShowS
Show)

-- | The command to run.
data Command
    = Build RunMode
    -- ^ Generate the site.
    | Check   {Command -> Bool
internal_links :: Bool}
    -- ^ Validate the site output.
    | Clean
    -- ^ Clean up and remove cache.
    | Deploy
    -- ^ Upload/deploy your site.
    | Preview {Command -> Int
port :: Int}
    -- ^ [DEPRECATED] Please use the watch command.
    | Rebuild
    -- ^ Clean and build again.
    | Server  {Command -> String
host :: String, port :: Int}
    -- ^ Start a preview server.
    | Watch   {host :: String, port :: Int, Command -> Bool
no_server :: Bool }
    -- ^ Autocompile on changes and start a preview server.
    deriving (Int -> Command -> ShowS
[Command] -> ShowS
Command -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Command] -> ShowS
$cshowList :: [Command] -> ShowS
show :: Command -> String
$cshow :: Command -> String
showsPrec :: Int -> Command -> ShowS
$cshowsPrec :: Int -> Command -> ShowS
Show)

{-# DEPRECATED Preview "Use Watch instead." #-}

optionParser :: Config.Configuration -> OA.Parser Options
optionParser :: Configuration -> Parser Options
optionParser Configuration
conf = Bool -> Command -> Options
Options forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Bool
verboseParser forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Configuration -> Parser Command
commandParser Configuration
conf
    where
    verboseParser :: Parser Bool
verboseParser = Mod FlagFields Bool -> Parser Bool
OA.switch (forall (f :: * -> *) a. HasName f => String -> Mod f a
OA.long String
"verbose" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
OA.short Char
'v' forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
OA.help String
"Run in verbose mode")


commandParser :: Config.Configuration -> OA.Parser Command
commandParser :: Configuration -> Parser Command
commandParser Configuration
conf =  forall a. Mod CommandFields a -> Parser a
OA.subparser forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. Semigroup a => a -> a -> a
(<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. (String, Parser a, InfoMod a) -> Mod CommandFields a
produceCommand) forall a. Monoid a => a
mempty (forall a. Configuration -> [(String, Parser Command, InfoMod a)]
defaultCommands Configuration
conf)
    where
    produceCommand :: (String, Parser a, InfoMod a) -> Mod CommandFields a
produceCommand (String
c,Parser a
a,InfoMod a
b) = forall a. String -> ParserInfo a -> Mod CommandFields a
OA.command String
c (forall a. Parser a -> InfoMod a -> ParserInfo a
OA.info (forall a. Parser (a -> a)
OA.helper forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a
a) (InfoMod a
b))


defaultCommands :: Config.Configuration -> [(String, OA.Parser Command, OA.InfoMod a)]
defaultCommands :: forall a. Configuration -> [(String, Parser Command, InfoMod a)]
defaultCommands Configuration
conf =
    [ ( String
"build"
      , forall (f :: * -> *) a. Applicative f => a -> f a
pure RunMode -> Command
Build forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> a -> Mod FlagFields a -> Parser a
OA.flag RunMode
RunModeNormal RunMode
RunModePrintOutOfDate (forall (f :: * -> *) a. HasName f => String -> Mod f a
OA.long String
"dry-run" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
OA.help String
"Don't build, only print out-of-date items")
      , forall a. InfoMod a
OA.fullDesc forall a. Semigroup a => a -> a -> a
<> forall a. String -> InfoMod a
OA.progDesc String
"Generate the site"
      )
    , ( String
"check"
      , forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool -> Command
Check forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
OA.switch (forall (f :: * -> *) a. HasName f => String -> Mod f a
OA.long String
"internal-links" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
OA.help String
"Check internal links only")
      , forall a. InfoMod a
OA.fullDesc forall a. Semigroup a => a -> a -> a
<> forall a. String -> InfoMod a
OA.progDesc String
"Validate the site output"
      )
    , ( String
"clean"
      , forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
Clean
      , forall a. InfoMod a
OA.fullDesc forall a. Semigroup a => a -> a -> a
<> forall a. String -> InfoMod a
OA.progDesc String
"Clean up and remove cache"
      )
    , ( String
"deploy"
      , forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
Deploy
      , forall a. InfoMod a
OA.fullDesc forall a. Semigroup a => a -> a -> a
<> forall a. String -> InfoMod a
OA.progDesc String
"Upload/deploy your site"
       )
    , ( String
"preview"
      , forall (f :: * -> *) a. Applicative f => a -> f a
pure Int -> Command
Preview forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Int
portParser
      , forall a. InfoMod a
OA.fullDesc forall a. Semigroup a => a -> a -> a
<> forall a. String -> InfoMod a
OA.progDesc String
"[DEPRECATED] Please use the watch command"
      )
    , ( String
"rebuild"
      , forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
Rebuild
      , forall a. InfoMod a
OA.fullDesc forall a. Semigroup a => a -> a -> a
<> forall a. String -> InfoMod a
OA.progDesc String
"Clean and build again"
      )
    , ( String
"server"
      , forall (f :: * -> *) a. Applicative f => a -> f a
pure String -> Int -> Command
Server forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String
hostParser forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Int
portParser
      , forall a. InfoMod a
OA.fullDesc forall a. Semigroup a => a -> a -> a
<> forall a. String -> InfoMod a
OA.progDesc String
"Start a preview server"
      )
    , ( String
"watch"
      , forall (f :: * -> *) a. Applicative f => a -> f a
pure String -> Int -> Bool -> Command
Watch forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String
hostParser forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Int
portParser forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
OA.switch (forall (f :: * -> *) a. HasName f => String -> Mod f a
OA.long String
"no-server" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
OA.help String
"Disable the built-in web server")
      , forall a. InfoMod a
OA.fullDesc forall a. Semigroup a => a -> a -> a
<> forall a. String -> InfoMod a
OA.progDesc String
"Autocompile on changes and start a preview server.  You can watch and recompile without running a server with --no-server."
      )
    ]
    where
    portParser :: Parser Int
portParser = forall a. ReadM a -> Mod OptionFields a -> Parser a
OA.option forall a. Read a => ReadM a
OA.auto (forall (f :: * -> *) a. HasName f => String -> Mod f a
OA.long String
"port" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
OA.help String
"Port to listen on" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasValue f => a -> Mod f a
OA.value (Configuration -> Int
Config.previewPort Configuration
conf))
    hostParser :: Parser String
hostParser = forall s. IsString s => Mod OptionFields s -> Parser s
OA.strOption (forall (f :: * -> *) a. HasName f => String -> Mod f a
OA.long String
"host" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
OA.help String
"Host to bind on" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasValue f => a -> Mod f a
OA.value (Configuration -> String
Config.previewHost Configuration
conf))


--------------------------------------------------------------------------------
-- | This is necessary because not everyone calls their program the same...
progName :: String
progName :: String
progName = forall a. IO a -> a
unsafePerformIO IO String
getProgName
{-# NOINLINE progName #-}