{-# 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

-- | The default recommended fields to use for your website templates.
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)
    ]

-- | An empty string context value.
emptyString :: ContextValue a
emptyString :: forall a. ContextValue a
emptyString = forall v a. IntoValue v a => v -> ContextValue a
intoValue (String
"" :: String)

-- | A context with the given keys and empty string values.
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

-- | Sets a scope in which the given fields are active in the context.
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

-- | Includes the given file in the template.
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

-- | Sets a layout to interpolate the template into.
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

-- | Conditionally renders a block.
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

-- | Context field for iterating over a list of items.
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

-- | Iterates over a list of items, applying their context to the given block.
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

-- | Gets a context value as a list of items.
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

-- | Gets a context value as a list of strings.
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 -- allow identifier as key
      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"

-- | Gets a default context value if none is provided.
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'

-- | Creates a link with the title to the given item.
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)

-- | The body of the current item.
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

-- | The absolute url to the site root.
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)

-- | The url path to the given item.
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

-- | Gets the url path to the given item file path.
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

-- | Gets the uri to the given item identifier.
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

-- | Gets the absolute url to the current item.
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)

-- | Gets the absolute url to the given item file path.
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)

-- | Gets the destination path to the current item.
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

-- | Gets the title of the current item from the file name.
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

-- | Extracts the teaser from the current item.
--
-- The teaser is noted in the item body with the HTML comment `<!--more-->`. All
-- content preceding this comment is considered the teaser.
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

-- | Gets the value of the first metadata key that exists.
metadataPriorityField ::
  -- | The context key.
  String ->
  -- | The list of metadata keys to try in order of priority.
  [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)

-- | Puts a block of content into the context by a given name.
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

-- | Adds a block of content to the given context collection identified by a name.
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)