module Heist.Extra where

import Data.Text qualified as T
import Heist qualified as H
import Heist.Internal.Types qualified as HT
import Heist.Interpreted qualified as HI
import Text.XmlHtml qualified as X

-- | Useful for running a splice against an arbitrary node (such as that pulled from pandoc.tpl)
runCustomNode :: X.Node -> H.Splices (HI.Splice Identity) -> HI.Splice Identity
runCustomNode :: Node -> Splices (Splice Identity) -> Splice Identity
runCustomNode Node
node Splices (Splice Identity)
splices =
  (HeistState Identity -> HeistState Identity)
-> Splice Identity -> Splice Identity
forall (m :: Type -> Type) (n :: Type -> Type) a.
Monad m =>
(HeistState n -> HeistState n) -> HeistT n m a -> HeistT n m a
H.localHS (Splices (Splice Identity)
-> HeistState Identity -> HeistState Identity
forall (n :: Type -> Type).
Splices (Splice n) -> HeistState n -> HeistState n
HI.bindSplices Splices (Splice Identity)
splices) (Splice Identity -> Splice Identity)
-> Splice Identity -> Splice Identity
forall a b. (a -> b) -> a -> b
$ do
    Node -> Splice Identity
forall (n :: Type -> Type). Monad n => Node -> Splice n
HI.runNode Node
node Splice Identity -> (Template -> Template) -> Splice Identity
forall (f :: Type -> Type) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
      [Node
resNode]
        | Node -> Text
X.elementTag Node
resNode Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Node -> Text
X.elementTag Node
node ->
            -- Get rid of the `node` itself.
            Node -> Template
X.elementChildren Node
resNode
      Template
res ->
        Template
res

runCustomTemplate :: HT.Template -> H.Splices (HI.Splice Identity) -> HI.Splice Identity
runCustomTemplate :: Template -> Splices (Splice Identity) -> Splice Identity
runCustomTemplate Template
nodes Splices (Splice Identity)
splices =
  (HeistState Identity -> HeistState Identity)
-> Splice Identity -> Splice Identity
forall (m :: Type -> Type) (n :: Type -> Type) a.
Monad m =>
(HeistState n -> HeistState n) -> HeistT n m a -> HeistT n m a
H.localHS (Splices (Splice Identity)
-> HeistState Identity -> HeistState Identity
forall (n :: Type -> Type).
Splices (Splice n) -> HeistState n -> HeistState n
HI.bindSplices Splices (Splice Identity)
splices) (Splice Identity -> Splice Identity)
-> Splice Identity -> Splice Identity
forall a b. (a -> b) -> a -> b
$ do
    Template -> Splice Identity
forall (n :: Type -> Type). Monad n => Template -> Splice n
HI.runNodeList Template
nodes

lookupHtmlTemplate :: Monad n => ByteString -> HT.HeistT m n (Maybe HT.Template)
lookupHtmlTemplate :: forall (n :: Type -> Type) (m :: Type -> Type).
Monad n =>
ByteString -> HeistT m n (Maybe Template)
lookupHtmlTemplate ByteString
name = do
  HeistState m
st <- HeistT m n (HeistState m)
forall (m :: Type -> Type) (n :: Type -> Type).
Monad m =>
HeistT n m (HeistState n)
HT.getHS
  Maybe Template -> HeistT m n (Maybe Template)
forall a. a -> HeistT m n a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Maybe Template -> HeistT m n (Maybe Template))
-> Maybe Template -> HeistT m n (Maybe Template)
forall a b. (a -> b) -> a -> b
$ do
    X.HtmlDocument Encoding
_ Maybe DocType
_ Template
nodes <- DocumentFile -> Document
H.dfDoc (DocumentFile -> Document)
-> ((DocumentFile, TPath) -> DocumentFile)
-> (DocumentFile, TPath)
-> Document
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DocumentFile, TPath) -> DocumentFile
forall a b. (a, b) -> a
fst ((DocumentFile, TPath) -> Document)
-> Maybe (DocumentFile, TPath) -> Maybe Document
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString
-> HeistState m
-> (HeistState m -> HashMap TPath DocumentFile)
-> Maybe (DocumentFile, TPath)
forall (n :: Type -> Type) t.
ByteString
-> HeistState n
-> (HeistState n -> HashMap TPath t)
-> Maybe (t, TPath)
H.lookupTemplate ByteString
name HeistState m
st HeistState m -> HashMap TPath DocumentFile
forall (m :: Type -> Type).
HeistState m -> HashMap TPath DocumentFile
HT._templateMap
    Template -> Maybe Template
forall a. a -> Maybe a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Template
nodes

lookupHtmlTemplateMust :: forall m n. Monad n => ByteString -> HT.HeistT m n HT.Template
lookupHtmlTemplateMust :: forall (m :: Type -> Type) (n :: Type -> Type).
Monad n =>
ByteString -> HeistT m n Template
lookupHtmlTemplateMust ByteString
name =
  ByteString -> HeistT m n (Maybe Template)
forall (n :: Type -> Type) (m :: Type -> Type).
Monad n =>
ByteString -> HeistT m n (Maybe Template)
lookupHtmlTemplate ByteString
name HeistT m n (Maybe Template)
-> (Maybe Template -> HeistT m n Template) -> HeistT m n Template
forall a b. HeistT m n a -> (a -> HeistT m n b) -> HeistT m n b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe Template
Nothing -> do
      HeistState m
st <- HeistT m n (HeistState m)
forall (m :: Type -> Type) (n :: Type -> Type).
Monad m =>
HeistT n m (HeistState n)
HT.getHS
      Text -> HeistT m n Template
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> HeistT m n Template) -> Text -> HeistT m n Template
forall a b. (a -> b) -> a -> b
$ Text
"heist: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 ByteString
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" not found ... among: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
", " (HeistState m -> [Text]
forall (n :: Type -> Type). HeistState n -> [Text]
availableTemplates HeistState m
st)
    Just Template
tpl ->
      Template -> HeistT m n Template
forall a. a -> HeistT m n a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Template
tpl

availableTemplates :: HT.HeistState n -> [Text]
availableTemplates :: forall (n :: Type -> Type). HeistState n -> [Text]
availableTemplates HeistState n
st =
  [Text] -> [Text]
forall a. Ord a => [a] -> [a]
sort ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ HeistState n -> [TPath]
forall (m :: Type -> Type). HeistState m -> [TPath]
H.templateNames HeistState n
st [TPath] -> (TPath -> Text) -> [Text]
forall (f :: Type -> Type) a b. Functor f => f a -> (a -> b) -> f b
<&> Text -> [Text] -> Text
T.intercalate Text
"/" ([Text] -> Text) -> (TPath -> [Text]) -> TPath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
forall a. [a] -> [a]
reverse ([Text] -> [Text]) -> (TPath -> [Text]) -> TPath -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Text) -> TPath -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 @Text)