Merge pull request #38 from wagdav/configurable-input-output

Configurable input output directories

rib.cabal

@@ -60,4 +60,5 @@ library
         wai-extra >=3.0.26 && <3.1,
         warp >=3.2.28 && <3.3,
         base >=4.7 && <5,
-        pandoc >=2.7 && <3
+        pandoc >=2.7 && <3,
+        directory >= 1.0 && <2.0

src/Rib/App.hs

@@ -9,8 +9,6 @@ module Rib.App
   ( App(..)
   , run
   , runWith
-  , ribOutputDir
-  , ribInputDir
   ) where
 
 import Control.Concurrent (threadDelay)
@@ -24,6 +22,7 @@ import System.Console.CmdArgs
 import System.FSNotify (watchTree, withManager)
 
 import qualified Rib.Server as Server
+import Rib.Shake (Dirs (..))
 
 -- | Application modes
 --
@@ -35,34 +34,31 @@ data App
     }
   -- ^ Generate static files once.
   | WatchAndGenerate
-  -- ^ Watch for changes in `ribInputDir` and run `Generate`
+  -- ^ Watch for changes in the input directory and run `Generate`
   | Serve
     { port :: Int
       -- ^ Port to bind the server
     , dontWatch :: Bool
       -- ^ Unless set run `WatchAndGenerate` automatically
     }
-  -- ^ Run a HTTP server serving `ribOutputDir`
+  -- ^ Run a HTTP server serving content from the output directory
   deriving (Data,Typeable,Show,Eq)
 
--- | The path where static files will be generated.
---
--- Rib's server uses this directory when serving files.
-ribOutputDir :: FilePath
-ribOutputDir = "b"
-
--- | Directory from which source content will be read.
-ribInputDir :: FilePath
-ribInputDir = "a"
--- NOTE: ^ This should ideally *not* be `"."` as our use of watchTree (of
--- `runWith`) can interfere with Shake's file scaning.
 
 -- | Run Rib using arguments passed in the command line.
 run
-  :: Action ()
+  :: FilePath
+  -- ^ Directory from which source content will be read.
+  --
+  -- NOTE: This should ideally *not* be `"."` as our use of watchTree (of
+  -- `runWith`) can interfere with Shake's file scaning.
+  -> FilePath
+  -- ^ The path where static files will be generated.  Rib's server uses this
+  -- directory when serving files.
+  -> Action ()
   -- ^ Shake build rules for building the static site
   -> IO ()
-run buildAction = runWith buildAction =<< cmdArgs ribCli
+run src dst buildAction = runWith src dst buildAction =<< cmdArgs ribCli
   where
     ribCli = modes
       [ Serve
@@ -78,25 +74,26 @@ run buildAction = runWith buildAction =<< cmdArgs ribCli
       ]
 
 -- | Like `run` but with an explicitly passed `App` mode
-runWith :: Action () -> App -> IO ()
-runWith buildAction = \case
+runWith :: FilePath -> FilePath -> Action () -> App -> IO ()
+runWith src dst buildAction = \case
   WatchAndGenerate -> withManager $ \mgr -> do
     -- Begin with a *full* generation as the HTML layout may have been changed.
-    runWith buildAction $ Generate True
+    runWith src dst buildAction $ Generate True
     -- And then every time a file changes under the current directory
-    putStrLn $ "[Rib] Watching " <> ribInputDir
-    void $ watchTree mgr ribInputDir (const True) $ const $
-      runWith buildAction $ Generate False
+    putStrLn $ "[Rib] Watching " <> src
+    void $ watchTree mgr src (const True) $ const $
+      runWith src dst buildAction $ Generate False
     -- Wait forever, effectively.
     forever $ threadDelay maxBound
 
   Serve p dw -> concurrently_
-    (unless dw $ runWith buildAction WatchAndGenerate)
-    (Server.serve p ribOutputDir)
+    (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

src/Rib/Shake.hs

@@ -6,8 +6,6 @@
 
 -- | Combinators for working with Shake.
 --
--- The functions in this module work with `ribInputDir` and `ribOutputDir`.
---
 -- See the source of `Rib.Simple.buildAction` for example usage.
 module Rib.Shake
   (
@@ -19,6 +17,7 @@ module Rib.Shake
   , readPandocMulti
   -- * Misc
   , buildStaticFiles
+  , Dirs(..)
   )
 where
 
@@ -39,20 +38,35 @@ import Development.Shake.FilePath
 import Development.Shake.Forward (cacheAction)
 import Lucid (Html)
 import qualified Lucid
+import System.Directory (createDirectoryIfMissing)
 import Text.Pandoc (Pandoc (Pandoc), PandocIO, ReaderOptions)
 
-import Rib.App (ribInputDir, ribOutputDir)
 import qualified Rib.Pandoc
 
--- FIXME: Auto create ./b directory
+newtype Dirs = Dirs (FilePath, FilePath)
 
+getDirs :: Action (FilePath, FilePath)
+getDirs = getShakeExtra >>= \case
+  Just (Dirs d) -> return d
+  Nothing -> fail "Input output directories are not initialized"
+
+ribInputDir :: Action FilePath
+ribInputDir = fst <$> getDirs
+
+ribOutputDir :: Action FilePath
+ribOutputDir = do
+  output <- snd <$> getDirs
+  liftIO $ createDirectoryIfMissing True output
+  return output
 
 -- | Shake action to copy static files as is
 buildStaticFiles :: [FilePattern] -> Action [FilePath]
 buildStaticFiles staticFilePatterns = do
-  files <- getDirectoryFiles ribInputDir staticFilePatterns
+  input <- ribInputDir
+  output <- ribOutputDir
+  files <- getDirectoryFiles input staticFilePatterns
   void $ forP files $ \f ->
-    copyFileChanged (ribInputDir </> f) (ribOutputDir </> f)
+    copyFileChanged (input </> f) (output </> f)
   pure files
 
 -- | Convert the given pattern of source files into their HTML.
@@ -77,7 +91,8 @@ readPandocMulti
      -- ^ Tuple of pattern of files to work on and document format.
   -> Action [(FilePath, Pandoc)]
 readPandocMulti (pat, r) = do
-  fs <- getDirectoryFiles ribInputDir [pat]
+  input <- ribInputDir
+  fs <- getDirectoryFiles input [pat]
   forP fs $ \f ->
     jsonCacheAction f $ (f, ) <$> readPandoc r f
 
@@ -91,7 +106,8 @@ readPandoc
   -> FilePath
   -> Action Pandoc
 readPandoc r f = do
-  let inp = ribInputDir </> f
+  input <- ribInputDir
+  let inp = input </> f
   need [inp]
   content <- T.decodeUtf8 <$> liftIO (BS.readFile inp)
   doc <- liftIO $ Rib.Pandoc.parse r content
@@ -113,7 +129,8 @@ readPandoc r f = do
 -- | Build a single HTML file with the given value
 buildHtml :: FilePath -> Html () -> Action ()
 buildHtml f html = do
-  let out = ribOutputDir </> f
+  output <- ribOutputDir
+  let out = output </> f
   writeHtml out html
 
 writeHtml :: MonadIO m => FilePath -> Html () -> m ()