{-# LANGUAGE CPP #-}
module Hakyll.Core.Metadata
( Metadata
, lookupString
, lookupStringList
, MonadMetadata (..)
, getMetadataField
, getMetadataField'
, makePatternDependency
, BinaryMetadata (..)
) where
import Control.Monad (forM)
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail (MonadFail)
#endif
import Data.Binary (Binary (..), getWord8,
putWord8, Get)
#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.KeyMap as KeyMap
import qualified Data.Aeson.Key as AK
#else
import qualified Data.HashMap.Strict as KeyMap
#endif
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 = Yaml.Object
lookupString :: String -> Metadata -> Maybe String
lookupString :: String -> Metadata -> Maybe String
lookupString String
key Metadata
meta = Key -> Metadata -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup (String -> Key
keyFromString String
key) Metadata
meta Maybe Value -> (Value -> Maybe String) -> Maybe String
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Maybe String
Yaml.toString
lookupStringList :: String -> Metadata -> Maybe [String]
lookupStringList :: String -> Metadata -> Maybe [String]
lookupStringList String
key Metadata
meta =
Key -> Metadata -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup (String -> Key
keyFromString String
key) Metadata
meta Maybe Value -> (Value -> Maybe [Value]) -> Maybe [Value]
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Maybe [Value]
Yaml.toList Maybe [Value] -> ([Value] -> Maybe [String]) -> Maybe [String]
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> Maybe String) -> [Value] -> Maybe [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Value -> Maybe String
Yaml.toString
class Monad m => MonadMetadata m where
getMetadata :: Identifier -> m Metadata
getMatches :: Pattern -> m [Identifier]
getAllMetadata :: Pattern -> m [(Identifier, Metadata)]
getAllMetadata Pattern
pattern = do
[Identifier]
matches' <- Pattern -> m [Identifier]
forall (m :: * -> *). MonadMetadata m => Pattern -> m [Identifier]
getMatches Pattern
pattern
[Identifier]
-> (Identifier -> m (Identifier, Metadata))
-> m [(Identifier, Metadata)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Identifier]
matches' ((Identifier -> m (Identifier, Metadata))
-> m [(Identifier, Metadata)])
-> (Identifier -> m (Identifier, Metadata))
-> m [(Identifier, Metadata)]
forall a b. (a -> b) -> a -> b
$ \Identifier
id' -> do
Metadata
metadata <- Identifier -> m Metadata
forall (m :: * -> *). MonadMetadata m => Identifier -> m Metadata
getMetadata Identifier
id'
(Identifier, Metadata) -> m (Identifier, Metadata)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Identifier
id', Metadata
metadata)
getMetadataField :: MonadMetadata m => Identifier -> String -> m (Maybe String)
getMetadataField :: forall (m :: * -> *).
MonadMetadata m =>
Identifier -> String -> m (Maybe String)
getMetadataField Identifier
identifier String
key = do
Metadata
metadata <- Identifier -> m Metadata
forall (m :: * -> *). MonadMetadata m => Identifier -> m Metadata
getMetadata Identifier
identifier
Maybe String -> m (Maybe String)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> m (Maybe String))
-> Maybe String -> m (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Metadata -> Maybe String
lookupString String
key Metadata
metadata
getMetadataField' :: (MonadFail m, MonadMetadata m) => Identifier -> String -> m String
getMetadataField' :: forall (m :: * -> *).
(MonadFail m, MonadMetadata m) =>
Identifier -> String -> m String
getMetadataField' Identifier
identifier String
key = do
Maybe String
field <- Identifier -> String -> m (Maybe String)
forall (m :: * -> *).
MonadMetadata m =>
Identifier -> String -> m (Maybe String)
getMetadataField Identifier
identifier String
key
case Maybe String
field of
Just String
v -> String -> m String
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return String
v
Maybe String
Nothing -> String -> m String
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m String) -> String -> m String
forall a b. (a -> b) -> a -> b
$ String
"Hakyll.Core.Metadata.getMetadataField': " String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"Item " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Identifier -> String
forall a. Show a => a -> String
show Identifier
identifier String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" has no metadata field " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
key
makePatternDependency :: MonadMetadata m => Pattern -> m Dependency
makePatternDependency :: forall (m :: * -> *). MonadMetadata m => Pattern -> m Dependency
makePatternDependency Pattern
pattern = do
[Identifier]
matches' <- Pattern -> m [Identifier]
forall (m :: * -> *). MonadMetadata m => Pattern -> m [Identifier]
getMatches Pattern
pattern
Dependency -> m Dependency
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Dependency -> m Dependency) -> Dependency -> m Dependency
forall a b. (a -> b) -> a -> b
$ Pattern -> Set Identifier -> Dependency
PatternDependency Pattern
pattern ([Identifier] -> Set Identifier
forall a. Ord a => [a] -> Set a
S.fromList [Identifier]
matches')
newtype BinaryMetadata = BinaryMetadata
{BinaryMetadata -> Metadata
unBinaryMetadata :: Metadata}
instance Binary BinaryMetadata where
put :: BinaryMetadata -> Put
put (BinaryMetadata Metadata
obj) = BinaryYaml -> Put
forall t. Binary t => t -> Put
put (Value -> BinaryYaml
BinaryYaml (Value -> BinaryYaml) -> Value -> BinaryYaml
forall a b. (a -> b) -> a -> b
$ Metadata -> Value
Yaml.Object Metadata
obj)
get :: Get BinaryMetadata
get = do
BinaryYaml (Yaml.Object Metadata
obj) <- Get BinaryYaml
forall t. Binary t => Get t
get
BinaryMetadata -> Get BinaryMetadata
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (BinaryMetadata -> Get BinaryMetadata)
-> BinaryMetadata -> Get BinaryMetadata
forall a b. (a -> b) -> a -> b
$ Metadata -> BinaryMetadata
BinaryMetadata Metadata
obj
newtype BinaryYaml = BinaryYaml {BinaryYaml -> Value
unBinaryYaml :: Yaml.Value}
instance Binary BinaryYaml where
put :: BinaryYaml -> Put
put (BinaryYaml Value
yaml) = case Value
yaml of
Yaml.Object Metadata
obj -> do
Word8 -> Put
putWord8 Word8
0
let list :: [(T.Text, BinaryYaml)]
list :: [(Text, BinaryYaml)]
list = ((Key, Value) -> (Text, BinaryYaml))
-> [(Key, Value)] -> [(Text, BinaryYaml)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Key
k, Value
v) -> (Key -> Text
keyToText Key
k, Value -> BinaryYaml
BinaryYaml Value
v)) ([(Key, Value)] -> [(Text, BinaryYaml)])
-> [(Key, Value)] -> [(Text, BinaryYaml)]
forall a b. (a -> b) -> a -> b
$ Metadata -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
KeyMap.toList Metadata
obj
[(Text, BinaryYaml)] -> Put
forall t. Binary t => t -> Put
put [(Text, BinaryYaml)]
list
Yaml.Array Array
arr -> do
Word8 -> Put
putWord8 Word8
1
let list :: [BinaryYaml]
list = (Value -> BinaryYaml) -> [Value] -> [BinaryYaml]
forall a b. (a -> b) -> [a] -> [b]
map Value -> BinaryYaml
BinaryYaml (Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
arr) :: [BinaryYaml]
[BinaryYaml] -> Put
forall t. Binary t => t -> Put
put [BinaryYaml]
list
Yaml.String Text
s -> Word8 -> Put
putWord8 Word8
2 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> Put
forall t. Binary t => t -> Put
put Text
s
Yaml.Number Scientific
n -> Word8 -> Put
putWord8 Word8
3 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Scientific -> Put
forall t. Binary t => t -> Put
put Scientific
n
Yaml.Bool Bool
b -> Word8 -> Put
putWord8 Word8
4 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Put
forall t. Binary t => t -> Put
put Bool
b
Value
Yaml.Null -> Word8 -> Put
putWord8 Word8
5
get :: Get BinaryYaml
get = do
Word8
tag <- Get Word8
getWord8
case Word8
tag of
Word8
0 -> do
[(Text, BinaryYaml)]
list <- Get [(Text, BinaryYaml)]
forall t. Binary t => Get t
get :: Get [(T.Text, BinaryYaml)]
BinaryYaml -> Get BinaryYaml
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (BinaryYaml -> Get BinaryYaml) -> BinaryYaml -> Get BinaryYaml
forall a b. (a -> b) -> a -> b
$ Value -> BinaryYaml
BinaryYaml (Value -> BinaryYaml) -> Value -> BinaryYaml
forall a b. (a -> b) -> a -> b
$ Metadata -> Value
Yaml.Object (Metadata -> Value) -> Metadata -> Value
forall a b. (a -> b) -> a -> b
$
[(Key, Value)] -> Metadata
forall v. [(Key, v)] -> KeyMap v
KeyMap.fromList ([(Key, Value)] -> Metadata) -> [(Key, Value)] -> Metadata
forall a b. (a -> b) -> a -> b
$ ((Text, BinaryYaml) -> (Key, Value))
-> [(Text, BinaryYaml)] -> [(Key, Value)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
k, BinaryYaml
v) -> (Text -> Key
keyFromText Text
k, BinaryYaml -> Value
unBinaryYaml BinaryYaml
v)) [(Text, BinaryYaml)]
list
Word8
1 -> do
[BinaryYaml]
list <- Get [BinaryYaml]
forall t. Binary t => Get t
get :: Get [BinaryYaml]
BinaryYaml -> Get BinaryYaml
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (BinaryYaml -> Get BinaryYaml) -> BinaryYaml -> Get BinaryYaml
forall a b. (a -> b) -> a -> b
$ Value -> BinaryYaml
BinaryYaml (Value -> BinaryYaml) -> Value -> BinaryYaml
forall a b. (a -> b) -> a -> b
$
Array -> Value
Yaml.Array (Array -> Value) -> Array -> Value
forall a b. (a -> b) -> a -> b
$ [Value] -> Array
forall a. [a] -> Vector a
V.fromList ([Value] -> Array) -> [Value] -> Array
forall a b. (a -> b) -> a -> b
$ (BinaryYaml -> Value) -> [BinaryYaml] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map BinaryYaml -> Value
unBinaryYaml [BinaryYaml]
list
Word8
2 -> Value -> BinaryYaml
BinaryYaml (Value -> BinaryYaml) -> (Text -> Value) -> Text -> BinaryYaml
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value
Yaml.String (Text -> BinaryYaml) -> Get Text -> Get BinaryYaml
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Text
forall t. Binary t => Get t
get
Word8
3 -> Value -> BinaryYaml
BinaryYaml (Value -> BinaryYaml)
-> (Scientific -> Value) -> Scientific -> BinaryYaml
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Value
Yaml.Number (Scientific -> BinaryYaml) -> Get Scientific -> Get BinaryYaml
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Scientific
forall t. Binary t => Get t
get
Word8
4 -> Value -> BinaryYaml
BinaryYaml (Value -> BinaryYaml) -> (Bool -> Value) -> Bool -> BinaryYaml
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Value
Yaml.Bool (Bool -> BinaryYaml) -> Get Bool -> Get BinaryYaml
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Bool
forall t. Binary t => Get t
get
Word8
5 -> BinaryYaml -> Get BinaryYaml
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (BinaryYaml -> Get BinaryYaml) -> BinaryYaml -> Get BinaryYaml
forall a b. (a -> b) -> a -> b
$ Value -> BinaryYaml
BinaryYaml Value
Yaml.Null
Word8
_ -> String -> Get BinaryYaml
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Data.Binary.get: Invalid Binary Metadata"
#if MIN_VERSION_aeson(2,0,0)
keyFromString :: String -> AK.Key
keyFromString :: String -> Key
keyFromString = String -> Key
AK.fromString
keyToText :: AK.Key -> T.Text
keyToText :: Key -> Text
keyToText = Key -> Text
AK.toText
keyFromText :: T.Text -> AK.Key
keyFromText :: Text -> Key
keyFromText = Text -> Key
AK.fromText
#else
keyFromString :: String -> T.Text
keyFromString = T.pack
keyToText :: T.Text -> T.Text
keyToText = id
keyFromText :: T.Text -> T.Text
keyFromText = id
#endif