git.iko.soy/hakyll
on c7a1069 help sign in
hakyll/src/Hakyll/Core/Metadata.hs
138 lines 5.0 kB history raw
1--------------------------------------------------------------------------------
2module Hakyll.Core.Metadata
3 ( Metadata
4 , lookupString
5 , lookupStringList
7 , MonadMetadata (..)
8 , getMetadataField
9 , getMetadataField'
10 , makePatternDependency
12 , BinaryMetadata (..)
13 ) where
16--------------------------------------------------------------------------------
17import Control.Arrow (second)
18import Control.Monad (forM)
19import Data.Binary (Binary (..), getWord8,
20 putWord8, Get)
21import qualified Data.HashMap.Strict as HMS
22import qualified Data.Set as S
23import qualified Data.Text as T
24import qualified Data.Vector as V
25import qualified Data.Yaml.Extended as Yaml
26import Hakyll.Core.Dependencies
27import Hakyll.Core.Identifier
28import Hakyll.Core.Identifier.Pattern
31--------------------------------------------------------------------------------
32type Metadata = Yaml.Object
35--------------------------------------------------------------------------------
36lookupString :: String -> Metadata -> Maybe String
37lookupString key meta = HMS.lookup (T.pack key) meta >>= Yaml.toString
40--------------------------------------------------------------------------------
41lookupStringList :: String -> Metadata -> Maybe [String]
42lookupStringList key meta =
43 HMS.lookup (T.pack key) meta >>= Yaml.toList >>= mapM Yaml.toString
46--------------------------------------------------------------------------------
47class Monad m => MonadMetadata m where
48 getMetadata :: Identifier -> m Metadata
49 getMatches :: Pattern -> m [Identifier]
51 getAllMetadata :: Pattern -> m [(Identifier, Metadata)]
52 getAllMetadata pattern = do
53 matches' <- getMatches pattern
54 forM matches' $ \id' -> do
55 metadata <- getMetadata id'
56 return (id', metadata)
59--------------------------------------------------------------------------------
60getMetadataField :: MonadMetadata m => Identifier -> String -> m (Maybe String)
61getMetadataField identifier key = do
62 metadata <- getMetadata identifier
63 return $ lookupString key metadata
66--------------------------------------------------------------------------------
67-- | Version of 'getMetadataField' which throws an error if the field does not
68-- exist.
69getMetadataField' :: MonadMetadata m => Identifier -> String -> m String
70getMetadataField' identifier key = do
71 field <- getMetadataField identifier key
72 case field of
73 Just v -> return v
74 Nothing -> fail $ "Hakyll.Core.Metadata.getMetadataField': " ++
75 "Item " ++ show identifier ++ " has no metadata field " ++ show key
78--------------------------------------------------------------------------------
79makePatternDependency :: MonadMetadata m => Pattern -> m Dependency
80makePatternDependency pattern = do
81 matches' <- getMatches pattern
82 return $ PatternDependency pattern (S.fromList matches')
85--------------------------------------------------------------------------------
86-- | Newtype wrapper for serialization.
87newtype BinaryMetadata = BinaryMetadata
88 {unBinaryMetadata :: Metadata}
91instance Binary BinaryMetadata where
92 put (BinaryMetadata obj) = put (BinaryYaml $ Yaml.Object obj)
93 get = do
94 BinaryYaml (Yaml.Object obj) <- get
95 return $ BinaryMetadata obj
98--------------------------------------------------------------------------------
99newtype BinaryYaml = BinaryYaml {unBinaryYaml :: Yaml.Value}
102--------------------------------------------------------------------------------
103instance Binary BinaryYaml where
104 put (BinaryYaml yaml) = case yaml of
105 Yaml.Object obj -> do
106 putWord8 0
107 let list :: [(T.Text, BinaryYaml)]
108 list = map (second BinaryYaml) $ HMS.toList obj
109 put list
111 Yaml.Array arr -> do
112 putWord8 1
113 let list = map BinaryYaml (V.toList arr) :: [BinaryYaml]
114 put list
116 Yaml.String s -> putWord8 2 >> put s
117 Yaml.Number n -> putWord8 3 >> put n
118 Yaml.Bool b -> putWord8 4 >> put b
119 Yaml.Null -> putWord8 5
121 get = do
122 tag <- getWord8
123 case tag of
124 0 -> do
125 list <- get :: Get [(T.Text, BinaryYaml)]
126 return $ BinaryYaml $ Yaml.Object $
127 HMS.fromList $ map (second unBinaryYaml) list
129 1 -> do
130 list <- get :: Get [BinaryYaml]
131 return $ BinaryYaml $
132 Yaml.Array $ V.fromList $ map unBinaryYaml list
134 2 -> BinaryYaml . Yaml.String <$> get
135 3 -> BinaryYaml . Yaml.Number <$> get
136 4 -> BinaryYaml . Yaml.Bool <$> get
137 5 -> return $ BinaryYaml Yaml.Null
138 _ -> fail "Data.Binary.get: Invalid Binary Metadata"