Add IsString instance for Template

Closes #150

1 files changed, 93 insertions, 6 deletions

diff --git a/src/Hakyll/Web/Template/Internal.hs b/src/Hakyll/Web/Template/Internal.hs
index 138010e..4450a19 100644
--- a/src/Hakyll/Web/Template/Internal.hs
+++ b/src/Hakyll/Web/Template/Internal.hs
@@ -5,16 +5,22 @@
 module Hakyll.Web.Template.Internal
     ( Template (..)
     , TemplateElement (..)
+    , readTemplate
     ) where
 
 
 --------------------------------------------------------------------------------
-import           Control.Applicative  (pure, (<$>), (<*>))
-import           Data.Binary          (Binary, get, getWord8, put, putWord8)
-import           Data.Typeable        (Typeable)
+import           Control.Applicative     (pure, (<$), (<$>), (<*>), (<|>))
+import           Control.Monad           (void)
+import           Data.Binary             (Binary, get, getWord8, put, putWord8)
+import           Data.Typeable           (Typeable)
+import           GHC.Exts                (IsString (..))
+import qualified Text.Parsec             as P
+import qualified Text.Parsec.String      as P
 
 
 --------------------------------------------------------------------------------
+import           Hakyll.Core.Util.Parser
 import           Hakyll.Core.Writable
 
 
@@ -46,10 +52,10 @@ data TemplateElement
 --------------------------------------------------------------------------------
 instance Binary TemplateElement where
     put (Chunk string) = putWord8 0 >> put string
-    put (Key key)      = putWord8 1 >> put key
+    put (Key k)        = putWord8 1 >> put k
     put (Escaped)      = putWord8 2
-    put (If key t f)   = putWord8 3 >> put key >> put t >> put f
-    put (For key b s)  = putWord8 4 >> put key >> put b >> put s
+    put (If k t f  )   = putWord8 3 >> put k >> put t >> put f
+    put (For k b s)    = putWord8 4 >> put k >> put b >> put s
     put (Partial p)    = putWord8 5 >> put p
 
     get = getWord8 >>= \tag -> case tag of
@@ -61,3 +67,84 @@ instance Binary TemplateElement where
         5 -> Partial <$> get
         _ -> error $
             "Hakyll.Web.Template.Internal: Error reading cached template"
+
+
+--------------------------------------------------------------------------------
+instance IsString Template where
+    fromString = readTemplate
+
+
+--------------------------------------------------------------------------------
+readTemplate :: String -> Template
+readTemplate input = case P.parse template "" input of
+    Left err -> error $ "Cannot parse template: " ++ show err
+    Right t  -> t
+
+
+--------------------------------------------------------------------------------
+template :: P.Parser Template
+template = Template <$>
+    (P.many1 $ chunk <|> escaped <|> conditional <|> for <|> partial <|> key)
+
+
+--------------------------------------------------------------------------------
+chunk :: P.Parser TemplateElement
+chunk = Chunk <$> (P.many1 $ P.noneOf "$")
+
+
+--------------------------------------------------------------------------------
+escaped :: P.Parser TemplateElement
+escaped = Escaped <$ (P.try $ P.string "$$")
+
+
+--------------------------------------------------------------------------------
+conditional :: P.Parser TemplateElement
+conditional = P.try $ do
+    void $ P.string "$if("
+    i <- metadataKey
+    void $ P.string ")$"
+    thenBranch <- template
+    elseBranch <- P.optionMaybe $ P.try (P.string "$else$") >> template
+    void $ P.string "$endif$"
+    return $ If i thenBranch elseBranch
+
+
+--------------------------------------------------------------------------------
+for :: P.Parser TemplateElement
+for = P.try $ do
+    void $ P.string "$for("
+    i <- metadataKey
+    void $ P.string ")$"
+    body <- template
+    sep  <- P.optionMaybe $ P.try (P.string "$sep$") >> template
+    void $ P.string "$endfor$"
+    return $ For i body sep
+
+
+--------------------------------------------------------------------------------
+partial :: P.Parser TemplateElement
+partial = P.try $ do
+    void $ P.string "$partial("
+    i <- stringLiteral
+    void $ P.string ")$"
+    return $ Partial i
+
+
+--------------------------------------------------------------------------------
+key :: P.Parser TemplateElement
+key = P.try $ do
+    void $ P.char '$'
+    k <- metadataKey
+    void $ P.char '$'
+    return $ Key k
+
+
+--------------------------------------------------------------------------------
+stringLiteral :: P.Parser String
+stringLiteral = do
+    void $ P.char '\"'
+    str <- P.many $ do
+        x <- P.noneOf "\""
+        if x == '\\' then P.anyChar else return x
+    void $ P.char '\"'
+    return str