module Emanote.Pandoc.Renderer.Query
  ( queryResolvingSplice,
    noteSpliceMap,
  )
where

import Data.List qualified as List
import Data.Map.Syntax ((##))
import Data.Text qualified as T
import Emanote.Model (Model)
import Emanote.Model.Note qualified as MN
import Emanote.Model.Query qualified as Q
import Emanote.Model.Title qualified as Tit
import Emanote.Pandoc.BuiltinFilters (preparePandoc)
import Emanote.Pandoc.Renderer (PandocBlockRenderer)
import Emanote.Route (LMLRoute)
import Emanote.Route.SiteRoute qualified as SR
import Heist qualified as H
import Heist.Extra qualified as HE
import Heist.Extra.Splices.Pandoc (RenderCtx)
import Heist.Interpreted qualified as HI
import Heist.Splices.Json qualified as HJ
import Optics.Operators ((^.))
import Relude
import Text.Pandoc.Definition qualified as B

queryResolvingSplice :: PandocBlockRenderer Model LMLRoute
queryResolvingSplice :: PandocBlockRenderer Model LMLRoute
queryResolvingSplice Model
model PandocRenderers Model LMLRoute
_nr RenderCtx
ctx LMLRoute
noteRoute Block
blk = do
  B.CodeBlock
    (Text
_id', [Text]
classes, [(Text, Text)]
_attrs)
    (Text -> Maybe Query
Q.parseQuery -> Just Query
q) <-
    Block -> Maybe Block
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Block
blk
  Bool -> Maybe ()
forall (f :: Type -> Type). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
List.elem Text
"query" [Text]
classes
  let mOtherCls :: Maybe Text
mOtherCls = [Text] -> Maybe (NonEmpty Text)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty (Text -> [Text] -> [Text]
forall a. Eq a => a -> [a] -> [a]
List.delete Text
"query" [Text]
classes) Maybe (NonEmpty Text) -> (NonEmpty Text -> Text) -> Maybe Text
forall (f :: Type -> Type) a b. Functor f => f a -> (a -> b) -> f b
<&> Text -> [Text] -> Text
T.intercalate Text
" " ([Text] -> Text)
-> (NonEmpty Text -> [Text]) -> NonEmpty Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Text -> [Text]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList
      queryTpl :: ByteString
queryTpl = Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text
"/templates/filters/query-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"default" Maybe Text
mOtherCls
  Splice Identity -> Maybe (Splice Identity)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Splice Identity -> Maybe (Splice Identity))
-> Splice Identity -> Maybe (Splice Identity)
forall a b. (a -> b) -> a -> b
$ do
    Template
tpl <- ByteString -> Splice Identity
forall (m :: Type -> Type) (n :: Type -> Type).
Monad n =>
ByteString -> HeistT m n Template
HE.lookupHtmlTemplateMust ByteString
queryTpl
    Template -> Splices (Splice Identity) -> Splice Identity
HE.runCustomTemplate Template
tpl (Splices (Splice Identity) -> Splice Identity)
-> Splices (Splice Identity) -> Splice Identity
forall a b. (a -> b) -> a -> b
$ do
      Text
"query" Text -> Splice Identity -> Splices (Splice Identity)
forall k v. k -> v -> MapSyntax k v
##
        Text -> Splice Identity
forall (m :: Type -> Type) (n :: Type -> Type).
Monad m =>
Text -> HeistT n m Template
HI.textSplice (Query -> Text
forall b a. (Show a, IsString b) => a -> b
show Query
q)
      Text
"result" Text -> Splice Identity -> Splices (Splice Identity)
forall k v. k -> v -> MapSyntax k v
##
        (Splices (Splice Identity) -> Splice Identity
forall (n :: Type -> Type).
Monad n =>
Splices (Splice n) -> Splice n
HI.runChildrenWith (Splices (Splice Identity) -> Splice Identity)
-> (Note -> Splices (Splice Identity)) -> Note -> Splice Identity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((RenderCtx -> Splice Identity) -> Splice Identity)
-> Model -> Note -> Splices (Splice Identity)
noteSpliceMap ((RenderCtx -> Splice Identity) -> RenderCtx -> Splice Identity
forall a b. (a -> b) -> a -> b
$ RenderCtx
ctx) Model
model) (Note -> Splice Identity) -> [Note] -> Splice Identity
forall b (m :: Type -> Type) (f :: Type -> Type) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
`foldMapM` LMLRoute -> Model -> Query -> [Note]
Q.runQuery LMLRoute
noteRoute Model
model Query
q

-- TODO: Reuse this elsewhere
noteSpliceMap ::
  ((RenderCtx -> HI.Splice Identity) -> HI.Splice Identity) ->
  Model ->
  MN.Note ->
  H.Splices (HI.Splice Identity)
noteSpliceMap :: ((RenderCtx -> Splice Identity) -> Splice Identity)
-> Model -> Note -> Splices (Splice Identity)
noteSpliceMap (RenderCtx -> Splice Identity) -> Splice Identity
withCtx Model
model Note
note = do
  Text
"ema:note:title" Text -> Splice Identity -> Splices (Splice Identity)
forall k v. k -> v -> MapSyntax k v
## (RenderCtx -> Splice Identity) -> Splice Identity
withCtx ((RenderCtx -> Splice Identity) -> Splice Identity)
-> (RenderCtx -> Splice Identity) -> Splice Identity
forall a b. (a -> b) -> a -> b
$ \RenderCtx
ctx -> RenderCtx -> ([Inline] -> [Inline]) -> Title -> Splice Identity
forall b.
(Walkable Inline b, (b :: Type) ~ ([Inline] :: Type)) =>
RenderCtx -> (b -> b) -> Title -> Splice Identity
Tit.titleSplice RenderCtx
ctx [Inline] -> [Inline]
forall b. Walkable Inline b => b -> b
preparePandoc (Note -> Title
MN._noteTitle Note
note)
  Text
"ema:note:url" Text -> Splice Identity -> Splices (Splice Identity)
forall k v. k -> v -> MapSyntax k v
## Text -> Splice Identity
forall (m :: Type -> Type) (n :: Type -> Type).
Monad m =>
Text -> HeistT n m Template
HI.textSplice (HasCallStack => Model -> SiteRoute -> Text
Model -> SiteRoute -> Text
SR.siteRouteUrl Model
model (SiteRoute -> Text) -> SiteRoute -> Text
forall a b. (a -> b) -> a -> b
$ LMLRoute -> SiteRoute
SR.lmlSiteRoute (LMLRoute -> SiteRoute) -> LMLRoute -> SiteRoute
forall a b. (a -> b) -> a -> b
$ Note
note Note -> Optic' A_Lens NoIx Note LMLRoute -> LMLRoute
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Note LMLRoute
MN.noteRoute)
  Text
"ema:note:metadata" Text -> Splice Identity -> Splices (Splice Identity)
forall k v. k -> v -> MapSyntax k v
## Value -> Splice Identity
forall a (n :: Type -> Type). (ToJSON a, Monad n) => a -> Splice n
HJ.bindJson (Note
note Note -> Optic' A_Lens NoIx Note Value -> Value
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Note Value
MN.noteMeta)