gitja - src/Templates.hs

-rw-r--r-- src/Templates.hs
      1 {-# LANGUAGE LambdaCase #-}
      2 {-# LANGUAGE OverloadedStrings #-}
      3 
      4 module Templates (
      5     Template (..),
      6     loadTemplate,
      7     render,
      8 ) where
      9 
     10 import Data.IORef (modifyIORef', newIORef, readIORef)
     11 import qualified Data.Text as T
     12 import qualified Data.Text.Lazy as TL
     13 import qualified Data.Text.Lazy.Builder as TB
     14 import Path (Abs, File, Path, Rel, filename, toFilePath)
     15 import System.IO.Error (tryIOError)
     16 import qualified Text.Ginger.AST as G
     17 import Text.Ginger.GVal (GVal)
     18 import Text.Ginger.Html (Html, htmlSource)
     19 import Text.Ginger.Parse (ParserError (..), SourcePos, parseGingerFile)
     20 import Text.Ginger.Run
     21 
     22 import Types
     23 
     24 data Template = Template
     25     { templatePath :: Path Rel File
     26     , templateGinger :: G.Template SourcePos
     27     }
     28 
     29 {-
     30 This tries to load a `Template` from the given file path.
     31 -}
     32 loadTemplate :: Path Abs File -> IO (Maybe Template)
     33 loadTemplate path =
     34     parseGingerFile includeResolver (toFilePath path) >>= \case
     35         Right parsed -> return . Just . Template (filename path) $ parsed
     36         Left err -> do
     37             informError (toFilePath path) err
     38             return Nothing
     39   where
     40     -- An attempt at pretty printing the error message.
     41     informError p (ParserError msg Nothing) =
     42         putStr $ "Template error: " <> p <> "\n" <> indent msg
     43     informError p (ParserError msg (Just pos)) =
     44         putStrLn $ "Template error: " <> p <> "\n" <> indent (show pos <> "\n" <> msg)
     45     indent = unlines . map (mappend "    ") . lines
     46 
     47     -- This resolves template 'includes'.
     48     includeResolver :: FilePath -> IO (Maybe String)
     49     includeResolver p = either (const Nothing) Just <$> tryIOError (readFile p)
     50 
     51 {-
     52 This generator function uses Ginger to render templates into Text, using a provided
     53 lookup function to request data from calling code.
     54 -}
     55 render ::
     56     (T.Text -> RunRepo (GVal RunRepo)) ->
     57     Template ->
     58     IO TL.Text
     59 render scopeLookup template = do
     60     ioref <- newIORef . TB.fromText $ ""
     61 
     62     let emit :: Html -> IO ()
     63         emit = modifyIORef' ioref . flip mappend . TB.fromText . htmlSource
     64 
     65     runGingerT
     66         (makeContextHtmlM scopeLookup emit)
     67         (templateGinger template)
     68 
     69     TB.toLazyText <$> readIORef ioref
     70