{-# LANGUAGE OverloadedStrings #-}
module Hakyll.Web.Meta.JSONLD
( jsonldField
) where
import Data.Aeson ((.=), pairs)
import Data.Aeson.Encoding (encodingToLazyByteString)
import qualified Data.Text.Lazy as LT
import qualified Data.Text.Lazy.Encoding as LT
import Hakyll.Core.Compiler
import Hakyll.Core.Compiler.Internal
import Hakyll.Core.Item
import Hakyll.Web.Template
import Hakyll.Web.Template.Context
runContext :: Context String -> String -> Compiler String
runContext :: Context String -> String -> Compiler String
runContext Context String
ctx String
k = do
Item String
i <- String -> Compiler (Item String)
forall a. a -> Compiler (Item a)
makeItem String
"dummy"
Context String
-> String -> [String] -> Item String -> Compiler ContextField
forall a.
Context a -> String -> [String] -> Item a -> Compiler ContextField
unContext Context String
ctx String
k [] Item String
i Compiler ContextField
-> (ContextField -> Compiler String) -> Compiler String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ContextField
cf -> case ContextField
cf of
StringField String
s -> String -> Compiler String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
s
ContextField
_ -> String -> Compiler String
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Compiler String) -> String -> Compiler String
forall a b. (a -> b) -> a -> b
$ String
"Error: '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
k String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"' is not a StringField"
getContext :: Context String -> String -> Compiler String
getContext :: Context String -> String -> Compiler String
getContext Context String
ctx String
k = Compiler String -> Compiler (Either (CompilerErrors String) String)
forall a. Compiler a -> Compiler (Either (CompilerErrors String) a)
compilerTry (Context String -> String -> Compiler String
runContext Context String
ctx String
k) Compiler (Either (CompilerErrors String) String)
-> (Either (CompilerErrors String) String -> Compiler String)
-> Compiler String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CompilerErrors String -> Compiler String)
-> (String -> Compiler String)
-> Either (CompilerErrors String) String
-> Compiler String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either CompilerErrors String -> Compiler String
forall a. CompilerErrors String -> Compiler a
f String -> Compiler String
forall (f :: * -> *) a. Applicative f => a -> f a
pure
where
f :: CompilerErrors String -> Compiler a
f (CompilationNoResult [String]
_) = CompilerResult a -> Compiler a
forall a. CompilerResult a -> Compiler a
compilerResult (CompilerResult a -> Compiler a)
-> (String -> CompilerResult a) -> String -> Compiler a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompilerErrors String -> CompilerResult a
forall a. CompilerErrors String -> CompilerResult a
CompilerError (CompilerErrors String -> CompilerResult a)
-> (String -> CompilerErrors String) -> String -> CompilerResult a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty String -> CompilerErrors String
forall a. NonEmpty a -> CompilerErrors a
CompilationFailure (NonEmpty String -> CompilerErrors String)
-> (String -> NonEmpty String) -> String -> CompilerErrors String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> NonEmpty String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Compiler a) -> String -> Compiler a
forall a b. (a -> b) -> a -> b
$
String
"missing required field '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
k String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"'"
f CompilerErrors String
err = CompilerResult a -> Compiler a
forall a. CompilerResult a -> Compiler a
compilerResult (CompilerErrors String -> CompilerResult a
forall a. CompilerErrors String -> CompilerResult a
CompilerError CompilerErrors String
err)
_lookupContext :: Context String -> String -> Compiler (Maybe String)
_lookupContext :: Context String -> String -> Compiler (Maybe String)
_lookupContext Context String
ctx String
k = Compiler String -> Compiler (Either (CompilerErrors String) String)
forall a. Compiler a -> Compiler (Either (CompilerErrors String) a)
compilerTry (Context String -> String -> Compiler String
runContext Context String
ctx String
k) Compiler (Either (CompilerErrors String) String)
-> (Either (CompilerErrors String) String
-> Compiler (Maybe String))
-> Compiler (Maybe String)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CompilerErrors String -> Compiler (Maybe String))
-> (String -> Compiler (Maybe String))
-> Either (CompilerErrors String) String
-> Compiler (Maybe String)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either CompilerErrors String -> Compiler (Maybe String)
forall a. CompilerErrors String -> Compiler (Maybe a)
f (Maybe String -> Compiler (Maybe String)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe String -> Compiler (Maybe String))
-> (String -> Maybe String) -> String -> Compiler (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
forall a. a -> Maybe a
Just)
where
f :: CompilerErrors String -> Compiler (Maybe a)
f (CompilationNoResult [String]
_) = Maybe a -> Compiler (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
f CompilerErrors String
err = CompilerResult (Maybe a) -> Compiler (Maybe a)
forall a. CompilerResult a -> Compiler a
compilerResult (CompilerErrors String -> CompilerResult (Maybe a)
forall a. CompilerErrors String -> CompilerResult a
CompilerError CompilerErrors String
err)
renderJSONLD :: Context String -> Compiler (Item String)
renderJSONLD :: Context String -> Compiler (Item String)
renderJSONLD Context String
ctx = do
String
dateString <- Context String -> String -> Compiler String
getContext (String -> String -> Context String
forall a. String -> String -> Context a
dateField String
"" String
"%Y-%m-%dT%H:%M:%S") String
""
String
titleString <- Context String -> String -> Compiler String
getContext Context String
ctx String
"title"
let
obj :: Encoding
obj = Series -> Encoding
pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
Text
"@context" Text -> String -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (String
"https://schema.org" :: String)
Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Text
"@type" Text -> String -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (String
"Article" :: String)
Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Text
"headline" Text -> String -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
titleString
Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Text
"datePublished" Text -> String -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
dateString
String -> Compiler (Item String)
forall a. a -> Compiler (Item a)
makeItem (String -> Compiler (Item String))
-> (Encoding -> String) -> Encoding -> Compiler (Item String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
LT.unpack (Text -> String) -> (Encoding -> Text) -> Encoding -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
LT.decodeUtf8 (ByteString -> Text)
-> (Encoding -> ByteString) -> Encoding -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoding -> ByteString
forall a. Encoding' a -> ByteString
encodingToLazyByteString (Encoding -> Compiler (Item String))
-> Encoding -> Compiler (Item String)
forall a b. (a -> b) -> a -> b
$ Encoding
obj
jsonldField :: String -> Context String -> Context String
jsonldField :: String -> Context String -> Context String
jsonldField String
k Context String
ctx = String
-> ([String] -> Item String -> Compiler String) -> Context String
forall a.
String -> ([String] -> Item a -> Compiler String) -> Context a
functionField String
k (\[String]
args Item String
_i -> [String] -> Compiler String
forall a. (Eq a, IsString a) => [a] -> Compiler String
go [String]
args)
where
go :: [a] -> Compiler String
go [] = String -> Compiler String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Compiler String) -> String -> Compiler String
forall a b. (a -> b) -> a -> b
$ String
"<!-- Whoops! Try this instead: $if(" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
k String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
")$$" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
k String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"(\"embed\")$$endif$ -->"
go [a
"raw"] = Item String -> String
forall a. Item a -> a
itemBody (Item String -> String)
-> Compiler (Item String) -> Compiler String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Context String -> Compiler (Item String)
renderJSONLD Context String
ctx
go [a
"embed"] = do
Template
template <- Compiler Template
jsonldTemplate
Item String
i <- Context String -> Compiler (Item String)
renderJSONLD Context String
ctx Compiler (Item String)
-> (Item String -> Compiler (Item String))
-> Compiler (Item String)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Template -> Context String -> Item String -> Compiler (Item String)
forall a. Template -> Context a -> Item a -> Compiler (Item String)
applyTemplate Template
template (String -> Context String
bodyField String
"body")
String -> Compiler String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Compiler String) -> String -> Compiler String
forall a b. (a -> b) -> a -> b
$ Item String -> String
forall a. Item a -> a
itemBody Item String
i
go [a
_] = String -> Compiler String
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Compiler String) -> String -> Compiler String
forall a b. (a -> b) -> a -> b
$ String
"invalid argument to jsonldField '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
k String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"'. use \"raw\" or \"embed\""
go [a]
_ = String -> Compiler String
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Compiler String) -> String -> Compiler String
forall a b. (a -> b) -> a -> b
$ String
"too many arguments to jsonldField '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
k String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"'"
jsonldTemplate :: Compiler Template
jsonldTemplate :: Compiler Template
jsonldTemplate = do
String -> Compiler (Item String)
forall a. a -> Compiler (Item a)
makeItem String
"<script type=\"application/ld+json\">$body$</script>"
Compiler (Item String)
-> (Item String -> Compiler Template) -> Compiler Template
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Item String -> Compiler Template
compileTemplateItem