--------------------------------------------------------------------------------
{-# 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 = forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup (String -> Key
keyFromString String
key) Metadata
meta 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 =
    forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup (String -> Key
keyFromString String
key) Metadata
meta forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Maybe [Value]
Yaml.toList forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t 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' <- forall (m :: * -> *). MonadMetadata m => Pattern -> m [Identifier]
getMatches Pattern
pattern
        forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Identifier]
matches' forall a b. (a -> b) -> a -> b
$ \Identifier
id' -> do
            Metadata
metadata <- forall (m :: * -> *). MonadMetadata m => Identifier -> m Metadata
getMetadata Identifier
id'
            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 <- forall (m :: * -> *). MonadMetadata m => Identifier -> m Metadata
getMetadata Identifier
identifier
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> Metadata -> Maybe String
lookupString String
key Metadata
metadata


--------------------------------------------------------------------------------
-- | Version of 'getMetadataField' which throws an error if the field does not
-- exist.
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 <- forall (m :: * -> *).
MonadMetadata m =>
Identifier -> String -> m (Maybe String)
getMetadataField Identifier
identifier String
key
    case Maybe String
field of
        Just String
v  -> forall (m :: * -> *) a. Monad m => a -> m a
return String
v
        Maybe String
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Hakyll.Core.Metadata.getMetadataField': " forall a. [a] -> [a] -> [a]
++
            String
"Item " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Identifier
identifier forall a. [a] -> [a] -> [a]
++ String
" has no metadata field " forall a. [a] -> [a] -> [a]
++ 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' <- forall (m :: * -> *). MonadMetadata m => Pattern -> m [Identifier]
getMatches Pattern
pattern
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Pattern -> Set Identifier -> Dependency
PatternDependency Pattern
pattern (forall a. Ord a => [a] -> Set a
S.fromList [Identifier]
matches')


--------------------------------------------------------------------------------
-- | Newtype wrapper for serialization.
newtype BinaryMetadata = BinaryMetadata
    {BinaryMetadata -> Metadata
unBinaryMetadata :: Metadata}


instance Binary BinaryMetadata where
    put :: BinaryMetadata -> Put
put (BinaryMetadata Metadata
obj) = forall t. Binary t => t -> Put
put (Value -> BinaryYaml
BinaryYaml forall a b. (a -> b) -> a -> b
$ Metadata -> Value
Yaml.Object Metadata
obj)
    get :: Get BinaryMetadata
get = do
        BinaryYaml (Yaml.Object Metadata
obj) <- forall t. Binary t => Get t
get
        forall (m :: * -> *) a. Monad m => a -> m a
return 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 = forall a b. (a -> b) -> [a] -> [b]
map (\(Key
k, Value
v) -> (Key -> Text
keyToText Key
k, Value -> BinaryYaml
BinaryYaml Value
v)) forall a b. (a -> b) -> a -> b
$ forall v. KeyMap v -> [(Key, v)]
KeyMap.toList Metadata
obj
            forall t. Binary t => t -> Put
put [(Text, BinaryYaml)]
list

        Yaml.Array Array
arr -> do
            Word8 -> Put
putWord8 Word8
1
            let list :: [BinaryYaml]
list = forall a b. (a -> b) -> [a] -> [b]
map Value -> BinaryYaml
BinaryYaml (forall a. Vector a -> [a]
V.toList Array
arr) :: [BinaryYaml]
            forall t. Binary t => t -> Put
put [BinaryYaml]
list

        Yaml.String Text
s -> Word8 -> Put
putWord8 Word8
2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put Text
s
        Yaml.Number Scientific
n -> Word8 -> Put
putWord8 Word8
3 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put Scientific
n
        Yaml.Bool   Bool
b -> Word8 -> Put
putWord8 Word8
4 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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 <- forall t. Binary t => Get t
get :: Get [(T.Text, BinaryYaml)]
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> BinaryYaml
BinaryYaml forall a b. (a -> b) -> a -> b
$ Metadata -> Value
Yaml.Object forall a b. (a -> b) -> a -> b
$
                    forall v. [(Key, v)] -> KeyMap v
KeyMap.fromList forall a b. (a -> b) -> a -> b
$ 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 <- forall t. Binary t => Get t
get :: Get [BinaryYaml]
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> BinaryYaml
BinaryYaml forall a b. (a -> b) -> a -> b
$
                    Array -> Value
Yaml.Array forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Vector a
V.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map BinaryYaml -> Value
unBinaryYaml [BinaryYaml]
list

            Word8
2 -> Value -> BinaryYaml
BinaryYaml forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value
Yaml.String forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get
            Word8
3 -> Value -> BinaryYaml
BinaryYaml forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Value
Yaml.Number forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get
            Word8
4 -> Value -> BinaryYaml
BinaryYaml forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Value
Yaml.Bool   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get
            Word8
5 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> BinaryYaml
BinaryYaml Value
Yaml.Null
            Word8
_ -> 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