Style changes, move stuff to common parser module

6 files changed, 82 insertions, 49 deletions

diff --git a/src/Hakyll/Core/Compiler/Internal.hs b/src/Hakyll/Core/Compiler/Internal.hs
index fbb7528..5b3e466 100644
--- a/src/Hakyll/Core/Compiler/Internal.hs
+++ b/src/Hakyll/Core/Compiler/Internal.hs
@@ -1,9 +1,9 @@
 --------------------------------------------------------------------------------
 -- | Internally used compiler module
+{-# LANGUAGE FlexibleInstances          #-}
 {-# LANGUAGE GADTs                      #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
 module Hakyll.Core.Compiler.Internal
     ( -- * Types
       CompilerRead (..)
@@ -31,7 +31,7 @@ import           Control.Applicative            (Alternative (..),
                                                  Applicative (..), (<$>))
 import           Control.Exception              (SomeException, handle)
 import           Control.Monad                  (forM_)
-import           Control.Monad.Error
+import           Control.Monad.Error            (MonadError (..))
 import           Data.Monoid                    (Monoid (..))
 import           Data.Set                       (Set)
 import qualified Data.Set                       as S
@@ -149,6 +149,7 @@ instance MonadMetadata Compiler where
     getMetadata = compilerGetMetadata
     getMatches  = compilerGetMatches
 
+
 --------------------------------------------------------------------------------
 instance MonadError [String] Compiler where
   throwError = compilerThrow
diff --git a/src/Hakyll/Core/Provider/Metadata.hs b/src/Hakyll/Core/Provider/Metadata.hs
index 0d94ad7..fe2857a 100644
--- a/src/Hakyll/Core/Provider/Metadata.hs
+++ b/src/Hakyll/Core/Provider/Metadata.hs
@@ -4,6 +4,9 @@ module Hakyll.Core.Provider.Metadata
     ( loadMetadata
     , metadata
     , page
+
+      -- This parser can be reused in some places
+    , metadataKey
     ) where
 
 
@@ -23,6 +26,7 @@ import           Text.Parsec.String            (Parser)
 import           Hakyll.Core.Identifier
 import           Hakyll.Core.Metadata
 import           Hakyll.Core.Provider.Internal
+import           Hakyll.Core.Util.Parser
 import           Hakyll.Core.Util.String
 
 
@@ -93,7 +97,8 @@ newline = P.string "\n" <|> P.string "\r\n"
 -- | Parse a single metadata field
 metadataField :: Parser (String, String)
 metadataField = do
-    key <- P.manyTill P.alphaNum $ P.char ':'
+    key <- metadataKey
+    _   <- P.char ':'
     P.skipMany1 inlineSpace <?> "space followed by metadata for: " ++ key
     value     <- P.manyTill P.anyChar newline
     trailing' <- P.many trailing
diff --git a/src/Hakyll/Core/Util/Parser.hs b/src/Hakyll/Core/Util/Parser.hs
new file mode 100644
index 0000000..afa72c1
--- /dev/null
+++ b/src/Hakyll/Core/Util/Parser.hs
@@ -0,0 +1,25 @@
+--------------------------------------------------------------------------------
+-- | Parser utilities
+module Hakyll.Core.Util.Parser
+    ( metadataKey
+    , reservedKeys
+    ) where
+
+
+--------------------------------------------------------------------------------
+import           Control.Applicative ((<$>), (<*>), (<|>))
+import           Control.Monad       (mzero)
+import qualified Text.Parsec         as P
+import           Text.Parsec.String  (Parser)
+
+
+--------------------------------------------------------------------------------
+metadataKey :: Parser String
+metadataKey = do
+    i <- (:) <$> P.letter <*> (P.many $ P.alphaNum <|> P.oneOf " _-.")
+    if i `elem` reservedKeys then mzero else return i
+
+
+--------------------------------------------------------------------------------
+reservedKeys :: [String]
+reservedKeys = ["if", "else","endif"]
diff --git a/src/Hakyll/Web/Template.hs b/src/Hakyll/Web/Template.hs
index 371ccef..8e3859a 100644
--- a/src/Hakyll/Web/Template.hs
+++ b/src/Hakyll/Web/Template.hs
@@ -116,14 +116,15 @@ applyAsTemplate context item =
 applyTemplateWith :: MonadError e m
                   => (String -> a -> m String)
                   -> Template -> a -> m String
-applyTemplateWith context tpl x = go tpl where
-
+applyTemplateWith context tpl x = go tpl
+  where
     go = liftM concat . mapM applyElem . unTemplate
 
     applyElem (Chunk c)   = return c
     applyElem Escaped     = return "$"
     applyElem (Key k)     = context k x
-    applyElem (If k t mf) = (context k x >> go t) `catchError` handler where
-      handler _ = case mf of
-        Nothing -> return ""
-        Just f  -> go f
+    applyElem (If k t mf) = (context k x >> go t) `catchError` handler
+      where
+        handler _ = case mf of
+            Nothing -> return ""
+            Just f  -> go f
diff --git a/src/Hakyll/Web/Template/Internal.hs b/src/Hakyll/Web/Template/Internal.hs
index 0bd999e..f939566 100644
--- a/src/Hakyll/Web/Template/Internal.hs
+++ b/src/Hakyll/Web/Template/Internal.hs
@@ -22,8 +22,7 @@ import           Hakyll.Core.Writable
 -- | Datatype used for template substitutions.
 newtype Template = Template
     { unTemplate :: [TemplateElement]
-    }
-    deriving (Show, Eq, Binary, Typeable)
+    } deriving (Show, Eq, Binary, Typeable)
 
 
 --------------------------------------------------------------------------------
@@ -41,17 +40,18 @@ data TemplateElement
     | If String Template (Maybe Template) -- key, then branch, else branch
     deriving (Show, Eq, Typeable)
 
+
 --------------------------------------------------------------------------------
 instance Binary TemplateElement where
     put (Chunk string) = putWord8 0 >> put string
-    put (Key key) = putWord8 1 >> put key
-    put (Escaped) = putWord8 2
-    put (If key t f) = putWord8 3 >> put key >> put t >> put f
+    put (Key key)      = putWord8 1 >> put key
+    put (Escaped)      = putWord8 2
+    put (If key t f)   = putWord8 3 >> put key >> put t >> put f
 
     get = getWord8 >>= \tag -> case tag of
-            0 -> Chunk <$> get
-            1 -> Key   <$> get
-            2 -> pure Escaped
-            3 -> If <$> get <*> get <*> get
-            _ -> error $  "Hakyll.Web.Template.Internal: "
-                       ++ "Error reading cached template"
+        0 -> Chunk <$> get
+        1 -> Key   <$> get
+        2 -> pure Escaped
+        3 -> If <$> get <*> get <*> get
+        _ -> error $
+            "Hakyll.Web.Template.Internal: Error reading cached template"
diff --git a/src/Hakyll/Web/Template/Read.hs b/src/Hakyll/Web/Template/Read.hs
index 9504f0b..620ce14 100644
--- a/src/Hakyll/Web/Template/Read.hs
+++ b/src/Hakyll/Web/Template/Read.hs
@@ -4,56 +4,57 @@ module Hakyll.Web.Template.Read
     ( readTemplate
     ) where
 
+
 --------------------------------------------------------------------------------
-import           Control.Applicative          ((<$>), (<$), (<*>))
-import           Control.Monad                (void, mzero)
+import           Control.Applicative          ((<$), (<$>))
+import           Control.Monad                (void)
 import           Text.Parsec
 import           Text.Parsec.String
 
+
 --------------------------------------------------------------------------------
+import           Hakyll.Core.Util.Parser
 import           Hakyll.Web.Template.Internal
 
---------------------------------------------------------------------------------
 
+--------------------------------------------------------------------------------
 readTemplate :: String -> Template
-readTemplate input =
-  case parse template "" input of
+readTemplate input = case parse template "" input of
     Left err -> error $ "Cannot parse template: " ++ show err
     Right t -> t
 
+
+--------------------------------------------------------------------------------
 template :: Parser Template
-template = Template <$>
-  (many1 $ chunk <|> escaped <|> conditional <|> key)
+template = Template <$> (many1 $ chunk <|> escaped <|> conditional <|> key)
+
 
+--------------------------------------------------------------------------------
 chunk :: Parser TemplateElement
 chunk = Chunk <$> (many1 $ noneOf "$")
 
+
+--------------------------------------------------------------------------------
 escaped :: Parser TemplateElement
 escaped = Escaped <$ (try $ string "$$")
 
+
+--------------------------------------------------------------------------------
 conditional :: Parser TemplateElement
 conditional = try $ do
-  void $ string "$if("
-  i <- ident
-  void $ string ")$"
-  thenBranch <- template
-  elseBranch <- optionMaybe $ try (string "$else$") >> template
-  void $ string "$endif$"
-  return $ If i thenBranch elseBranch
-
-ident :: Parser String
-ident = do
-  i <- (:) <$> letter <*> (many $ alphaNum <|> oneOf " _-.")
-  if i `elem` reserved
-     then mzero
-     else return i
-
-reserved :: [String]
-reserved = ["if", "else","endif"]
+    void $ string "$if("
+    i <- metadataKey
+    void $ string ")$"
+    thenBranch <- template
+    elseBranch <- optionMaybe $ try (string "$else$") >> template
+    void $ string "$endif$"
+    return $ If i thenBranch elseBranch
+
 
+--------------------------------------------------------------------------------
 key :: Parser TemplateElement
 key = try $ do
-  void $ char '$'
-  k <- ident
-  void $ char '$'
-  return $ Key k
+    void $ char '$'
+    k <- metadataKey
+    void $ char '$'
+    return $ Key k