git.iko.soy/hakyll
on b91c8be help sign in
hakyll/src/Hakyll/Core/Provider/Metadata.hs
126 lines 4.6 kB history raw
1--------------------------------------------------------------------------------
2-- | Internal module to parse metadata
3module Hakyll.Core.Provider.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.Identifier
21import Hakyll.Core.Metadata
22import Hakyll.Core.Provider.Internal
23import Hakyll.Core.Util.String
26--------------------------------------------------------------------------------
27loadMetadata :: Provider -> Identifier -> IO (Metadata, Maybe String)
28loadMetadata p identifier = do
29 hasHeader <- probablyHasMetadataHeader fp
30 (md, body) <- if hasHeader
31 then second Just <$> loadMetadataHeader fp
32 else return (M.empty, Nothing)
34 emd <- case mi of
35 Nothing -> return M.empty
36 Just mi' -> loadMetadataFile $ resourceFilePath p mi'
38 return (M.union md emd, body)
39 where
40 fp = resourceFilePath p identifier
41 mi = M.lookup identifier (providerFiles p) >>= resourceInfoMetadata
44--------------------------------------------------------------------------------
45loadMetadataHeader :: FilePath -> IO (Metadata, String)
46loadMetadataHeader fp = do
47 contents <- readFile fp
48 case P.parse page fp contents of
49 Left err -> error (show err)
50 Right (md, b) -> return (M.fromList md, b)
53--------------------------------------------------------------------------------
54loadMetadataFile :: FilePath -> IO Metadata
55loadMetadataFile fp = do
56 contents <- readFile fp
57 case P.parse metadata fp contents of
58 Left err -> error (show err)
59 Right md -> return $ M.fromList md
62--------------------------------------------------------------------------------
63-- | Check if a file "probably" has a metadata header. The main goal of this is
64-- to exclude binary files (which are unlikely to start with "---").
65probablyHasMetadataHeader :: FilePath -> IO Bool
66probablyHasMetadataHeader fp = do
67 handle <- IO.openFile fp IO.ReadMode
68 bs <- BC.hGet handle 1024
69 IO.hClose handle
70 return $ isMetadataHeader bs
71 where
72 isMetadataHeader bs =
73 let pre = BC.takeWhile (\x -> x /= '\n' && x /= '\r') bs
74 in BC.length pre >= 3 && BC.all (== '-') pre
77--------------------------------------------------------------------------------
78-- | Space or tab, no newline
79inlineSpace :: Parser Char
80inlineSpace = P.oneOf ['\t', ' '] <?> "space"
83--------------------------------------------------------------------------------
84-- | Parse Windows newlines as well (i.e. "\n" or "\r\n")
85newline :: Parser String
86newline = P.string "\n" <|> P.string "\r\n"
89--------------------------------------------------------------------------------
90-- | Parse a single metadata field
91metadataField :: Parser (String, String)
92metadataField = do
93 key <- P.manyTill P.alphaNum $ P.char ':'
94 P.skipMany1 inlineSpace <?> "space followed by metadata for: " ++ key
95 value <- P.manyTill P.anyChar newline
96 trailing' <- P.many trailing
97 return (key, trim $ value ++ concat trailing')
98 where
99 trailing = (++) <$> P.many1 inlineSpace <*> P.manyTill P.anyChar newline
102--------------------------------------------------------------------------------
103-- | Parse a metadata block
104metadata :: Parser [(String, String)]
105metadata = P.many metadataField
108--------------------------------------------------------------------------------
109-- | Parse a metadata block, including delimiters and trailing newlines
110metadataBlock :: Parser [(String, String)]
111metadataBlock = do
112 open <- P.many1 (P.char '-') <* P.many inlineSpace <* newline
113 metadata' <- metadata
114 _ <- P.choice $ map (P.string . replicate (length open)) ['-', '.']
115 P.skipMany inlineSpace
116 P.skipMany1 newline
117 return metadata'
120--------------------------------------------------------------------------------
121-- | Parse a page consisting of a metadata header and a body
122page :: Parser ([(String, String)], String)
123page = do
124 metadata' <- P.option [] metadataBlock
125 body <- P.many P.anyChar
126 return (metadata', body)