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