{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Rib.App
( App (..),
run,
runWith,
)
where
import Control.Concurrent (threadDelay)
import Control.Concurrent.Async (concurrently_)
import Control.Exception (catch)
import Development.Shake
import Development.Shake.Forward (shakeForward)
import Path
import Relude
import qualified Rib.Server as Server
import Rib.Shake (RibSettings (..))
import System.Console.CmdArgs
import System.FSNotify (watchTree, withManager)
data App
=
Generate
{
full :: Bool
}
|
WatchAndGenerate
|
Serve
{
port :: Int,
dontWatch :: Bool
}
deriving (Data, Typeable, Show, Eq)
run ::
Path Rel Dir ->
Path Rel Dir ->
Action () ->
IO ()
run src dst buildAction = runWith src dst buildAction =<< cmdArgs ribCli
where
ribCli =
modes
[ Serve
{ port = 8080 &= help "Port to bind to",
dontWatch = False &= help "Do not watch in addition to serving generated files"
}
&= help "Serve the generated site"
&= auto,
WatchAndGenerate
&= help "Watch for changes and generate",
Generate
{ full = False &= help "Force a full generation of all files"
}
&= help "Generate the site"
]
runWith :: Path Rel Dir -> Path Rel Dir -> Action () -> App -> IO ()
runWith src dst buildAction = \case
WatchAndGenerate -> withManager $ \mgr -> do
runShake True
putStrLn $ "[Rib] Watching " <> toFilePath src <> " for changes"
void $ watchTree mgr (toFilePath src) (const True) $ \_ -> do
runShake False
forever $ threadDelay maxBound
Serve p dw ->
concurrently_
(unless dw $ runWith src dst buildAction WatchAndGenerate)
(Server.serve p $ toFilePath dst)
Generate fullGen -> do
runShake fullGen
where
runShake fullGen =
shakeForward (ribShakeOptions fullGen) buildAction
`catch` \(e :: SomeException) -> putStrLn $ "[Rib] Shake error: " <> show e
ribShakeOptions fullGen =
shakeOptions
{ shakeVerbosity = Verbose,
shakeRebuild = bool [] [(RebuildNow, "**")] fullGen,
shakeLintInside = [""],
shakeExtra = addShakeExtra (RibSettings src dst) (shakeExtra shakeOptions)
}