{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Rib.App
( App(..)
, run
, runWith
) where
import Control.Concurrent (threadDelay)
import Control.Concurrent.Async (concurrently_)
import Control.Monad
import Data.Bool (bool)
import Development.Shake
import Development.Shake.Forward (shakeForward)
import System.Console.CmdArgs
import System.FSNotify (watchTree, withManager)
import qualified Rib.Server as Server
import Rib.Shake (Dirs (..))
data App
= Generate
{ force :: Bool
}
| WatchAndGenerate
| Serve
{ port :: Int
, dontWatch :: Bool
}
deriving (Data,Typeable,Show,Eq)
run
:: FilePath
-> FilePath
-> 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
{ force = False &= help "Force generation of all files"
} &= help "Generate the site"
]
runWith :: FilePath -> FilePath -> Action () -> App -> IO ()
runWith src dst buildAction = \case
WatchAndGenerate -> withManager $ \mgr -> do
runWith src dst buildAction $ Generate True
putStrLn $ "[Rib] Watching " <> src
void $ watchTree mgr src (const True) $ const $
runWith src dst buildAction $ Generate False
forever $ threadDelay maxBound
Serve p dw -> concurrently_
(unless dw $ runWith src dst buildAction WatchAndGenerate)
(Server.serve p dst)
Generate forceGen ->
let opts = shakeOptions
{ shakeVerbosity = Chatty
, shakeRebuild = bool [] [(RebuildNow, "**")] forceGen
, shakeExtra = addShakeExtra (Dirs (src, dst)) (shakeExtra shakeOptions)
}
in shakeForward opts buildAction