{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Rib.App
( App(..)
, run
, runWith
, ribOutputDir
, ribInputDir
) 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
data App
= Generate
{ force :: Bool
}
| WatchAndGenerate
| Serve
{ port :: Int
, dontWatch :: Bool
}
deriving (Data,Typeable,Show,Eq)
ribOutputDir :: FilePath
ribOutputDir = "b"
ribInputDir :: FilePath
ribInputDir = "a"
run
:: Action ()
-> IO ()
run buildAction = runWith 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 :: Action () -> App -> IO ()
runWith buildAction = \case
WatchAndGenerate -> withManager $ \mgr -> do
runWith buildAction $ Generate True
putStrLn $ "[Rib] Watching " <> ribInputDir
void $ watchTree mgr ribInputDir (const True) $ const $
runWith buildAction $ Generate False
forever $ threadDelay maxBound
Serve p dw -> concurrently_
(unless dw $ runWith buildAction WatchAndGenerate)
(Server.serve p ribOutputDir)
Generate forceGen ->
let opts = shakeOptions
{ shakeVerbosity = Chatty
, shakeRebuild = bool [] [(RebuildNow, "**")] forceGen
}
in shakeForward opts buildAction