{-# LANGUAGE AllowAmbiguousTypes #-}
module Hakyllbars.Field
( module Hakyllbars.Field.Date,
module Hakyllbars.Field.Git,
module Hakyllbars.Field.Html,
defaultFields,
emptyString,
defaultKeys,
includeField,
layoutField,
ifField,
forField,
withField,
forEachField,
defaultField,
linkedTitleField,
metadataField,
siteUrlField,
urlField,
absUrlField,
getUrlField,
getAbsUrlField,
titleFromFileField,
teaserField,
metadataPriorityField,
namedMetadataField,
putField,
addField,
putBlockField,
addBlockField,
)
where
import Control.Monad.Except
import Data.Aeson.Key qualified as Key
import Data.Aeson.KeyMap qualified as KeyMap
import Hakyllbars.Ast
import Hakyllbars.Common
import Hakyllbars.Compiler
import Hakyllbars.Context
import Hakyllbars.Field.Date (DateConfig, dateFields, defaultDateConfigWith)
import Hakyllbars.Field.Git (gitFields)
import Hakyllbars.Field.Html (escapeHtmlField, escapeHtmlUriField)
import Hakyllbars.Util (stripSuffix)
import System.FilePath
defaultFields :: String -> String -> Context String
defaultFields :: String -> String -> Context String
defaultFields String
host String
siteRoot =
forall a. Monoid a => [a] -> a
mconcat
[ String -> Context String
bodyField String
"body",
forall v a. IntoValue v a => String -> v -> Context a
constField String
"host" String
host,
forall v a. IntoValue v a => String -> v -> Context a
constField String
"siteRoot" String
siteRoot,
forall a. String -> Context a
pathField String
"path",
forall a. String -> String -> String -> Context a
siteUrlField String
"siteUrl" String
"host" String
"siteRoot",
forall a. String -> String -> Context a
urlField String
"url" String
"siteRoot",
forall a. String -> String -> String -> Context a
absUrlField String
"absUrl" String
"host" String
"url",
forall a. String -> String -> Context a
getUrlField String
"getUrl" String
"siteRoot",
forall a. String -> String -> String -> Context a
getAbsUrlField String
"getAbsUrl" String
"host" String
"getUrl",
String -> String -> String -> Context String
linkedTitleField String
"linkedTitle" String
"title" String
"url",
Context String
escapeHtmlField,
Context String
escapeHtmlUriField,
forall a. String -> Context a
putField String
"put",
forall a. String -> Context a
addField String
"add",
forall a. String -> Context a
putBlockField String
"putBlock",
forall a. String -> Context a
addBlockField String
"addBlock",
forall a. String -> Context a
ifField String
"if",
String -> Context String
forField String
"for",
forall a. String -> Context a
defaultField String
"default",
String -> Context String
withField String
"with",
String -> Maybe String -> Maybe String -> Context String
includeField String
"include" forall a. Maybe a
Nothing forall a. Maybe a
Nothing,
String -> Maybe String -> Maybe String -> Context String
includeField String
"partial" (forall a. a -> Maybe a
Just String
"_partials") (forall a. a -> Maybe a
Just String
"html"),
String -> String -> Maybe String -> Context String
layoutField String
"applyLayout" String
"_layouts" (forall a. a -> Maybe a
Just String
"html"),
forall a. String -> [String] -> Context a
metadataPriorityField String
"updated" [String
"updated", String
"published", String
"created"],
forall a. String -> [String] -> Context a
metadataPriorityField String
"published" [String
"published", String
"created"],
forall a. Context a
metadataField,
forall a. String -> Context a
titleFromFileField String
"title",
forall v a. IntoValue v a => String -> v -> Context a
constField String
"description" (String
"" :: String)
]
emptyString :: ContextValue a
emptyString :: forall a. ContextValue a
emptyString = forall v a. IntoValue v a => v -> ContextValue a
intoValue (String
"" :: String)
defaultKeys :: [String] -> Context a
defaultKeys :: forall a. [String] -> Context a
defaultKeys [String]
keys = forall v a. IntoContext v a => v -> Context a
intoContext forall a b. (a -> b) -> a -> b
$ (,String
"" :: String) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
keys
withField :: String -> Context String
withField :: String -> Context String
withField String
key = forall v a x w.
(FromValue v a, FromValue x a, IntoValue w a) =>
String -> (v -> x -> TemplateRunner a w) -> Context a
functionField2 String
key Context String -> [Block] -> TemplateRunner String String
f
where
f :: Context String -> [Block] -> TemplateRunner String String
f (Context String
context :: Context String) ([Block]
blocks :: [Block]) =
forall a b. Context a -> TemplateRunner a b -> TemplateRunner a b
tplWithContext Context String
context do
[Block] -> TemplateRunner String String
reduceBlocks [Block]
blocks
includeField :: String -> Maybe FilePath -> Maybe FilePath -> Context String
includeField :: String -> Maybe String -> Maybe String -> Context String
includeField String
key Maybe String
basePath Maybe String
extension = forall v a w.
(FromValue v a, IntoValue w a) =>
String -> (v -> TemplateRunner a w) -> Context a
functionField String
key String
-> StateT (TemplateState String) Compiler (ContextValue String)
f
where
f :: String
-> StateT (TemplateState String) Compiler (ContextValue String)
f (String
filePath :: String) = do
String
basePath' <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. Item a -> String
itemFilePath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. TemplateRunner a (Item a)
tplItem) forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
basePath
let filePath' :: String
filePath' = String
basePath' String -> String -> String
</> String
filePath
let filePath'' :: String
filePath'' = forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
filePath' (String
filePath' String -> String -> String
<.>) Maybe String
extension
Context String
context <- forall a. TemplateRunner a (Context a)
tplContext
Identifier -> TemplateRunner String ()
applyTemplate (String -> Identifier
fromFilePath String
filePath'')
forall a. Context a -> Item a -> ContextValue a
itemValue Context String
context forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. TemplateRunner a (Item a)
tplPopItem
layoutField :: String -> FilePath -> Maybe FilePath -> Context String
layoutField :: String -> String -> Maybe String -> Context String
layoutField String
key String
basePath Maybe String
extension = forall v a x w.
(FromValue v a, FromValue x a, IntoValue w a) =>
String -> (v -> x -> TemplateRunner a w) -> Context a
functionField2 String
key String -> FunctionValue String String String
f
where
f :: String -> FunctionValue String String String
f (String
filePath :: FilePath) (String
content :: String) = do
let filePath' :: String
filePath' = String
basePath String -> String -> String
</> String
filePath
let filePath'' :: String
filePath'' = forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
filePath' (String
filePath' String -> String -> String
<.>) Maybe String
extension
let layoutId :: Identifier
layoutId = String -> Identifier
fromFilePath String
filePath''
(Template [Block]
bs String
_) <- forall a. Identifier -> TemplateRunner a Template
loadTemplate Identifier
layoutId
Item String
item <- forall a b. a -> Item b -> Item a
itemSetBody String
content forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. TemplateRunner a (Item a)
tplItem
forall a b. Item a -> TemplateRunner a b -> TemplateRunner a b
tplWithItem Item String
item do
[Block] -> TemplateRunner String String
reduceBlocks [Block]
bs
ifField :: forall a. String -> Context a
ifField :: forall a. String -> Context a
ifField String
key = forall v a w.
(FromValue v a, IntoValue w a) =>
String -> (v -> TemplateRunner a w) -> Context a
functionField String
key forall a. ContextValue a -> TemplateRunner a Bool
isTruthy
forField :: String -> Context String
forField :: String -> Context String
forField String
key = forall v a x w.
(FromValue v a, FromValue x a, IntoValue w a) =>
String -> (v -> x -> TemplateRunner a w) -> Context a
functionField2 String
key ContextValue String
-> [Block] -> TemplateRunner String (Maybe String)
applyForLoop
applyForLoop :: ContextValue String -> [Block] -> TemplateRunner String (Maybe String)
applyForLoop :: ContextValue String
-> [Block] -> TemplateRunner String (Maybe String)
applyForLoop ContextValue String
items [Block]
blocks =
ContextValue String
-> StateT
(TemplateState String) Compiler (Context String, [Item String])
getAsItems ContextValue String
items
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` (\[String]
_ -> ContextValue String
-> StateT
(TemplateState String) Compiler (Context String, [Item String])
getAsStrings ContextValue String
items)
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` (\[String]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Monoid a => a
mempty, []))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Context String
-> [Item String] -> TemplateRunner String (Maybe String)
go
where
go :: Context String
-> [Item String] -> TemplateRunner String (Maybe String)
go Context String
context [Item String]
items'
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Item String]
items' = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
| Bool
otherwise = forall a b. Context a -> TemplateRunner a b -> TemplateRunner a b
tplWithContext Context String
context do
forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Item String]
items' \Item String
item ->
forall a b. Item a -> TemplateRunner a b -> TemplateRunner a b
tplWithItem Item String
item do
[Block] -> TemplateRunner String String
reduceBlocks [Block]
blocks
getAsItems :: ContextValue String -> TemplateRunner String (Context String, [Item String])
getAsItems :: ContextValue String
-> StateT
(TemplateState String) Compiler (Context String, [Item String])
getAsItems = forall v a. FromValue v a => ContextValue a -> TemplateRunner a v
fromValue
getAsStrings :: ContextValue String -> TemplateRunner String (Context String, [Item String])
getAsStrings :: ContextValue String
-> StateT
(TemplateState String) Compiler (Context String, [Item String])
getAsStrings ContextValue String
x = do
[String]
bodies <- forall v a. FromValue v a => ContextValue a -> TemplateRunner a v
fromValue ContextValue String
x :: TemplateRunner String [String]
[Item String]
items <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [String]
bodies \String
body -> forall a b. a -> Item b -> Item a
itemSetBody String
body forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. TemplateRunner a (Item a)
tplItem
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Context String
bodyField String
"item", [Item String]
items)
forEachField :: String -> Context String
forEachField :: String -> Context String
forEachField String
key = forall v a x y w.
(FromValue v a, FromValue x a, FromValue y a, IntoValue w a) =>
String -> (v -> x -> y -> TemplateRunner a w) -> Context a
functionField3 String
key ContextValue String
-> ContextValue String
-> [Block]
-> StateT (TemplateState String) Compiler [Maybe String]
f
where
f :: ContextValue String
-> ContextValue String
-> [Block]
-> StateT (TemplateState String) Compiler [Maybe String]
f (ContextValue String
forEachKey :: ContextValue String) (ContextValue String
forEachItems :: ContextValue String) ([Block]
blocks :: [Block]) = do
String
keyId <- forall {a} {a}.
ContextValue a -> StateT (TemplateState a) Compiler String
getKey ContextValue String
forEachKey
[(ContextValue String, ContextValue String)]
keyItemPairs <- forall v a. FromValue v a => ContextValue a -> TemplateRunner a v
fromValue ContextValue String
forEachItems :: TemplateRunner String [(ContextValue String, ContextValue String)]
[(ContextValue String, ContextValue String)]
keyItemPairs forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
`forM` \(ContextValue String
key', ContextValue String
items) ->
forall a b. Context a -> TemplateRunner a b -> TemplateRunner a b
tplWithContext (forall v a. IntoValue v a => String -> v -> Context a
constField String
keyId ContextValue String
key') do
ContextValue String
-> [Block] -> TemplateRunner String (Maybe String)
applyForLoop ContextValue String
items [Block]
blocks
getKey :: ContextValue a -> StateT (TemplateState a) Compiler String
getKey ContextValue a
block = case ContextValue a
block of
UndefinedValue String
k Item a
_ [String]
_ [String]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return String
k
StringValue String
k -> forall (m :: * -> *) a. Monad m => a -> m a
return String
k
ContextValue a
_ -> forall a b. String -> TemplateRunner a b
tplFail String
"forEach: key must be a string or identifier"
defaultField :: forall a. String -> Context a
defaultField :: forall a. String -> Context a
defaultField String
key = forall v a x w.
(FromValue v a, FromValue x a, IntoValue w a) =>
String -> (v -> x -> TemplateRunner a w) -> Context a
functionField2 String
key ContextValue a
-> ContextValue a
-> StateT (TemplateState a) Compiler (ContextValue a)
f
where
f :: ContextValue a
-> ContextValue a
-> StateT (TemplateState a) Compiler (ContextValue a)
f (ContextValue a
default' :: ContextValue a) (ContextValue a
arg :: ContextValue a) =
forall a. ContextValue a -> TemplateRunner a Bool
isTruthy ContextValue a
arg forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
Bool
True -> ContextValue a
arg
Bool
False -> ContextValue a
default'
linkedTitleField :: String -> String -> String -> Context String
linkedTitleField :: String -> String -> String -> Context String
linkedTitleField String
key String
titleKey String
urlKey = forall v a. IntoValue v a => String -> v -> Context a
constField String
key FunctionValue String String String
f
where
f :: FunctionValue String String String
f :: FunctionValue String String String
f String
filePath = do
forall a b. Item a -> TemplateRunner a b -> TemplateRunner a b
tplWithItem (forall a. Identifier -> a -> Item a
Item (String -> Identifier
fromFilePath String
filePath) String
"") do
String -> String -> String
makeLink forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {b} {a}.
FromValue b a =>
String -> StateT (TemplateState a) Compiler b
getField String
titleKey forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {b} {a}.
FromValue b a =>
String -> StateT (TemplateState a) Compiler b
getField String
urlKey
where
getField :: String -> StateT (TemplateState a) Compiler b
getField String
key' = do
Context a
context <- forall a. TemplateRunner a (Context a)
tplContext
forall v a. FromValue v a => ContextValue a -> TemplateRunner a v
fromValue forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Context a -> ContextFunction a
unContext Context a
context String
key'
makeLink :: String -> String -> String
makeLink String
title String
url
| String
".html" forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
filePath = String
"<a href=\"" forall a. [a] -> [a] -> [a]
++ String -> String
escapeHtml String
url forall a. [a] -> [a] -> [a]
++ String
"\" title=\"" forall a. [a] -> [a] -> [a]
++ String -> String
escapeHtml String
title forall a. [a] -> [a] -> [a]
++ String
"\">" forall a. [a] -> [a] -> [a]
++ String -> String
escapeHtml String
title forall a. [a] -> [a] -> [a]
++ String
"</a>"
| String
".md" forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
filePath = String
"[" forall a. [a] -> [a] -> [a]
++ String
title forall a. [a] -> [a] -> [a]
++ String
"](" forall a. [a] -> [a] -> [a]
++ String
url forall a. [a] -> [a] -> [a]
++ String
" \"" forall a. [a] -> [a] -> [a]
++ String
title forall a. [a] -> [a] -> [a]
++ String
"\")"
| Bool
otherwise = String
title forall a. [a] -> [a] -> [a]
++ String
" <" forall a. [a] -> [a] -> [a]
++ String
url forall a. [a] -> [a] -> [a]
++ String
">"
metadataField :: forall a. Context a
metadataField :: forall a. Context a
metadataField = forall a. ContextFunction a -> Context a
Context forall {a}.
String -> StateT (TemplateState a) Compiler (ContextValue a)
f
where
f :: String -> StateT (TemplateState a) Compiler (ContextValue a)
f String
key = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. String -> Item a -> Compiler (ContextValue a)
getMetadataField String
key forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. TemplateRunner a (Item a)
tplItem
getMetadataField :: String -> Item a -> Compiler (ContextValue a)
getMetadataField :: forall a. String -> Item a -> Compiler (ContextValue a)
getMetadataField String
key Item a
item = do
Metadata
m <- forall (m :: * -> *). MonadMetadata m => Identifier -> m Metadata
getMetadata (forall a. Item a -> Identifier
itemIdentifier Item a
item)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(forall a. String -> Compiler a
noResult forall a b. (a -> b) -> a -> b
$ String
"tried metadata key " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
key)
(forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v a. IntoValue v a => v -> ContextValue a
intoValue)
(forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup (String -> Key
Key.fromString String
key) Metadata
m)
bodyField :: String -> Context String
bodyField :: String -> Context String
bodyField String
key = forall v a.
IntoValue v a =>
String -> (Item a -> TemplateRunner a v) -> Context a
field String
key forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Item a -> a
itemBody
siteUrlField :: String -> String -> String -> Context a
siteUrlField :: forall a. String -> String -> String -> Context a
siteUrlField String
key String
hostKey String
siteRootKey = forall v a.
IntoValue v a =>
String -> (Item a -> TemplateRunner a v) -> Context a
field String
key Item a -> StateT (TemplateState a) Compiler String
f
where
f :: Item a -> StateT (TemplateState a) Compiler String
f Item a
_ = do
Context a
context <- forall a. TemplateRunner a (Context a)
tplContext
String
host <- forall v a. FromValue v a => ContextValue a -> TemplateRunner a v
fromValue forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Context a -> ContextFunction a
unContext Context a
context String
hostKey
String
siteRoot <- forall v a. FromValue v a => ContextValue a -> TemplateRunner a v
fromValue forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Context a -> ContextFunction a
unContext Context a
context String
siteRootKey
forall (m :: * -> *) a. Monad m => a -> m a
return (String
host forall a. [a] -> [a] -> [a]
++ String
siteRoot :: String)
urlField :: String -> String -> Context a
urlField :: forall a. String -> String -> Context a
urlField String
key String
siteRootKey = forall v a.
IntoValue v a =>
String -> (Item a -> TemplateRunner a v) -> Context a
field String
key Item a -> TemplateRunner a String
f
where
f :: Item a -> TemplateRunner a String
f = forall a. String -> String -> Identifier -> TemplateRunner a String
getUri String
key String
siteRootKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Item a -> Identifier
itemIdentifier
getUrlField :: String -> String -> Context a
getUrlField :: forall a. String -> String -> Context a
getUrlField String
key String
siteRootKey = forall v a w.
(FromValue v a, IntoValue w a) =>
String -> (v -> TemplateRunner a w) -> Context a
functionField String
key String -> TemplateRunner a String
f
where
f :: String -> TemplateRunner a String
f = forall a. String -> String -> Identifier -> TemplateRunner a String
getUri String
key String
siteRootKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Identifier
fromFilePath
getUri :: String -> String -> Identifier -> TemplateRunner a String
getUri :: forall a. String -> String -> Identifier -> TemplateRunner a String
getUri String
key String
siteRootKey Identifier
id' = do
String
siteRoot <-
forall a. TemplateRunner a (Context a)
tplContext
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Context a -> ContextFunction a
unContext String
siteRootKey
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall v a. FromValue v a => ContextValue a -> TemplateRunner a v
fromValue
Maybe String
maybeRoute <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Identifier -> Compiler (Maybe String)
getRoute Identifier
id'
String
definitelyRoute <-
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"no route by " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
key forall a. [a] -> [a] -> [a]
++ String
" found for item " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Identifier
id')
(forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"/" forall a. [a] -> [a] -> [a]
++))
Maybe String
maybeRoute
let uri :: String
uri = String -> String -> String
stripSuffix String
"index.html" String
definitelyRoute
forall (m :: * -> *) a. Monad m => a -> m a
return if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
uri then String
siteRoot else String
siteRoot forall a. [a] -> [a] -> [a]
++ String
uri
absUrlField :: String -> String -> String -> Context a
absUrlField :: forall a. String -> String -> String -> Context a
absUrlField String
key String
hostKey String
urlKey = forall v a.
IntoValue v a =>
String -> (Item a -> TemplateRunner a v) -> Context a
field String
key Item a -> StateT (TemplateState a) Compiler String
f
where
f :: Item a -> StateT (TemplateState a) Compiler String
f Item a
_ = do
Context a
context <- forall a. TemplateRunner a (Context a)
tplContext
String
host <- forall v a. FromValue v a => ContextValue a -> TemplateRunner a v
fromValue forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Context a -> ContextFunction a
unContext Context a
context String
hostKey
String
url <- forall v a. FromValue v a => ContextValue a -> TemplateRunner a v
fromValue forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Context a -> ContextFunction a
unContext Context a
context String
urlKey
forall (m :: * -> *) a. Monad m => a -> m a
return (String
host forall a. [a] -> [a] -> [a]
++ String
url :: String)
getAbsUrlField :: forall a. String -> String -> String -> Context a
getAbsUrlField :: forall a. String -> String -> String -> Context a
getAbsUrlField String
key String
hostKey String
getUrlKey = forall v a w.
(FromValue v a, IntoValue w a) =>
String -> (v -> TemplateRunner a w) -> Context a
functionField String
key String -> StateT (TemplateState a) Compiler String
f
where
f :: String -> StateT (TemplateState a) Compiler String
f (String
filePath :: FilePath) = do
Context a
context <- forall a. TemplateRunner a (Context a)
tplContext
String
host <- forall v a. FromValue v a => ContextValue a -> TemplateRunner a v
fromValue forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Context a -> ContextFunction a
unContext Context a
context String
hostKey
ContextValue a -> StateT (TemplateState a) Compiler String
getUrl <- forall v a. FromValue v a => ContextValue a -> TemplateRunner a v
fromValue forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Context a -> ContextFunction a
unContext Context a
context String
getUrlKey
String
url <- ContextValue a -> StateT (TemplateState a) Compiler String
getUrl (forall v a. IntoValue v a => v -> ContextValue a
intoValue String
filePath :: ContextValue a)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
host forall a. [a] -> [a] -> [a]
++ String
url :: String)
pathField :: String -> Context a
pathField :: forall a. String -> Context a
pathField String
key = forall v a.
IntoValue v a =>
String -> (Item a -> TemplateRunner a v) -> Context a
field String
key forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> String
toFilePath forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Item a -> Identifier
itemIdentifier
titleFromFileField :: String -> Context a
titleFromFileField :: forall a. String -> Context a
titleFromFileField = forall v a w.
(FromValue v a, IntoValue w a) =>
(v -> TemplateRunner a w) -> Context a -> Context a
bindField String -> StateT (TemplateState a) Compiler String
titleFromPath forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. String -> Context a
pathField
where
titleFromPath :: String -> StateT (TemplateState a) Compiler String
titleFromPath = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
takeBaseName
teaserField :: String -> Snapshot -> Context String
teaserField :: String -> String -> Context String
teaserField String
key String
snapshot = forall v a.
IntoValue v a =>
String -> (Item a -> TemplateRunner a v) -> Context a
field String
key Item String -> TemplateRunner String String
f
where
f :: Item String -> TemplateRunner String String
f Item String
item = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift do
String
body <- forall a.
(Binary a, Typeable a) =>
Identifier -> String -> Compiler a
loadSnapshotBody (forall a. Item a -> Identifier
itemIdentifier Item String
item) String
snapshot
case String -> Maybe String
takeTeaser String
body of
Just String
teaser -> forall (m :: * -> *) a. Monad m => a -> m a
return String
teaser
Maybe String
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"item " forall a. [a] -> [a] -> [a]
++ forall a. Item a -> String
itemFilePath Item String
item forall a. [a] -> [a] -> [a]
++ String
" has no teaser"
takeTeaser :: String -> Maybe String
takeTeaser = String -> String -> Maybe String
go String
""
where
go :: String -> String -> Maybe String
go String
acc xss :: String
xss@(Char
x : String
xs)
| String
"<!--more-->" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
xss = forall a. a -> Maybe a
Just (forall a. [a] -> [a]
reverse String
acc)
| Bool
otherwise = String -> String -> Maybe String
go (Char
x forall a. a -> [a] -> [a]
: String
acc) String
xs
go String
_ [] = forall a. Maybe a
Nothing
metadataPriorityField :: String -> [String] -> Context a
metadataPriorityField :: forall a. String -> [String] -> Context a
metadataPriorityField String
key [String]
priorityKeys = forall v a.
IntoValue v a =>
String -> (Item a -> TemplateRunner a v) -> Context a
field String
key Item a -> StateT (TemplateState a) Compiler (ContextValue a)
f
where
f :: Item a -> StateT (TemplateState a) Compiler (ContextValue a)
f Item a
item =
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
(forall a. String -> Compiler a
noResult forall a b. (a -> b) -> a -> b
$ String
"Metadata priority key " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
key forall a. [a] -> [a] -> [a]
++ String
" from set " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show [String]
priorityKeys)
(forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. String -> Item a -> Compiler (ContextValue a)
getMetadataField Item a
item forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
priorityKeys)
namedMetadataField :: String -> Context String
namedMetadataField :: String -> Context String
namedMetadataField String
key = forall v a.
IntoValue v a =>
String -> (Item a -> TemplateRunner a v) -> Context a
field String
key forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. String -> Item a -> Compiler (ContextValue a)
getMetadataField String
key
putField :: String -> Context a
putField :: forall a. String -> Context a
putField String
key = forall v a w.
(FromValue v a, IntoValue w a) =>
String -> (v -> TemplateRunner a w) -> Context a
functionField String
key forall a. Context a -> TemplateRunner a ()
tplPut
addField :: forall a. String -> Context a
addField :: forall a. String -> Context a
addField String
key = forall v a x w.
(FromValue v a, FromValue x a, IntoValue w a) =>
String -> (v -> x -> TemplateRunner a w) -> Context a
functionField2 String
key String -> ContextValue a -> StateT (TemplateState a) Compiler ()
f
where
f :: String -> ContextValue a -> StateT (TemplateState a) Compiler ()
f (String
name :: String) (ContextValue a
value :: ContextValue a) = do
[ContextValue a]
current <- forall {b} {a}.
FromValue b a =>
String -> StateT (TemplateState a) Compiler b
tplGet String
name forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` \[String]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return []
forall a. Context a -> TemplateRunner a ()
tplPut forall a b. (a -> b) -> a -> b
$ forall v a. IntoValue v a => String -> v -> Context a
constField String
name (ContextValue a
value forall a. a -> [a] -> [a]
: [ContextValue a]
current)
putBlockField :: String -> Context a
putBlockField :: forall a. String -> Context a
putBlockField String
key = forall v a x w.
(FromValue v a, FromValue x a, IntoValue w a) =>
String -> (v -> x -> TemplateRunner a w) -> Context a
functionField2 String
key forall {a}. String -> [Block] -> TemplateRunner a ()
f
where
f :: String -> [Block] -> TemplateRunner a ()
f (String
name :: String) ([Block]
blocks :: [Block]) = do
forall a. Context a -> TemplateRunner a ()
tplPut forall a b. (a -> b) -> a -> b
$ forall v a. IntoValue v a => String -> v -> Context a
constField String
name [Block]
blocks
addBlockField :: String -> Context a
addBlockField :: forall a. String -> Context a
addBlockField String
key = forall v a x w.
(FromValue v a, FromValue x a, IntoValue w a) =>
String -> (v -> x -> TemplateRunner a w) -> Context a
functionField2 String
key forall {a}. String -> [Block] -> TemplateRunner a ()
f
where
f :: String -> [Block] -> StateT (TemplateState a) Compiler ()
f (String
name :: String) ([Block]
blocks :: [Block]) = do
[Block]
current <- forall {b} {a}.
FromValue b a =>
String -> StateT (TemplateState a) Compiler b
tplGet String
name forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` \[String]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return []
forall a. Context a -> TemplateRunner a ()
tplPut forall a b. (a -> b) -> a -> b
$ forall v a. IntoValue v a => String -> v -> Context a
constField String
name ([Block]
current forall a. [a] -> [a] -> [a]
++ [Block]
blocks)