--------------------------------------------------------------------------------
-- | Implementation of Hakyll commands: build, preview...
{-# LANGUAGE CPP #-}
module Hakyll.Commands
    ( Check(..)
    , build
    , check
    , clean
    , preview
    , rebuild
    , server
    , deploy
    , watch
    ) where


--------------------------------------------------------------------------------
import           Control.Concurrent
import           System.Exit                (ExitCode)


--------------------------------------------------------------------------------
import           Hakyll.Check               (Check(..))
import qualified Hakyll.Check               as Check
import           Hakyll.Core.Configuration
import           Hakyll.Core.Logger         (Logger)
import qualified Hakyll.Core.Logger         as Logger
import           Hakyll.Core.Rules
import           Hakyll.Core.Rules.Internal
import           Hakyll.Core.Runtime
import           Hakyll.Core.Util.File


--------------------------------------------------------------------------------
#ifdef WATCH_SERVER
import           Hakyll.Preview.Poll        (watchUpdates)
#endif

#ifdef PREVIEW_SERVER
import           Hakyll.Preview.Server
#endif

#ifdef mingw32_HOST_OS
import           Control.Monad              (void)
import           System.IO.Error            (catchIOError)
#endif


--------------------------------------------------------------------------------
-- | Build the site
build :: Configuration -> Logger -> Rules a -> IO ExitCode
build :: Configuration -> Logger -> Rules a -> IO ExitCode
build Configuration
conf Logger
logger Rules a
rules = (ExitCode, RuleSet) -> ExitCode
forall a b. (a, b) -> a
fst ((ExitCode, RuleSet) -> ExitCode)
-> IO (ExitCode, RuleSet) -> IO ExitCode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Configuration -> Logger -> Rules a -> IO (ExitCode, RuleSet)
forall a.
Configuration -> Logger -> Rules a -> IO (ExitCode, RuleSet)
run Configuration
conf Logger
logger Rules a
rules


--------------------------------------------------------------------------------
-- | Run the checker and exit
check :: Configuration -> Logger -> Check.Check -> IO ExitCode
check :: Configuration -> Logger -> Check -> IO ExitCode
check = Configuration -> Logger -> Check -> IO ExitCode
Check.check


--------------------------------------------------------------------------------
-- | Remove the output directories
clean :: Configuration -> Logger -> IO ()
clean :: Configuration -> Logger -> IO ()
clean Configuration
conf Logger
logger = do
    [Char] -> IO ()
remove ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ Configuration -> [Char]
destinationDirectory Configuration
conf
    [Char] -> IO ()
remove ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ Configuration -> [Char]
storeDirectory Configuration
conf
    [Char] -> IO ()
remove ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ Configuration -> [Char]
tmpDirectory Configuration
conf
  where
    remove :: [Char] -> IO ()
remove [Char]
dir = do
        Logger -> [Char] -> IO ()
forall (m :: * -> *). MonadIO m => Logger -> [Char] -> m ()
Logger.header Logger
logger ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Removing " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
dir [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"..."
        [Char] -> IO ()
removeDirectory [Char]
dir


--------------------------------------------------------------------------------
-- | Preview the site
preview :: Configuration -> Logger -> Rules a -> Int -> IO ()
#ifdef PREVIEW_SERVER
preview :: Configuration -> Logger -> Rules a -> Int -> IO ()
preview Configuration
conf Logger
logger Rules a
rules Int
port  = do
    IO ()
deprecatedMessage
    Configuration
-> Logger -> [Char] -> Int -> Bool -> Rules a -> IO ()
forall a.
Configuration
-> Logger -> [Char] -> Int -> Bool -> Rules a -> IO ()
watch Configuration
conf Logger
logger [Char]
"0.0.0.0" Int
port Bool
True Rules a
rules
  where
    deprecatedMessage :: IO ()
deprecatedMessage = ([Char] -> IO ()) -> [[Char]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [Char] -> IO ()
putStrLn [ [Char]
"The preview command has been deprecated."
                                       , [Char]
"Use the watch command for recompilation and serving."
                                       ]
#else
preview _ _ _ _ = previewServerDisabled
#endif


--------------------------------------------------------------------------------
-- | Watch and recompile for changes

watch :: Configuration -> Logger -> String -> Int -> Bool -> Rules a -> IO ()
#ifdef WATCH_SERVER
watch :: Configuration
-> Logger -> [Char] -> Int -> Bool -> Rules a -> IO ()
watch Configuration
conf Logger
logger [Char]
host Int
port Bool
runServer Rules a
rules = do
#ifndef mingw32_HOST_OS
    ThreadId
_ <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ Configuration -> IO Pattern -> IO ()
watchUpdates Configuration
conf IO Pattern
update
#else
    -- Force windows users to compile with -threaded flag, as otherwise
    -- thread is blocked indefinitely.
    catchIOError (void $ forkOS $ watchUpdates conf update) $ \_ -> do
        fail $ "Hakyll.Commands.watch: Could not start update watching " ++
               "thread. Did you compile with -threaded flag?"
#endif
    IO ()
server'
  where
    update :: IO Pattern
update = do
        (ExitCode
_, RuleSet
ruleSet) <- Configuration -> Logger -> Rules a -> IO (ExitCode, RuleSet)
forall a.
Configuration -> Logger -> Rules a -> IO (ExitCode, RuleSet)
run Configuration
conf Logger
logger Rules a
rules
        Pattern -> IO Pattern
forall (m :: * -> *) a. Monad m => a -> m a
return (Pattern -> IO Pattern) -> Pattern -> IO Pattern
forall a b. (a -> b) -> a -> b
$ RuleSet -> Pattern
rulesPattern RuleSet
ruleSet
    loop :: IO b
loop = Int -> IO ()
threadDelay Int
100000 IO () -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO b
loop
    server' :: IO ()
server' = if Bool
runServer then Configuration -> Logger -> [Char] -> Int -> IO ()
server Configuration
conf Logger
logger [Char]
host Int
port else IO ()
forall b. IO b
loop
#else
watch _ _ _ _ _ _ = watchServerDisabled
#endif

--------------------------------------------------------------------------------
-- | Rebuild the site
rebuild :: Configuration -> Logger -> Rules a -> IO ExitCode
rebuild :: Configuration -> Logger -> Rules a -> IO ExitCode
rebuild Configuration
conf Logger
logger Rules a
rules =
    Configuration -> Logger -> IO ()
clean Configuration
conf Logger
logger IO () -> IO ExitCode -> IO ExitCode
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Configuration -> Logger -> Rules a -> IO ExitCode
forall a. Configuration -> Logger -> Rules a -> IO ExitCode
build Configuration
conf Logger
logger Rules a
rules

--------------------------------------------------------------------------------
-- | Start a server
server :: Configuration -> Logger -> String -> Int -> IO ()
#ifdef PREVIEW_SERVER
server :: Configuration -> Logger -> [Char] -> Int -> IO ()
server Configuration
conf Logger
logger [Char]
host Int
port = do
    let destination :: [Char]
destination = Configuration -> [Char]
destinationDirectory Configuration
conf
    Logger -> [Char] -> [Char] -> Int -> IO ()
staticServer Logger
logger [Char]
destination [Char]
host Int
port
#else
server _ _ _ _ = previewServerDisabled
#endif


--------------------------------------------------------------------------------
-- | Upload the site
deploy :: Configuration -> IO ExitCode
deploy :: Configuration -> IO ExitCode
deploy Configuration
conf = Configuration -> Configuration -> IO ExitCode
deploySite Configuration
conf Configuration
conf


--------------------------------------------------------------------------------
-- | Print a warning message about the preview serving not being enabled
#ifndef PREVIEW_SERVER
previewServerDisabled :: IO ()
previewServerDisabled =
    mapM_ putStrLn
        [ "PREVIEW SERVER"
        , ""
        , "The preview server is not enabled in the version of Hakyll. To"
        , "enable it, set the flag to True and recompile Hakyll."
        , "Alternatively, use an external tool to serve your site directory."
        ]
#endif

#ifndef WATCH_SERVER
watchServerDisabled :: IO ()
watchServerDisabled =
    mapM_ putStrLn
      [ "WATCH SERVER"
      , ""
      , "The watch server is not enabled in the version of Hakyll. To"
      , "enable it, set the flag to True and recompile Hakyll."
      , "Alternatively, use an external tool to serve your site directory."
      ]
#endif