git.iko.soy/hakyll
on dac3fac help sign in
hakyll/src/Hakyll/Core/Resource/Metadata.hs
118 lines 4.4 kB history raw
1--------------------------------------------------------------------------------
2-- | Internal module to parse metadata
3module Hakyll.Core.Resource.Metadata
4 ( loadMetadata
5 ) where
8--------------------------------------------------------------------------------
9import Control.Applicative ((<$>), (<*), (<*>))
10import Control.Arrow (second)
11import qualified Data.ByteString.Char8 as BC
12import qualified Data.Map as M
13import System.IO as IO
14import Text.Parsec ((<?>))
15import qualified Text.Parsec as P
16import Text.Parsec.String (Parser)
19--------------------------------------------------------------------------------
20import Hakyll.Core.Resource
21import Hakyll.Core.Resource.Provider.Internal
22import Hakyll.Core.Util.String
25--------------------------------------------------------------------------------
26loadMetadata :: ResourceProvider -> Resource -> IO (Metadata, Maybe String)
27loadMetadata rp r = do
28 hasHeader <- probablyHasMetadataHeader fp
29 (md, body) <- if hasHeader
30 then second Just <$> loadMetadataHeader fp
31 else return (M.empty, Nothing)
33 emd <- if resourceExists rp mr then loadMetadataFile mfp else return M.empty
35 return (M.union md emd, body)
36 where
37 fp = unResource r
38 mr = resourceMetadataResource r
39 mfp = unResource mr
42--------------------------------------------------------------------------------
43loadMetadataHeader :: FilePath -> IO (Metadata, String)
44loadMetadataHeader fp = do
45 contents <- readFile fp
46 case P.parse page fp contents of
47 Left err -> error (show err)
48 Right (md, b) -> return (M.fromList md, b)
51--------------------------------------------------------------------------------
52loadMetadataFile :: FilePath -> IO Metadata
53loadMetadataFile fp = do
54 contents <- readFile fp
55 case P.parse metadata fp contents of
56 Left err -> error (show err)
57 Right md -> return $ M.fromList md
60--------------------------------------------------------------------------------
61-- | Check if a file "probably" has a metadata header. The main goal of this is
62-- to exclude binary files (which are unlikely to start with "---").
63probablyHasMetadataHeader :: FilePath -> IO Bool
64probablyHasMetadataHeader fp = do
65 handle <- IO.openFile fp IO.ReadMode
66 bs <- BC.hGet handle 1024
67 IO.hClose handle
68 return $ isMetadataHeader bs
69 where
70 isMetadataHeader bs =
71 let pre = BC.takeWhile (\x -> x /= '\n' && x /= '\r') bs
72 in BC.length pre >= 3 && BC.all (== '-') pre
75--------------------------------------------------------------------------------
76-- | Space or tab, no newline
77inlineSpace :: Parser Char
78inlineSpace = P.oneOf ['\t', ' '] <?> "space"
81--------------------------------------------------------------------------------
82-- | Parse a single metadata field
83metadataField :: Parser (String, String)
84metadataField = do
85 key <- P.manyTill P.alphaNum $ P.char ':'
86 P.skipMany1 inlineSpace <?> "space followed by metadata for: " ++ key
87 value <- P.manyTill P.anyChar P.newline
88 trailing' <- P.many trailing
89 return (key, trim $ value ++ concat trailing')
90 where
91 trailing = (++) <$> P.many1 inlineSpace <*> P.manyTill P.anyChar P.newline
94--------------------------------------------------------------------------------
95-- | Parse a metadata block
96metadata :: Parser [(String, String)]
97metadata = P.many metadataField
100--------------------------------------------------------------------------------
101-- | Parse a metadata block, including delimiters and trailing newlines
102metadataBlock :: Parser [(String, String)]
103metadataBlock = do
104 open <- P.many1 (P.char '-') <* P.many inlineSpace <* P.newline
105 metadata' <- metadata
106 _ <- P.choice $ map (P.string . replicate (length open)) ['-', '.']
107 P.skipMany inlineSpace
108 P.skipMany1 P.newline
109 return metadata'
112--------------------------------------------------------------------------------
113-- | Parse a page consisting of a metadata header and a body
114page :: Parser ([(String, String)], String)
115page = do
116 metadata' <- P.option [] metadataBlock
117 body <- P.many P.anyChar
118 return (metadata', body)