parent
3f3e09672d
commit
e81468e0f6
17 changed files with 287 additions and 195 deletions
3
.gitignore
vendored
3
.gitignore
vendored
|
@ -1,4 +1,4 @@
|
|||
# Ignore swap files and cabal output.
|
||||
# Ignore swap files and stack/cabal output.
|
||||
*.hi
|
||||
*.o
|
||||
*.swo
|
||||
|
@ -10,6 +10,7 @@ dist
|
|||
tags
|
||||
cabal.sandbox.config
|
||||
.cabal-sandbox/
|
||||
.stack-work
|
||||
|
||||
# Ignore test builds.
|
||||
tests/Main
|
||||
|
|
116
hakyll.cabal
116
hakyll.cabal
|
@ -121,6 +121,8 @@ Library
|
|||
Hakyll.Web.Template.List
|
||||
|
||||
Other-Modules:
|
||||
Data.List.Extended
|
||||
Data.Yaml.Extended
|
||||
Hakyll.Check
|
||||
Hakyll.Commands
|
||||
Hakyll.Core.Compiler.Internal
|
||||
|
@ -140,33 +142,36 @@ Library
|
|||
Paths_hakyll
|
||||
|
||||
Build-Depends:
|
||||
base >= 4 && < 5,
|
||||
binary >= 0.5 && < 0.8,
|
||||
blaze-html >= 0.5 && < 0.9,
|
||||
blaze-markup >= 0.5.1 && < 0.8,
|
||||
bytestring >= 0.9 && < 0.11,
|
||||
cmdargs >= 0.10 && < 0.11,
|
||||
containers >= 0.3 && < 0.6,
|
||||
cryptohash >= 0.7 && < 0.12,
|
||||
data-default >= 0.4 && < 0.6,
|
||||
deepseq >= 1.3 && < 1.5,
|
||||
directory >= 1.0 && < 1.3,
|
||||
filepath >= 1.0 && < 1.5,
|
||||
lrucache >= 1.1.1 && < 1.3,
|
||||
mtl >= 1 && < 2.3,
|
||||
network >= 2.6 && < 2.7,
|
||||
network-uri >= 2.6 && < 2.7,
|
||||
pandoc >= 1.14 && < 1.18,
|
||||
pandoc-citeproc >= 0.4 && < 0.10,
|
||||
parsec >= 3.0 && < 3.2,
|
||||
process >= 1.0 && < 1.3,
|
||||
random >= 1.0 && < 1.2,
|
||||
regex-base >= 0.93 && < 0.94,
|
||||
regex-tdfa >= 1.1 && < 1.3,
|
||||
tagsoup >= 0.13.1 && < 0.14,
|
||||
text >= 0.11 && < 1.3,
|
||||
time >= 1.4 && < 1.6,
|
||||
time-locale-compat >= 0.1 && < 0.2
|
||||
base >= 4 && < 5,
|
||||
binary >= 0.5 && < 0.8,
|
||||
blaze-html >= 0.5 && < 0.9,
|
||||
blaze-markup >= 0.5.1 && < 0.8,
|
||||
bytestring >= 0.9 && < 0.11,
|
||||
cmdargs >= 0.10 && < 0.11,
|
||||
containers >= 0.3 && < 0.6,
|
||||
cryptohash >= 0.7 && < 0.12,
|
||||
data-default >= 0.4 && < 0.6,
|
||||
deepseq >= 1.3 && < 1.5,
|
||||
directory >= 1.0 && < 1.3,
|
||||
filepath >= 1.0 && < 1.5,
|
||||
lrucache >= 1.1.1 && < 1.3,
|
||||
mtl >= 1 && < 2.3,
|
||||
network >= 2.6 && < 2.7,
|
||||
network-uri >= 2.6 && < 2.7,
|
||||
pandoc >= 1.14 && < 1.18,
|
||||
pandoc-citeproc >= 0.4 && < 0.10,
|
||||
parsec >= 3.0 && < 3.2,
|
||||
process >= 1.0 && < 1.3,
|
||||
random >= 1.0 && < 1.2,
|
||||
regex-base >= 0.93 && < 0.94,
|
||||
regex-tdfa >= 1.1 && < 1.3,
|
||||
tagsoup >= 0.13.1 && < 0.14,
|
||||
text >= 0.11 && < 1.3,
|
||||
time >= 1.4 && < 1.6,
|
||||
time-locale-compat >= 0.1 && < 0.2,
|
||||
unordered-containers >= 0.2 && < 0.3,
|
||||
vector >= 0.11 && < 0.12,
|
||||
yaml >= 0.8 && < 0.9
|
||||
|
||||
If flag(previewServer)
|
||||
Build-depends:
|
||||
|
@ -226,33 +231,36 @@ Test-suite hakyll-tests
|
|||
test-framework-hunit >= 0.3 && < 0.4,
|
||||
test-framework-quickcheck2 >= 0.3 && < 0.4,
|
||||
-- Copy pasted from hakyll dependencies:
|
||||
base >= 4 && < 5,
|
||||
binary >= 0.5 && < 0.8,
|
||||
blaze-html >= 0.5 && < 0.9,
|
||||
blaze-markup >= 0.5.1 && < 0.8,
|
||||
bytestring >= 0.9 && < 0.11,
|
||||
cmdargs >= 0.10 && < 0.11,
|
||||
containers >= 0.3 && < 0.6,
|
||||
cryptohash >= 0.7 && < 0.12,
|
||||
data-default >= 0.4 && < 0.6,
|
||||
deepseq >= 1.3 && < 1.5,
|
||||
directory >= 1.0 && < 1.3,
|
||||
filepath >= 1.0 && < 1.5,
|
||||
lrucache >= 1.1.1 && < 1.3,
|
||||
mtl >= 1 && < 2.3,
|
||||
network >= 2.6 && < 2.7,
|
||||
network-uri >= 2.6 && < 2.7,
|
||||
pandoc >= 1.14 && < 1.18,
|
||||
pandoc-citeproc >= 0.4 && < 0.10,
|
||||
parsec >= 3.0 && < 3.2,
|
||||
process >= 1.0 && < 1.3,
|
||||
random >= 1.0 && < 1.2,
|
||||
regex-base >= 0.93 && < 0.94,
|
||||
regex-tdfa >= 1.1 && < 1.3,
|
||||
tagsoup >= 0.13.1 && < 0.14,
|
||||
text >= 0.11 && < 1.3,
|
||||
time >= 1.5 && < 1.6,
|
||||
time-locale-compat >= 0.1 && < 0.2
|
||||
base >= 4 && < 5,
|
||||
binary >= 0.5 && < 0.8,
|
||||
blaze-html >= 0.5 && < 0.9,
|
||||
blaze-markup >= 0.5.1 && < 0.8,
|
||||
bytestring >= 0.9 && < 0.11,
|
||||
cmdargs >= 0.10 && < 0.11,
|
||||
containers >= 0.3 && < 0.6,
|
||||
cryptohash >= 0.7 && < 0.12,
|
||||
data-default >= 0.4 && < 0.6,
|
||||
deepseq >= 1.3 && < 1.5,
|
||||
directory >= 1.0 && < 1.3,
|
||||
filepath >= 1.0 && < 1.5,
|
||||
lrucache >= 1.1.1 && < 1.3,
|
||||
mtl >= 1 && < 2.3,
|
||||
network >= 2.6 && < 2.7,
|
||||
network-uri >= 2.6 && < 2.7,
|
||||
pandoc >= 1.14 && < 1.18,
|
||||
pandoc-citeproc >= 0.4 && < 0.10,
|
||||
parsec >= 3.0 && < 3.2,
|
||||
process >= 1.0 && < 1.3,
|
||||
random >= 1.0 && < 1.2,
|
||||
regex-base >= 0.93 && < 0.94,
|
||||
regex-tdfa >= 1.1 && < 1.3,
|
||||
tagsoup >= 0.13.1 && < 0.14,
|
||||
text >= 0.11 && < 1.3,
|
||||
time >= 1.4 && < 1.6,
|
||||
time-locale-compat >= 0.1 && < 0.2,
|
||||
unordered-containers >= 0.2 && < 0.3,
|
||||
vector >= 0.11 && < 0.12,
|
||||
yaml >= 0.8 && < 0.9
|
||||
|
||||
If flag(previewServer)
|
||||
Build-depends:
|
||||
|
|
15
src/Data/List/Extended.hs
Normal file
15
src/Data/List/Extended.hs
Normal file
|
@ -0,0 +1,15 @@
|
|||
module Data.List.Extended
|
||||
( module Data.List
|
||||
, breakWhen
|
||||
) where
|
||||
|
||||
import Data.List
|
||||
|
||||
-- | Like 'break', but can act on the entire tail of the list.
|
||||
breakWhen :: ([a] -> Bool) -> [a] -> ([a], [a])
|
||||
breakWhen predicate = go []
|
||||
where
|
||||
go buf [] = (reverse buf, [])
|
||||
go buf (x : xs)
|
||||
| predicate (x : xs) = (reverse buf, x : xs)
|
||||
| otherwise = go (x : buf) xs
|
17
src/Data/Yaml/Extended.hs
Normal file
17
src/Data/Yaml/Extended.hs
Normal file
|
@ -0,0 +1,17 @@
|
|||
module Data.Yaml.Extended
|
||||
( module Data.Yaml
|
||||
, toString
|
||||
, toList
|
||||
) where
|
||||
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Vector as V
|
||||
import Data.Yaml
|
||||
|
||||
toString :: Value -> Maybe String
|
||||
toString (String t) = Just (T.unpack t)
|
||||
toString _ = Nothing
|
||||
|
||||
toList :: Value -> Maybe [Value]
|
||||
toList (Array a) = Just (V.toList a)
|
||||
toList _ = Nothing
|
|
@ -1,28 +1,46 @@
|
|||
--------------------------------------------------------------------------------
|
||||
module Hakyll.Core.Metadata
|
||||
( Metadata
|
||||
, lookupString
|
||||
, lookupStringList
|
||||
|
||||
, MonadMetadata (..)
|
||||
, getMetadataField
|
||||
, getMetadataField'
|
||||
, makePatternDependency
|
||||
|
||||
, BinaryMetadata (..)
|
||||
) where
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
import Control.Arrow (second)
|
||||
import Control.Monad (forM)
|
||||
import Data.Map (Map)
|
||||
import qualified Data.Map as M
|
||||
import Data.Binary (Binary (..), getWord8,
|
||||
putWord8, Get)
|
||||
import qualified Data.HashMap.Strict as HMS
|
||||
import qualified Data.Set as S
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Vector as V
|
||||
import qualified Data.Yaml.Extended as Yaml
|
||||
import Hakyll.Core.Dependencies
|
||||
import Hakyll.Core.Identifier
|
||||
import Hakyll.Core.Identifier.Pattern
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
type Metadata = Map String String
|
||||
type Metadata = Yaml.Object
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
lookupString :: String -> Metadata -> Maybe String
|
||||
lookupString key meta = HMS.lookup (T.pack key) meta >>= Yaml.toString
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
lookupStringList :: String -> Metadata -> Maybe [String]
|
||||
lookupStringList key meta =
|
||||
HMS.lookup (T.pack key) meta >>= Yaml.toList >>= mapM Yaml.toString
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
@ -42,7 +60,7 @@ class Monad m => MonadMetadata m where
|
|||
getMetadataField :: MonadMetadata m => Identifier -> String -> m (Maybe String)
|
||||
getMetadataField identifier key = do
|
||||
metadata <- getMetadata identifier
|
||||
return $ M.lookup key metadata
|
||||
return $ lookupString key metadata
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
@ -62,3 +80,59 @@ makePatternDependency :: MonadMetadata m => Pattern -> m Dependency
|
|||
makePatternDependency pattern = do
|
||||
matches' <- getMatches pattern
|
||||
return $ PatternDependency pattern (S.fromList matches')
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Newtype wrapper for serialization.
|
||||
newtype BinaryMetadata = BinaryMetadata
|
||||
{unBinaryMetadata :: Metadata}
|
||||
|
||||
|
||||
instance Binary BinaryMetadata where
|
||||
put (BinaryMetadata obj) = put (BinaryYaml $ Yaml.Object obj)
|
||||
get = do
|
||||
BinaryYaml (Yaml.Object obj) <- get
|
||||
return $ BinaryMetadata obj
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
newtype BinaryYaml = BinaryYaml {unBinaryYaml :: Yaml.Value}
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
instance Binary BinaryYaml where
|
||||
put (BinaryYaml yaml) = case yaml of
|
||||
Yaml.Object obj -> do
|
||||
putWord8 0
|
||||
let list :: [(T.Text, BinaryYaml)]
|
||||
list = map (second BinaryYaml) $ HMS.toList obj
|
||||
put list
|
||||
|
||||
Yaml.Array arr -> do
|
||||
putWord8 1
|
||||
let list = map BinaryYaml (V.toList arr) :: [BinaryYaml]
|
||||
put list
|
||||
|
||||
Yaml.String s -> putWord8 2 >> put s
|
||||
Yaml.Number n -> putWord8 3 >> put n
|
||||
Yaml.Bool b -> putWord8 4 >> put b
|
||||
Yaml.Null -> putWord8 5
|
||||
|
||||
get = do
|
||||
tag <- getWord8
|
||||
case tag of
|
||||
0 -> do
|
||||
list <- get :: Get [(T.Text, BinaryYaml)]
|
||||
return $ BinaryYaml $ Yaml.Object $
|
||||
HMS.fromList $ map (second unBinaryYaml) list
|
||||
|
||||
1 -> do
|
||||
list <- get :: Get [BinaryYaml]
|
||||
return $ BinaryYaml $
|
||||
Yaml.Array $ V.fromList $ map unBinaryYaml list
|
||||
|
||||
2 -> BinaryYaml . Yaml.String <$> get
|
||||
3 -> BinaryYaml . Yaml.Number <$> get
|
||||
4 -> BinaryYaml . Yaml.Bool <$> get
|
||||
5 -> return $ BinaryYaml Yaml.Null
|
||||
_ -> fail "Data.Binary.get: Invalid Binary Metadata"
|
||||
|
|
|
@ -1,33 +1,32 @@
|
|||
--------------------------------------------------------------------------------
|
||||
-- | Internal module to parse metadata
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
module Hakyll.Core.Provider.Metadata
|
||||
( loadMetadata
|
||||
, metadata
|
||||
, page
|
||||
|
||||
-- This parser can be reused in some places
|
||||
, metadataKey
|
||||
, parsePage
|
||||
) where
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
import Control.Applicative
|
||||
import Control.Arrow (second)
|
||||
import Control.Monad (guard)
|
||||
import qualified Data.ByteString.Char8 as BC
|
||||
import qualified Data.HashMap.Strict as HMS
|
||||
import Data.List (intercalate)
|
||||
import Data.List.Extended (breakWhen)
|
||||
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 Data.Maybe (fromMaybe)
|
||||
import Data.Monoid ((<>))
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as T
|
||||
import qualified Data.Yaml as Yaml
|
||||
import Hakyll.Core.Identifier
|
||||
import Hakyll.Core.Metadata
|
||||
import Hakyll.Core.Provider.Internal
|
||||
import Hakyll.Core.Util.Parser
|
||||
import Hakyll.Core.Util.String
|
||||
import System.IO as IO
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
@ -36,13 +35,13 @@ loadMetadata p identifier = do
|
|||
hasHeader <- probablyHasMetadataHeader fp
|
||||
(md, body) <- if hasHeader
|
||||
then second Just <$> loadMetadataHeader fp
|
||||
else return (M.empty, Nothing)
|
||||
else return (mempty, Nothing)
|
||||
|
||||
emd <- case mi of
|
||||
Nothing -> return M.empty
|
||||
Nothing -> return mempty
|
||||
Just mi' -> loadMetadataFile $ resourceFilePath p mi'
|
||||
|
||||
return (M.union md emd, body)
|
||||
return (md <> emd, body)
|
||||
where
|
||||
normal = setVersion Nothing identifier
|
||||
fp = resourceFilePath p identifier
|
||||
|
@ -52,19 +51,15 @@ loadMetadata p identifier = do
|
|||
--------------------------------------------------------------------------------
|
||||
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)
|
||||
fileContent <- readFile fp
|
||||
either fail return (parsePage fileContent)
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
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
|
||||
errOrMeta <- Yaml.decodeFileEither fp
|
||||
either (fail . show) return errOrMeta
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
@ -83,53 +78,41 @@ probablyHasMetadataHeader fp = do
|
|||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Space or tab, no newline
|
||||
inlineSpace :: Parser Char
|
||||
inlineSpace = P.oneOf ['\t', ' '] <?> "space"
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Parse Windows newlines as well (i.e. "\n" or "\r\n")
|
||||
newline :: Parser String
|
||||
newline = P.string "\n" <|> P.string "\r\n"
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Parse a single metadata field
|
||||
metadataField :: Parser (String, String)
|
||||
metadataField = do
|
||||
key <- metadataKey
|
||||
_ <- P.char ':'
|
||||
P.skipMany1 inlineSpace <?> "space followed by metadata for: " ++ key
|
||||
value <- P.manyTill P.anyChar newline
|
||||
trailing' <- P.many trailing
|
||||
return (key, trim $ intercalate " " $ value : trailing')
|
||||
-- | Parse the page metadata and body.
|
||||
splitMetadata :: String -> (Maybe String, String)
|
||||
splitMetadata str0 = fromMaybe (Nothing, str0) $ do
|
||||
guard $ leading >= 3
|
||||
let !(!meta, !content0) = breakWhen isTrailing (drop leading str0)
|
||||
guard $ not $ null content0
|
||||
let !content1 = drop (leading + 1) content0
|
||||
!content2 = dropWhile isNewline $ dropWhile isInlineSpace content1
|
||||
return (Just meta, content2)
|
||||
where
|
||||
trailing = P.many1 inlineSpace *> P.manyTill P.anyChar newline
|
||||
-- Parse the leading "---"
|
||||
!leading = length $ takeWhile (== '-') str0
|
||||
|
||||
-- Predicate to recognize the trailing "---" or "..."
|
||||
isTrailing [] = False
|
||||
isTrailing (x : xs) =
|
||||
isNewline x && length (takeWhile isDash xs) == leading
|
||||
|
||||
-- Characters
|
||||
isNewline c = c == '\n' || c == '\r'
|
||||
isDash c = c == '-' || c == '.'
|
||||
isInlineSpace c = c == '\t' || c == ' '
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Parse a metadata block
|
||||
metadata :: Parser [(String, String)]
|
||||
metadata = P.many metadataField
|
||||
parseMetadata :: String -> Either String Metadata
|
||||
parseMetadata = Yaml.decodeEither . T.encodeUtf8 . T.pack
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Parse a metadata block, including delimiters and trailing newlines
|
||||
metadataBlock :: Parser [(String, String)]
|
||||
metadataBlock = do
|
||||
open <- P.many1 (P.char '-') <* P.many inlineSpace <* newline
|
||||
metadata' <- metadata
|
||||
_ <- P.choice $ map (P.string . replicate (length open)) ['-', '.']
|
||||
P.skipMany inlineSpace
|
||||
P.skipMany1 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)
|
||||
parsePage :: String -> Either String (Metadata, String)
|
||||
parsePage fileContent = case mbMetaBlock of
|
||||
Nothing -> return (mempty, content)
|
||||
Just metaBlock -> case parseMetadata metaBlock of
|
||||
Left err -> Left err
|
||||
Right meta -> return (meta, content)
|
||||
where
|
||||
!(!mbMetaBlock, !content) = splitMetadata fileContent
|
||||
|
|
|
@ -8,9 +8,6 @@ module Hakyll.Core.Provider.MetadataCache
|
|||
|
||||
--------------------------------------------------------------------------------
|
||||
import Control.Monad (unless)
|
||||
import qualified Data.Map as M
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
import Hakyll.Core.Identifier
|
||||
import Hakyll.Core.Metadata
|
||||
import Hakyll.Core.Provider.Internal
|
||||
|
@ -21,11 +18,11 @@ import qualified Hakyll.Core.Store as Store
|
|||
--------------------------------------------------------------------------------
|
||||
resourceMetadata :: Provider -> Identifier -> IO Metadata
|
||||
resourceMetadata p r
|
||||
| not (resourceExists p r) = return M.empty
|
||||
| not (resourceExists p r) = return mempty
|
||||
| otherwise = do
|
||||
-- TODO keep time in md cache
|
||||
load p r
|
||||
Store.Found md <- Store.get (providerStore p)
|
||||
Store.Found (BinaryMetadata md) <- Store.get (providerStore p)
|
||||
[name, toFilePath r, "metadata"]
|
||||
return md
|
||||
|
||||
|
@ -52,7 +49,7 @@ load p r = do
|
|||
mmof <- Store.isMember store mdk
|
||||
unless mmof $ do
|
||||
(md, body) <- loadMetadata p r
|
||||
Store.set store mdk md
|
||||
Store.set store mdk (BinaryMetadata md)
|
||||
Store.set store bk body
|
||||
where
|
||||
store = providerStore p
|
||||
|
|
|
@ -42,7 +42,6 @@ module Hakyll.Core.Routes
|
|||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
import Data.Monoid (Monoid, mappend, mempty)
|
||||
import System.FilePath (replaceExtension)
|
||||
|
||||
|
||||
|
|
|
@ -5,7 +5,6 @@ module Hakyll.Core.Runtime
|
|||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
import Control.Applicative ((<$>))
|
||||
import Control.Monad (unless)
|
||||
import Control.Monad.Error (ErrorT, runErrorT, throwError)
|
||||
import Control.Monad.Reader (ask)
|
||||
|
@ -15,7 +14,6 @@ import Control.Monad.Trans (liftIO)
|
|||
import Data.List (intercalate)
|
||||
import Data.Map (Map)
|
||||
import qualified Data.Map as M
|
||||
import Data.Monoid (mempty)
|
||||
import Data.Set (Set)
|
||||
import qualified Data.Set as S
|
||||
import System.Exit (ExitCode (..))
|
||||
|
|
|
@ -23,22 +23,19 @@ module Hakyll.Web.Pandoc.Biblio
|
|||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
import Control.Applicative ((<$>))
|
||||
import Control.Monad (replicateM, liftM)
|
||||
import Data.Binary (Binary (..))
|
||||
import Data.Default (def)
|
||||
import Data.Typeable (Typeable)
|
||||
import qualified Text.CSL as CSL
|
||||
import Text.CSL.Pandoc (processCites)
|
||||
import Text.Pandoc (Pandoc, ReaderOptions (..))
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
import Control.Monad (liftM, replicateM)
|
||||
import Data.Binary (Binary (..))
|
||||
import Data.Default (def)
|
||||
import Data.Typeable (Typeable)
|
||||
import Hakyll.Core.Compiler
|
||||
import Hakyll.Core.Identifier
|
||||
import Hakyll.Core.Item
|
||||
import Hakyll.Core.Writable
|
||||
import Hakyll.Web.Pandoc
|
||||
import Hakyll.Web.Pandoc.Binary ()
|
||||
import qualified Text.CSL as CSL
|
||||
import Text.CSL.Pandoc (processCites)
|
||||
import Text.Pandoc (Pandoc, ReaderOptions (..))
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
|
|
@ -63,13 +63,12 @@ module Hakyll.Web.Tags
|
|||
|
||||
--------------------------------------------------------------------------------
|
||||
import Control.Arrow ((&&&))
|
||||
import Control.Monad (foldM, forM, forM_)
|
||||
import Control.Monad (foldM, forM, forM_, mplus)
|
||||
import Data.Char (toLower)
|
||||
import Data.List (intercalate, intersperse,
|
||||
sortBy)
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe (catMaybes, fromMaybe)
|
||||
import Data.Monoid (mconcat)
|
||||
import Data.Ord (comparing)
|
||||
import qualified Data.Set as S
|
||||
import System.FilePath (takeBaseName, takeDirectory)
|
||||
|
@ -88,8 +87,8 @@ import Hakyll.Core.Item
|
|||
import Hakyll.Core.Metadata
|
||||
import Hakyll.Core.Rules
|
||||
import Hakyll.Core.Util.String
|
||||
import Hakyll.Web.Template.Context
|
||||
import Hakyll.Web.Html
|
||||
import Hakyll.Web.Template.Context
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
@ -103,11 +102,14 @@ data Tags = Tags
|
|||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Obtain tags from a page in the default way: parse them from the @tags@
|
||||
-- metadata field.
|
||||
-- metadata field. This can either be a list or a comma-separated string.
|
||||
getTags :: MonadMetadata m => Identifier -> m [String]
|
||||
getTags identifier = do
|
||||
metadata <- getMetadata identifier
|
||||
return $ maybe [] (map trim . splitAll ",") $ M.lookup "tags" metadata
|
||||
return $ fromMaybe [] $
|
||||
(lookupStringList "tags" metadata) `mplus`
|
||||
(map trim . splitAll "," <$> lookupString "tags" metadata)
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Obtain categories from a page.
|
||||
|
|
|
@ -31,18 +31,13 @@ module Hakyll.Web.Template.Context
|
|||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
import Control.Applicative (Alternative (..), pure, (<$>))
|
||||
import Control.Applicative (Alternative (..))
|
||||
import Control.Monad (msum)
|
||||
import Data.List (intercalate)
|
||||
import qualified Data.Map as M
|
||||
import Data.Monoid (Monoid (..))
|
||||
import Data.Time.Clock (UTCTime (..))
|
||||
import Data.Time.Format (formatTime)
|
||||
import qualified Data.Time.Format as TF
|
||||
import Data.Time.Locale.Compat (TimeLocale, defaultTimeLocale)
|
||||
import System.FilePath (splitDirectories, takeBaseName)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
import Hakyll.Core.Compiler
|
||||
import Hakyll.Core.Compiler.Internal
|
||||
import Hakyll.Core.Identifier
|
||||
|
@ -51,6 +46,7 @@ import Hakyll.Core.Metadata
|
|||
import Hakyll.Core.Provider
|
||||
import Hakyll.Core.Util.String (needlePrefix, splitAll)
|
||||
import Hakyll.Web.Html
|
||||
import System.FilePath (splitDirectories, takeBaseName)
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
@ -274,7 +270,7 @@ getItemUTC :: MonadMetadata m
|
|||
-> m UTCTime -- ^ Parsed UTCTime
|
||||
getItemUTC locale id' = do
|
||||
metadata <- getMetadata id'
|
||||
let tryField k fmt = M.lookup k metadata >>= parseTime' fmt
|
||||
let tryField k fmt = lookupString k metadata >>= parseTime' fmt
|
||||
paths = splitDirectories $ toFilePath id'
|
||||
|
||||
maybe empty' return $ msum $
|
||||
|
|
12
stack.yaml
Normal file
12
stack.yaml
Normal file
|
@ -0,0 +1,12 @@
|
|||
resolver: lts-5.11
|
||||
extra-deps: []
|
||||
extra-package-dbs: []
|
||||
|
||||
flags:
|
||||
hakyll:
|
||||
previewServer: True
|
||||
watchServer: True
|
||||
checkExternal: True
|
||||
|
||||
packages:
|
||||
- '.'
|
|
@ -5,14 +5,13 @@ module Hakyll.Core.Provider.Metadata.Tests
|
|||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
import qualified Data.HashMap.Strict as HMS
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Yaml as Yaml
|
||||
import Hakyll.Core.Metadata
|
||||
import Hakyll.Core.Provider.Metadata
|
||||
import Test.Framework (Test, testGroup)
|
||||
import Test.HUnit (Assertion, (@=?))
|
||||
import Text.Parsec as P
|
||||
import Text.Parsec.String (Parser)
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
import Hakyll.Core.Provider.Metadata
|
||||
import TestSuite.Util
|
||||
|
||||
|
||||
|
@ -22,9 +21,11 @@ tests = testGroup "Hakyll.Core.Provider.Metadata.Tests" $
|
|||
fromAssertions "page" [testPage01, testPage02]
|
||||
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
testPage01 :: Assertion
|
||||
testPage01 = testParse page ([("foo", "bar")], "qux\n")
|
||||
testPage01 =
|
||||
Right (meta [("foo", "bar")], "qux\n") @=? parsePage
|
||||
"---\n\
|
||||
\foo: bar\n\
|
||||
\---\n\
|
||||
|
@ -33,21 +34,21 @@ testPage01 = testParse page ([("foo", "bar")], "qux\n")
|
|||
|
||||
--------------------------------------------------------------------------------
|
||||
testPage02 :: Assertion
|
||||
testPage02 = testParse page
|
||||
([("description", descr)], "Hello I am dog\n")
|
||||
testPage02 =
|
||||
Right (meta [("description", descr)], "Hello I am dog\n") @=?
|
||||
parsePage
|
||||
"---\n\
|
||||
\description: A long description that would look better if it\n\
|
||||
\ spanned multiple lines and was indented\n\
|
||||
\---\n\
|
||||
\Hello I am dog\n"
|
||||
where
|
||||
descr :: String
|
||||
descr =
|
||||
"A long description that would look better if it \
|
||||
\spanned multiple lines and was indented"
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
testParse :: (Eq a, Show a) => Parser a -> a -> String -> Assertion
|
||||
testParse parser expected input = case P.parse parser "<inline>" input of
|
||||
Left err -> error $ show err
|
||||
Right x -> expected @=? x
|
||||
meta :: Yaml.ToJSON a => [(String, a)] -> Metadata
|
||||
meta pairs = HMS.fromList [(T.pack k, Yaml.toJSON v) | (k, v) <- pairs]
|
||||
|
|
|
@ -6,14 +6,11 @@ module Hakyll.Core.Provider.Tests
|
|||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
import qualified Data.Map as M
|
||||
import Hakyll.Core.Metadata
|
||||
import Hakyll.Core.Provider
|
||||
import Test.Framework (Test, testGroup)
|
||||
import Test.Framework.Providers.HUnit (testCase)
|
||||
import Test.HUnit (Assertion, assert, (@=?))
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
import Hakyll.Core.Provider
|
||||
import TestSuite.Util
|
||||
|
||||
|
||||
|
@ -32,9 +29,9 @@ case01 = do
|
|||
assert $ resourceExists provider "example.md"
|
||||
|
||||
metadata <- resourceMetadata provider "example.md"
|
||||
Just "An example" @=? M.lookup "title" metadata
|
||||
Just "External data" @=? M.lookup "external" metadata
|
||||
Just "An example" @=? lookupString "title" metadata
|
||||
Just "External data" @=? lookupString "external" metadata
|
||||
|
||||
doesntExist <- resourceMetadata provider "doesntexist.md"
|
||||
M.empty @=? doesntExist
|
||||
mempty @=? doesntExist
|
||||
cleanTestEnv
|
||||
|
|
|
@ -6,15 +6,13 @@ module Hakyll.Core.Routes.Tests
|
|||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Hakyll.Core.Identifier
|
||||
import Hakyll.Core.Metadata
|
||||
import Hakyll.Core.Routes
|
||||
import System.FilePath ((</>))
|
||||
import Test.Framework (Test, testGroup)
|
||||
import Test.HUnit (Assertion, (@=?))
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
import Hakyll.Core.Identifier
|
||||
import Hakyll.Core.Routes
|
||||
import TestSuite.Util
|
||||
|
||||
|
||||
|
@ -37,7 +35,7 @@ tests = testGroup "Hakyll.Core.Routes.Tests" $ fromAssertions "runRoutes"
|
|||
"tags/rss/bar"
|
||||
|
||||
, testRoutes "food/example.md" (metadataRoute $ \md -> customRoute $ \id' ->
|
||||
M.findWithDefault "?" "subblog" md </> toFilePath id')
|
||||
fromMaybe "?" (lookupString "subblog" md) </> toFilePath id')
|
||||
"example.md"
|
||||
]
|
||||
|
||||
|
|
|
@ -8,22 +8,19 @@ module Hakyll.Core.Rules.Tests
|
|||
--------------------------------------------------------------------------------
|
||||
import Data.IORef (IORef, newIORef, readIORef,
|
||||
writeIORef)
|
||||
import qualified Data.Map as M
|
||||
import qualified Data.Set as S
|
||||
import System.FilePath ((</>))
|
||||
import Test.Framework (Test, testGroup)
|
||||
import Test.HUnit (Assertion, assert, (@=?))
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
import Hakyll.Core.Compiler
|
||||
import Hakyll.Core.File
|
||||
import Hakyll.Core.Identifier
|
||||
import Hakyll.Core.Identifier.Pattern
|
||||
import Hakyll.Core.Metadata
|
||||
import Hakyll.Core.Routes
|
||||
import Hakyll.Core.Rules
|
||||
import Hakyll.Core.Rules.Internal
|
||||
import Hakyll.Web.Pandoc
|
||||
import System.FilePath ((</>))
|
||||
import Test.Framework (Test, testGroup)
|
||||
import Test.HUnit (Assertion, assert, (@=?))
|
||||
import TestSuite.Util
|
||||
|
||||
|
||||
|
@ -89,7 +86,7 @@ rules01 ioref = do
|
|||
compile getResourceString
|
||||
|
||||
version "metadataMatch" $
|
||||
matchMetadata "*.md" (\md -> M.lookup "subblog" md == Just "food") $ do
|
||||
matchMetadata "*.md" (\md -> lookupString "subblog" md == Just "food") $ do
|
||||
route $ customRoute $ \id' -> "food" </> toFilePath id'
|
||||
compile getResourceString
|
||||
|
||||
|
|
Loading…
Reference in a new issue