Merge pull request #69 from srid/source-reader-action

Make SourceReader a Shake Action

README.md

@@ -82,7 +82,7 @@ main = Rib.run [reldir|a|] [reldir|b|] generateSite
       -- - Function that will parse the file (here we use mmark)
       -- - Function that will generate the HTML (see below)
       srcs <-
-        Rib.buildHtmlMulti [[relfile|*.md|]] M.parseIO $
+        Rib.buildHtmlMulti [[relfile|*.md|]] M.parse $
           renderPage . Page_Single
       -- Build an index.html linking to the aforementioned files.
       Rib.buildHtml [relfile|index.html|] $

src/Rib/Parser/MMark.hs

@@ -10,8 +10,8 @@
 
 module Rib.Parser.MMark
   ( -- * Parsing
+    parse,
     parsePure,
-    parseIO,
 
     -- * Rendering
     render,
@@ -26,6 +26,7 @@ module Rib.Parser.MMark
 where
 
 import Control.Foldl (Fold (..))
+import Development.Shake (readFile')
 import Lucid (Html)
 import Path
 import Rib.Source (SourceReader)
@@ -40,14 +41,21 @@ import Text.URI (URI)
 render :: MMark -> Html ()
 render = MMark.render
 
-parsePure :: FilePath -> Text -> Either Text MMark
+-- | Pure version of `parse`
+parsePure ::
+  -- | Filepath corresponding to the text to be parsed (used in parse errors)
+  FilePath ->
+  -- | Text to be parsed
+  Text ->
+  Either Text MMark
 parsePure k s = case MMark.parse k s of
   Left e -> Left $ toText $ M.errorBundlePretty e
   Right doc -> Right $ MMark.useExtensions exts $ useTocExt doc
 
-parseIO :: SourceReader MMark
-parseIO (toFilePath -> f) = do
-  s <- readFileText f
+-- | `SourceReader` for parsing Markdown using mmark
+parse :: SourceReader MMark
+parse (toFilePath -> f) = do
+  s <- toText <$> readFile' f
   pure $ parsePure f s
 
 -- | Get the first image in the document if one exists

src/Rib/Parser/Pandoc.hs

@@ -4,13 +4,14 @@
 {-# LANGUAGE Rank2Types #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE ViewPatterns #-}
 
 -- | Helpers for working with Pandoc documents
 module Rib.Parser.Pandoc
   ( -- * Parsing
     PandocFormat (..),
+    parse,
     parsePure,
-    parseIO,
 
     -- * Rendering
     render,
@@ -28,6 +29,7 @@ where
 
 import Control.Monad.Except
 import Data.Aeson
+import Development.Shake (readFile')
 import Lucid (Html, toHtmlRaw)
 import Path
 import Rib.Source (SourceReader)
@@ -47,17 +49,23 @@ readPandocFormat = \case
   PandocFormat_Markdown -> readMarkdown
   PandocFormat_RST -> readRST
 
+-- | Pure version of `parse`
 parsePure :: PandocFormat -> Text -> Either Text Pandoc
 parsePure fmt s =
   first show $ runExcept $ do
     runPure'
     $ readPandocFormat fmt readerSettings s
 
-parseIO :: PandocFormat -> SourceReader Pandoc
-parseIO fmt f = fmap (first show) $ runExceptT $ do
-  content <- readFileText $ toFilePath f
-  v' <- runIO' $ readPandocFormat fmt readerSettings content
-  liftIO $ walkM includeSources v'
+-- | `SourceReader` for parsing a lightweight markup language using Pandoc
+parse ::
+  -- | The markup format to use when parsing the source. Eg: `PandocFormat_Markdown`
+  PandocFormat ->
+  SourceReader Pandoc
+parse fmt (toFilePath -> f) = do
+  content <- toText <$> readFile' f
+  fmap (first show) $ runExceptT $ do
+    v' <- runIO' $ readPandocFormat fmt readerSettings content
+    liftIO $ walkM includeSources v'
   where
     includeSources = includeCode $ Just $ Format "html5"
 

src/Rib/Shake.hs

@@ -12,6 +12,7 @@ module Rib.Shake
     buildStaticFiles,
     buildHtmlMulti,
     buildHtml,
+    readSource,
 
     -- * Misc
     RibSettings (..),
@@ -62,6 +63,25 @@ buildStaticFiles staticFilePatterns = do
     copyFileChanged' (toFilePath -> old) (toFilePath -> new) =
       copyFileChanged old new
 
+-- | Read and parse an individual source file from the source directory
+readSource ::
+  SourceReader repr ->
+  Path Rel File ->
+  Action (Source repr)
+readSource sourceReader k = do
+  f <- (</> k) <$> ribInputDir
+  -- NOTE: We don't really use cacheActionWith prior to parsing content,
+  -- because the parsed representation (`repr`) may not always have instances
+  -- for Typeable/Binary/Generic (for example, MMark does not expose its
+  -- structure.). Consequently we are forced to cache merely the HTML writing
+  -- stage (see buildHtml').
+  need [toFilePath f]
+  sourceReader f >>= \case
+    Left e ->
+      fail $ "Error parsing source " <> toFilePath k <> ": " <> show e
+    Right v ->
+      pure $ Source k v
+
 -- | Convert the given pattern of source files into their HTML.
 buildHtmlMulti ::
   -- | Source file patterns
@@ -76,20 +96,10 @@ buildHtmlMulti pats parser r = do
   input <- ribInputDir
   fs <- getDirectoryFiles' input pats
   forP fs $ \k -> do
-    let f = input </> k
-    -- NOTE: We don't really use cacheActionWith prior to parsing content,
-    -- because the parsed representation (`repr`) may not always have instances
-    -- for Typeable/Binary/Generic (for example, MMark does not expose its
-    -- structure.). Consequently we are forced to cache merely the HTML writing
-    -- stage (see buildHtml').
-    need [toFilePath f]
-    readSource parser k f >>= \case
-      Left e ->
-        fail $ "Error parsing source " <> toFilePath k <> ": " <> show e
-      Right src -> do
-        outfile <- liftIO $ replaceExtension ".html" k
-        writeFileCached outfile $ toString $ Lucid.renderText $ r src
-        pure src
+    src <- readSource parser k
+    outfile <- liftIO $ replaceExtension ".html" k
+    writeFileCached outfile $ toString $ Lucid.renderText $ r src
+    pure src
 
 -- | Build a single HTML file with the given HTML value
 --

src/Rib/Source.hs

@@ -9,9 +9,8 @@
 
 module Rib.Source
   ( -- * Source type
-    Source,
+    Source (..),
     SourceReader,
-    readSource,
 
     -- * Source properties
     sourcePath,
@@ -20,6 +19,7 @@ module Rib.Source
   )
 where
 
+import Development.Shake (Action)
 import Development.Shake.FilePath ((-<.>))
 import Path hiding ((-<.>))
 
@@ -49,13 +49,4 @@ sourceUrl :: Source repr -> Text
 sourceUrl doc = toText $ toFilePath ([absdir|/|] </> (sourcePath doc)) -<.> ".html"
 
 -- | A function that parses a source representation out of the given file
-type SourceReader repr =
-  forall m b. MonadIO m => Path b File -> m (Either Text repr)
-
-readSource ::
-  MonadIO m =>
-  SourceReader repr ->
-  Path Rel File ->
-  Path b File ->
-  m (Either Text (Source repr))
-readSource r k f = fmap (Source k) <$> r f
+type SourceReader repr = forall b. Path b File -> Action (Either Text repr)