diff options
Diffstat (limited to 'src/Hakyll/Core/Resource/Metadata.hs')
| -rw-r--r-- | src/Hakyll/Core/Resource/Metadata.hs | 118 |
1 files changed, 0 insertions, 118 deletions
diff --git a/src/Hakyll/Core/Resource/Metadata.hs b/src/Hakyll/Core/Resource/Metadata.hs deleted file mode 100644 index 44b0721..0000000 --- a/src/Hakyll/Core/Resource/Metadata.hs +++ /dev/null @@ -1,118 +0,0 @@ --------------------------------------------------------------------------------- --- | Internal module to parse metadata -module Hakyll.Core.Resource.Metadata - ( loadMetadata - ) where - - --------------------------------------------------------------------------------- -import Control.Applicative ((<$>), (<*), (<*>)) -import Control.Arrow (second) -import qualified Data.ByteString.Char8 as BC -import qualified Data.Map as M -import System.IO as IO -import Text.Parsec ((<?>)) -import qualified Text.Parsec as P -import Text.Parsec.String (Parser) - - --------------------------------------------------------------------------------- -import Hakyll.Core.Resource -import Hakyll.Core.Resource.Provider.Internal -import Hakyll.Core.Util.String - - --------------------------------------------------------------------------------- -loadMetadata :: ResourceProvider -> Resource -> IO (Metadata, Maybe String) -loadMetadata rp r = do - hasHeader <- probablyHasMetadataHeader fp - (md, body) <- if hasHeader - then second Just <$> loadMetadataHeader fp - else return (M.empty, Nothing) - - emd <- if resourceExists rp mr then loadMetadataFile mfp else return M.empty - - return (M.union md emd, body) - where - fp = unResource r - mr = resourceMetadataResource r - mfp = unResource mr - - --------------------------------------------------------------------------------- -loadMetadataHeader :: FilePath -> IO (Metadata, String) -loadMetadataHeader fp = do - contents <- readFile fp - case P.parse page fp contents of - Left err -> error (show err) - Right (md, b) -> return (M.fromList md, b) - - --------------------------------------------------------------------------------- -loadMetadataFile :: FilePath -> IO Metadata -loadMetadataFile fp = do - contents <- readFile fp - case P.parse metadata fp contents of - Left err -> error (show err) - Right md -> return $ M.fromList md - - --------------------------------------------------------------------------------- --- | Check if a file "probably" has a metadata header. The main goal of this is --- to exclude binary files (which are unlikely to start with "---"). -probablyHasMetadataHeader :: FilePath -> IO Bool -probablyHasMetadataHeader fp = do - handle <- IO.openFile fp IO.ReadMode - bs <- BC.hGet handle 1024 - IO.hClose handle - return $ isMetadataHeader bs - where - isMetadataHeader bs = - let pre = BC.takeWhile (\x -> x /= '\n' && x /= '\r') bs - in BC.length pre >= 3 && BC.all (== '-') pre - - --------------------------------------------------------------------------------- --- | Space or tab, no newline -inlineSpace :: Parser Char -inlineSpace = P.oneOf ['\t', ' '] <?> "space" - - --------------------------------------------------------------------------------- --- | Parse a single metadata field -metadataField :: Parser (String, String) -metadataField = do - key <- P.manyTill P.alphaNum $ P.char ':' - P.skipMany1 inlineSpace <?> "space followed by metadata for: " ++ key - value <- P.manyTill P.anyChar P.newline - trailing' <- P.many trailing - return (key, trim $ value ++ concat trailing') - where - trailing = (++) <$> P.many1 inlineSpace <*> P.manyTill P.anyChar P.newline - - --------------------------------------------------------------------------------- --- | Parse a metadata block -metadata :: Parser [(String, String)] -metadata = P.many metadataField - - --------------------------------------------------------------------------------- --- | Parse a metadata block, including delimiters and trailing newlines -metadataBlock :: Parser [(String, String)] -metadataBlock = do - open <- P.many1 (P.char '-') <* P.many inlineSpace <* P.newline - metadata' <- metadata - _ <- P.choice $ map (P.string . replicate (length open)) ['-', '.'] - P.skipMany inlineSpace - P.skipMany1 P.newline - return metadata' - - --------------------------------------------------------------------------------- --- | Parse a page consisting of a metadata header and a body -page :: Parser ([(String, String)], String) -page = do - metadata' <- P.option [] metadataBlock - body <- P.many P.anyChar - return (metadata', body) |
