git.iko.soy/hakyll
on b287c82 help sign in
hakyll/src/Hakyll/Core/Provider/Metadata.hs
129 lines 4.7 kB history raw
1--------------------------------------------------------------------------------
2-- | Internal module to parse metadata
3module Hakyll.Core.Provider.Metadata
4 ( loadMetadata
5 , metadata
6 , page
7 ) where
10--------------------------------------------------------------------------------
11import Control.Applicative
12import Control.Arrow (second)
13import qualified Data.ByteString.Char8 as BC
14import Data.List (intercalate)
15import qualified Data.Map as M
16import System.IO as IO
17import Text.Parsec ((<?>))
18import qualified Text.Parsec as P
19import Text.Parsec.String (Parser)
22--------------------------------------------------------------------------------
23import Hakyll.Core.Identifier
24import Hakyll.Core.Metadata
25import Hakyll.Core.Provider.Internal
26import Hakyll.Core.Util.String
29--------------------------------------------------------------------------------
30loadMetadata :: Provider -> Identifier -> IO (Metadata, Maybe String)
31loadMetadata p identifier = do
32 hasHeader <- probablyHasMetadataHeader fp
33 (md, body) <- if hasHeader
34 then second Just <$> loadMetadataHeader fp
35 else return (M.empty, Nothing)
37 emd <- case mi of
38 Nothing -> return M.empty
39 Just mi' -> loadMetadataFile $ resourceFilePath p mi'
41 return (M.union md emd, body)
42 where
43 fp = resourceFilePath p identifier
44 mi = M.lookup identifier (providerFiles p) >>= resourceInfoMetadata
47--------------------------------------------------------------------------------
48loadMetadataHeader :: FilePath -> IO (Metadata, String)
49loadMetadataHeader fp = do
50 contents <- readFile fp
51 case P.parse page fp contents of
52 Left err -> error (show err)
53 Right (md, b) -> return (M.fromList md, b)
56--------------------------------------------------------------------------------
57loadMetadataFile :: FilePath -> IO Metadata
58loadMetadataFile fp = do
59 contents <- readFile fp
60 case P.parse metadata fp contents of
61 Left err -> error (show err)
62 Right md -> return $ M.fromList md
65--------------------------------------------------------------------------------
66-- | Check if a file "probably" has a metadata header. The main goal of this is
67-- to exclude binary files (which are unlikely to start with "---").
68probablyHasMetadataHeader :: FilePath -> IO Bool
69probablyHasMetadataHeader fp = do
70 handle <- IO.openFile fp IO.ReadMode
71 bs <- BC.hGet handle 1024
72 IO.hClose handle
73 return $ isMetadataHeader bs
74 where
75 isMetadataHeader bs =
76 let pre = BC.takeWhile (\x -> x /= '\n' && x /= '\r') bs
77 in BC.length pre >= 3 && BC.all (== '-') pre
80--------------------------------------------------------------------------------
81-- | Space or tab, no newline
82inlineSpace :: Parser Char
83inlineSpace = P.oneOf ['\t', ' '] <?> "space"
86--------------------------------------------------------------------------------
87-- | Parse Windows newlines as well (i.e. "\n" or "\r\n")
88newline :: Parser String
89newline = P.string "\n" <|> P.string "\r\n"
92--------------------------------------------------------------------------------
93-- | Parse a single metadata field
94metadataField :: Parser (String, String)
95metadataField = do
96 key <- P.manyTill P.alphaNum $ P.char ':'
97 P.skipMany1 inlineSpace <?> "space followed by metadata for: " ++ key
98 value <- P.manyTill P.anyChar newline
99 trailing' <- P.many trailing
100 return (key, trim $ intercalate " " $ value : trailing')
101 where
102 trailing = P.many1 inlineSpace *> P.manyTill P.anyChar newline
105--------------------------------------------------------------------------------
106-- | Parse a metadata block
107metadata :: Parser [(String, String)]
108metadata = P.many metadataField
111--------------------------------------------------------------------------------
112-- | Parse a metadata block, including delimiters and trailing newlines
113metadataBlock :: Parser [(String, String)]
114metadataBlock = do
115 open <- P.many1 (P.char '-') <* P.many inlineSpace <* newline
116 metadata' <- metadata
117 _ <- P.choice $ map (P.string . replicate (length open)) ['-', '.']
118 P.skipMany inlineSpace
119 P.skipMany1 newline
120 return metadata'
123--------------------------------------------------------------------------------
124-- | Parse a page consisting of a metadata header and a body
125page :: Parser ([(String, String)], String)
126page = do
127 metadata' <- P.option [] metadataBlock
128 body <- P.many P.anyChar
129 return (metadata', body)