{-# 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 <- forall a. a -> Compiler (Item a)
makeItem String
"dummy"
forall a.
Context a -> String -> [String] -> Item a -> Compiler ContextField
unContext Context String
ctx String
k [] Item String
i forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ContextField
cf -> case ContextField
cf of
StringField String
s -> forall (f :: * -> *) a. Applicative f => a -> f a
pure String
s
ContextField
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Error: '" forall a. Semigroup a => a -> a -> a
<> String
k 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 = forall a. Compiler a -> Compiler (Either (CompilerErrors String) a)
compilerTry (Context String -> String -> Compiler String
runContext Context String
ctx String
k) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall {a}. CompilerErrors String -> Compiler a
f forall (f :: * -> *) a. Applicative f => a -> f a
pure
where
f :: CompilerErrors String -> Compiler a
f (CompilationNoResult [String]
_) = forall a. CompilerResult a -> Compiler a
compilerResult forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CompilerErrors String -> CompilerResult a
CompilerError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> CompilerErrors a
CompilationFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
String
"missing required field '" forall a. Semigroup a => a -> a -> a
<> String
k forall a. Semigroup a => a -> a -> a
<> String
"'"
f CompilerErrors String
err = forall a. CompilerResult a -> Compiler a
compilerResult (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 = forall a. Compiler a -> Compiler (Either (CompilerErrors String) a)
compilerTry (Context String -> String -> Compiler String
runContext Context String
ctx String
k) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall {a}. CompilerErrors String -> Compiler (Maybe a)
f (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just)
where
f :: CompilerErrors String -> Compiler (Maybe a)
f (CompilationNoResult [String]
_) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
f CompilerErrors String
err = forall a. CompilerResult a -> Compiler a
compilerResult (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 (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 forall a b. (a -> b) -> a -> b
$
Key
"@context" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (String
"https://schema.org" :: String)
forall a. Semigroup a => a -> a -> a
<> Key
"@type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (String
"Article" :: String)
forall a. Semigroup a => a -> a -> a
<> Key
"headline" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
titleString
forall a. Semigroup a => a -> a -> a
<> Key
"datePublished" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
dateString
forall a. a -> Compiler (Item a)
makeItem forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
LT.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
LT.decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Encoding' a -> ByteString
encodingToLazyByteString 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 = forall a.
String -> ([String] -> Item a -> Compiler String) -> Context a
functionField String
k (\[String]
args Item String
_i -> forall {a}. (Eq a, IsString a) => [a] -> Compiler String
go [String]
args)
where
go :: [a] -> Compiler String
go [] = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ String
"<!-- Whoops! Try this instead: $if(" forall a. Semigroup a => a -> a -> a
<> String
k forall a. Semigroup a => a -> a -> a
<> String
")$$" forall a. Semigroup a => a -> a -> a
<> String
k forall a. Semigroup a => a -> a -> a
<> String
"(\"embed\")$$endif$ -->"
go [a
"raw"] = forall a. Item a -> a
itemBody 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Template -> Context a -> Item a -> Compiler (Item String)
applyTemplate Template
template (String -> Context String
bodyField String
"body")
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Item a -> a
itemBody Item String
i
go [a
_] = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"invalid argument to jsonldField '" forall a. Semigroup a => a -> a -> a
<> String
k forall a. Semigroup a => a -> a -> a
<> String
"'. use \"raw\" or \"embed\""
go [a]
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"too many arguments to jsonldField '" forall a. Semigroup a => a -> a -> a
<> String
k forall a. Semigroup a => a -> a -> a
<> String
"'"
jsonldTemplate :: Compiler Template
jsonldTemplate :: Compiler Template
jsonldTemplate = do
forall a. a -> Compiler (Item a)
makeItem String
"<script type=\"application/ld+json\">$body$</script>"
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Item String -> Compiler Template
compileTemplateItem