module Emanote.Pandoc.Renderer.Embed where

import Commonmark.Extensions.WikiLink qualified as WL
import Data.Map.Syntax ((##))
import Data.Text qualified as T
import Emanote.Model (Model)
import Emanote.Model.Link.Rel qualified as Rel
import Emanote.Model.Link.Resolve qualified as Resolve
import Emanote.Model.Note qualified as MN
import Emanote.Model.StaticFile qualified as SF
import Emanote.Model.Title qualified as Tit
import Emanote.Pandoc.BuiltinFilters (prepareNoteDoc, preparePandoc)
import Emanote.Pandoc.Link qualified as Link
import Emanote.Pandoc.Renderer (PandocBlockRenderer, PandocInlineRenderer)
import Emanote.Pandoc.Renderer.Url qualified as RenderedUrl
import Emanote.Route.ModelRoute qualified as R
import Emanote.Route.R qualified as R
import Emanote.Route.SiteRoute qualified as SF
import Emanote.Route.SiteRoute qualified as SR
import Heist qualified as H
import Heist.Extra qualified as HE
import Heist.Extra.Splices.Pandoc (pandocSplice)
import Heist.Extra.Splices.Pandoc qualified as HP
import Heist.Interpreted qualified as HI
import Optics.Operators ((^.))
import Relude
import Text.Pandoc.Definition qualified as B

embedBlockWikiLinkResolvingSplice :: PandocBlockRenderer Model R.LMLRoute
embedBlockWikiLinkResolvingSplice :: PandocBlockRenderer Model LMLRoute
embedBlockWikiLinkResolvingSplice Model
model PandocRenderers Model LMLRoute
_nf RenderCtx
ctx LMLRoute
noteRoute Block
node = do
  B.Para [Inline
inl] <- Block -> Maybe Block
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Block
node
  (InlineRef
inlRef, (Text
_, [Text]
_, [(Text, Text)]
otherAttrs), [Inline]
is, (Text
url, Text
tit)) <- Inline -> Maybe (InlineRef, Attr, [Inline], (Text, Text))
Link.parseInlineRef Inline
inl
  Bool -> Maybe ()
forall (f :: Type -> Type). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ InlineRef
inlRef InlineRef -> InlineRef -> Bool
forall a. Eq a => a -> a -> Bool
== InlineRef
Link.InlineLink
  let parentR :: Maybe (R @() 'Folder)
parentR = (forall (lmlType :: LML).
 HasExt @SourceExt ('LMLType lmlType) =>
 R @SourceExt ('LMLType lmlType) -> Maybe (R @() 'Folder))
-> LMLRoute -> Maybe (R @() 'Folder)
forall r.
(forall (lmlType :: LML).
 HasExt @SourceExt ('LMLType lmlType) =>
 R @SourceExt ('LMLType lmlType) -> r)
-> LMLRoute -> r
R.withLmlRoute forall {a} (ext :: FileType a). R @a ext -> Maybe (R @() 'Folder)
forall (lmlType :: LML).
HasExt @SourceExt ('LMLType lmlType) =>
R @SourceExt ('LMLType lmlType) -> Maybe (R @() 'Folder)
R.routeParent LMLRoute
noteRoute
  -- TODO: Use anchor to embed a section?
  (Rel.URTWikiLink (WikiLinkType
WL.WikiLinkEmbed, WikiLink
wl), Maybe Anchor
_mAnchor) <-
    Maybe (R @() 'Folder)
-> [(Text, Text)]
-> Text
-> Maybe (UnresolvedRelTarget, Maybe Anchor)
Rel.parseUnresolvedRelTarget Maybe (R @() 'Folder)
parentR ([(Text, Text)]
otherAttrs [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<> OneItem [(Text, Text)] -> [(Text, Text)]
forall x. One x => OneItem x -> x
one (Text
"title", Text
tit)) Text
url
  let rRel :: ResolvedRelTarget (Either Note StaticFile)
rRel = Model -> WikiLink -> ResolvedRelTarget (Either Note StaticFile)
Resolve.resolveWikiLinkMustExist Model
model WikiLink
wl
  (Either Note StaticFile -> SiteRoute)
-> ([Inline], (Text, Text))
-> ResolvedRelTarget (Either Note StaticFile)
-> Model
-> RenderCtx
-> Inline
-> (Either Note StaticFile -> Maybe (Splice Identity))
-> Maybe (Splice Identity)
forall a.
(a -> SiteRoute)
-> ([Inline], (Text, Text))
-> ResolvedRelTarget a
-> Model
-> RenderCtx
-> Inline
-> (a -> Maybe (Splice Identity))
-> Maybe (Splice Identity)
RenderedUrl.renderSomeInlineRefWith Either Note StaticFile -> SiteRoute
Resolve.resourceSiteRoute ([Inline]
is, (Text
url, Text
tit)) ResolvedRelTarget (Either Note StaticFile)
rRel Model
model RenderCtx
ctx Inline
inl ((Either Note StaticFile -> Maybe (Splice Identity))
 -> Maybe (Splice Identity))
-> (Either Note StaticFile -> Maybe (Splice Identity))
-> Maybe (Splice Identity)
forall a b. (a -> b) -> a -> b
$
    (Note -> Maybe (Splice Identity))
-> (StaticFile -> Maybe (Splice Identity))
-> Either Note StaticFile
-> Maybe (Splice Identity)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Model -> RenderCtx -> Note -> Maybe (Splice Identity)
embedResourceRoute Model
model RenderCtx
ctx) (Maybe (Splice Identity) -> StaticFile -> Maybe (Splice Identity)
forall a b. a -> b -> a
const Maybe (Splice Identity)
forall a. Maybe a
Nothing)

embedBlockRegularLinkResolvingSplice :: PandocBlockRenderer Model R.LMLRoute
embedBlockRegularLinkResolvingSplice :: PandocBlockRenderer Model LMLRoute
embedBlockRegularLinkResolvingSplice Model
model PandocRenderers Model LMLRoute
_nf RenderCtx
ctx LMLRoute
noteRoute Block
node = do
  B.Para [Inline
inl] <- Block -> Maybe Block
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Block
node
  (InlineRef
inlRef, (Text
_, [Text]
_, [(Text, Text)]
otherAttrs), [Inline]
is, (Text
url, Text
tit)) <- Inline -> Maybe (InlineRef, Attr, [Inline], (Text, Text))
Link.parseInlineRef Inline
inl
  Bool -> Maybe ()
forall (f :: Type -> Type). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ InlineRef
inlRef InlineRef -> InlineRef -> Bool
forall a. Eq a => a -> a -> Bool
== InlineRef
Link.InlineImage
  let parentR :: Maybe (R @() 'Folder)
parentR = (forall (lmlType :: LML).
 HasExt @SourceExt ('LMLType lmlType) =>
 R @SourceExt ('LMLType lmlType) -> Maybe (R @() 'Folder))
-> LMLRoute -> Maybe (R @() 'Folder)
forall r.
(forall (lmlType :: LML).
 HasExt @SourceExt ('LMLType lmlType) =>
 R @SourceExt ('LMLType lmlType) -> r)
-> LMLRoute -> r
R.withLmlRoute forall {a} (ext :: FileType a). R @a ext -> Maybe (R @() 'Folder)
forall (lmlType :: LML).
HasExt @SourceExt ('LMLType lmlType) =>
R @SourceExt ('LMLType lmlType) -> Maybe (R @() 'Folder)
R.routeParent LMLRoute
noteRoute
  (Rel.URTResource ModelRoute
mr, Maybe Anchor
_mAnchor) <-
    Maybe (R @() 'Folder)
-> [(Text, Text)]
-> Text
-> Maybe (UnresolvedRelTarget, Maybe Anchor)
Rel.parseUnresolvedRelTarget Maybe (R @() 'Folder)
parentR ([(Text, Text)]
otherAttrs [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<> OneItem [(Text, Text)] -> [(Text, Text)]
forall x. One x => OneItem x -> x
one (Text
"title", Text
tit)) Text
url
  let rRel :: ResolvedRelTarget (Either Note StaticFile)
rRel = Model -> ModelRoute -> ResolvedRelTarget (Either Note StaticFile)
Resolve.resolveModelRoute Model
model ModelRoute
mr
  (Either Note StaticFile -> SiteRoute)
-> ([Inline], (Text, Text))
-> ResolvedRelTarget (Either Note StaticFile)
-> Model
-> RenderCtx
-> Inline
-> (Either Note StaticFile -> Maybe (Splice Identity))
-> Maybe (Splice Identity)
forall a.
(a -> SiteRoute)
-> ([Inline], (Text, Text))
-> ResolvedRelTarget a
-> Model
-> RenderCtx
-> Inline
-> (a -> Maybe (Splice Identity))
-> Maybe (Splice Identity)
RenderedUrl.renderSomeInlineRefWith Either Note StaticFile -> SiteRoute
Resolve.resourceSiteRoute ([Inline]
is, (Text
url, Text
tit)) ResolvedRelTarget (Either Note StaticFile)
rRel Model
model RenderCtx
ctx Inline
inl ((Either Note StaticFile -> Maybe (Splice Identity))
 -> Maybe (Splice Identity))
-> (Either Note StaticFile -> Maybe (Splice Identity))
-> Maybe (Splice Identity)
forall a b. (a -> b) -> a -> b
$
    (Note -> Maybe (Splice Identity))
-> (StaticFile -> Maybe (Splice Identity))
-> Either Note StaticFile
-> Maybe (Splice Identity)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe (Splice Identity) -> Note -> Maybe (Splice Identity)
forall a b. a -> b -> a
const Maybe (Splice Identity)
forall a. Maybe a
Nothing) (Model -> Text -> StaticFile -> Maybe (Splice Identity)
embedStaticFileRoute Model
model (Text -> StaticFile -> Maybe (Splice Identity))
-> Text -> StaticFile -> Maybe (Splice Identity)
forall a b. (a -> b) -> a -> b
$ [Inline] -> Text
WL.plainify [Inline]
is)

embedInlineWikiLinkResolvingSplice :: PandocInlineRenderer Model R.LMLRoute
embedInlineWikiLinkResolvingSplice :: PandocInlineRenderer Model LMLRoute
embedInlineWikiLinkResolvingSplice Model
model PandocRenderers Model LMLRoute
_nf RenderCtx
ctx LMLRoute
noteRoute Inline
inl = do
  (InlineRef
inlRef, (Text
_, [Text]
_, [(Text, Text)]
otherAttrs), [Inline]
is, (Text
url, Text
tit)) <- Inline -> Maybe (InlineRef, Attr, [Inline], (Text, Text))
Link.parseInlineRef Inline
inl
  Bool -> Maybe ()
forall (f :: Type -> Type). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ InlineRef
inlRef InlineRef -> InlineRef -> Bool
forall a. Eq a => a -> a -> Bool
== InlineRef
Link.InlineLink
  let parentR :: Maybe (R @() 'Folder)
parentR = (forall (lmlType :: LML).
 HasExt @SourceExt ('LMLType lmlType) =>
 R @SourceExt ('LMLType lmlType) -> Maybe (R @() 'Folder))
-> LMLRoute -> Maybe (R @() 'Folder)
forall r.
(forall (lmlType :: LML).
 HasExt @SourceExt ('LMLType lmlType) =>
 R @SourceExt ('LMLType lmlType) -> r)
-> LMLRoute -> r
R.withLmlRoute forall {a} (ext :: FileType a). R @a ext -> Maybe (R @() 'Folder)
forall (lmlType :: LML).
HasExt @SourceExt ('LMLType lmlType) =>
R @SourceExt ('LMLType lmlType) -> Maybe (R @() 'Folder)
R.routeParent LMLRoute
noteRoute
  (Rel.URTWikiLink (WikiLinkType
WL.WikiLinkEmbed, WikiLink
wl), Maybe Anchor
_mAnchor) <- Maybe (R @() 'Folder)
-> [(Text, Text)]
-> Text
-> Maybe (UnresolvedRelTarget, Maybe Anchor)
Rel.parseUnresolvedRelTarget Maybe (R @() 'Folder)
parentR ([(Text, Text)]
otherAttrs [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<> OneItem [(Text, Text)] -> [(Text, Text)]
forall x. One x => OneItem x -> x
one (Text
"title", Text
tit)) Text
url
  let rRel :: ResolvedRelTarget (Either Note StaticFile)
rRel = Model -> WikiLink -> ResolvedRelTarget (Either Note StaticFile)
Resolve.resolveWikiLinkMustExist Model
model WikiLink
wl
  (Either Note StaticFile -> SiteRoute)
-> ([Inline], (Text, Text))
-> ResolvedRelTarget (Either Note StaticFile)
-> Model
-> RenderCtx
-> Inline
-> (Either Note StaticFile -> Maybe (Splice Identity))
-> Maybe (Splice Identity)
forall a.
(a -> SiteRoute)
-> ([Inline], (Text, Text))
-> ResolvedRelTarget a
-> Model
-> RenderCtx
-> Inline
-> (a -> Maybe (Splice Identity))
-> Maybe (Splice Identity)
RenderedUrl.renderSomeInlineRefWith Either Note StaticFile -> SiteRoute
Resolve.resourceSiteRoute ([Inline]
is, (Text
url, Text
tit)) ResolvedRelTarget (Either Note StaticFile)
rRel Model
model RenderCtx
ctx Inline
inl ((Either Note StaticFile -> Maybe (Splice Identity))
 -> Maybe (Splice Identity))
-> (Either Note StaticFile -> Maybe (Splice Identity))
-> Maybe (Splice Identity)
forall a b. (a -> b) -> a -> b
$
    (Note -> Maybe (Splice Identity))
-> (StaticFile -> Maybe (Splice Identity))
-> Either Note StaticFile
-> Maybe (Splice Identity)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe (Splice Identity) -> Note -> Maybe (Splice Identity)
forall a b. a -> b -> a
const Maybe (Splice Identity)
forall a. Maybe a
Nothing) (Model -> Text -> StaticFile -> Maybe (Splice Identity)
embedStaticFileRoute Model
model (Text -> StaticFile -> Maybe (Splice Identity))
-> Text -> StaticFile -> Maybe (Splice Identity)
forall a b. (a -> b) -> a -> b
$ WikiLink -> Text
forall b a. (Show a, IsString b) => a -> b
show WikiLink
wl)

runEmbedTemplate :: ByteString -> H.Splices (HI.Splice Identity) -> HI.Splice Identity
runEmbedTemplate :: ByteString -> Splices (Splice Identity) -> Splice Identity
runEmbedTemplate ByteString
name Splices (Splice Identity)
splices = do
  Template
tpl <- ByteString -> Splice Identity
forall (m :: Type -> Type) (n :: Type -> Type).
Monad n =>
ByteString -> HeistT m n Template
HE.lookupHtmlTemplateMust (ByteString -> Splice Identity) -> ByteString -> Splice Identity
forall a b. (a -> b) -> a -> b
$ ByteString
"/templates/filters/embed-" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
name
  Template -> Splices (Splice Identity) -> Splice Identity
HE.runCustomTemplate Template
tpl Splices (Splice Identity)
splices

embedResourceRoute :: Model -> HP.RenderCtx -> MN.Note -> Maybe (HI.Splice Identity)
embedResourceRoute :: Model -> RenderCtx -> Note -> Maybe (Splice Identity)
embedResourceRoute Model
model RenderCtx
ctx Note
note = do
  Splice Identity -> Maybe (Splice Identity)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Splice Identity -> Maybe (Splice Identity))
-> (Splices (Splice Identity) -> Splice Identity)
-> Splices (Splice Identity)
-> Maybe (Splice Identity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Splices (Splice Identity) -> Splice Identity
runEmbedTemplate ByteString
"note" (Splices (Splice Identity) -> Maybe (Splice Identity))
-> Splices (Splice Identity) -> Maybe (Splice Identity)
forall a b. (a -> b) -> a -> b
$ do
    Text
"ema:note:title" Text -> Splice Identity -> Splices (Splice Identity)
forall k v. k -> v -> MapSyntax k v
## 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:pandoc" Text -> Splice Identity -> Splices (Splice Identity)
forall k v. k -> v -> MapSyntax k v
##
      RenderCtx -> Pandoc -> Splice Identity
pandocSplice RenderCtx
ctx (Note -> Pandoc
prepareNoteDoc Note
note)

embedStaticFileRoute :: Model -> Text -> SF.StaticFile -> Maybe (HI.Splice Identity)
embedStaticFileRoute :: Model -> Text -> StaticFile -> Maybe (Splice Identity)
embedStaticFileRoute Model
model Text
altText StaticFile
staticFile = do
  let fp :: FilePath
fp = StaticFile
staticFile StaticFile -> Optic' A_Lens NoIx StaticFile FilePath -> FilePath
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx StaticFile FilePath
SF.staticFilePath
      url :: Text
url = HasCallStack => Model -> SiteRoute -> Text
Model -> SiteRoute -> Text
SF.siteRouteUrl Model
model (SiteRoute -> Text) -> SiteRoute -> Text
forall a b. (a -> b) -> a -> b
$ StaticFile -> SiteRoute
SF.staticFileSiteRoute StaticFile
staticFile
  if
      | (Text -> Bool) -> [Text] -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
any (Text -> Text -> Bool
`T.isSuffixOf` FilePath -> Text
forall a. ToText a => a -> Text
toText FilePath
fp) [Text]
imageExts ->
          Splice Identity -> Maybe (Splice Identity)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Splice Identity -> Maybe (Splice Identity))
-> (Splices (Splice Identity) -> Splice Identity)
-> Splices (Splice Identity)
-> Maybe (Splice Identity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Splices (Splice Identity) -> Splice Identity
runEmbedTemplate ByteString
"image" (Splices (Splice Identity) -> Maybe (Splice Identity))
-> Splices (Splice Identity) -> Maybe (Splice Identity)
forall a b. (a -> b) -> a -> b
$ do
            Text
"ema: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 Text
url
            Text
"ema:alt" 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 Text
altText
      | (Text -> Bool) -> [Text] -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
any (Text -> Text -> Bool
`T.isSuffixOf` FilePath -> Text
forall a. ToText a => a -> Text
toText FilePath
fp) [Text]
videoExts -> do
          Splice Identity -> Maybe (Splice Identity)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Splice Identity -> Maybe (Splice Identity))
-> (Splices (Splice Identity) -> Splice Identity)
-> Splices (Splice Identity)
-> Maybe (Splice Identity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Splices (Splice Identity) -> Splice Identity
runEmbedTemplate ByteString
"video" (Splices (Splice Identity) -> Maybe (Splice Identity))
-> Splices (Splice Identity) -> Maybe (Splice Identity)
forall a b. (a -> b) -> a -> b
$ do
            Text
"ema: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 Text
url
      | Text
".pdf" Text -> Text -> Bool
`T.isSuffixOf` FilePath -> Text
forall a. ToText a => a -> Text
toText FilePath
fp -> do
          Splice Identity -> Maybe (Splice Identity)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Splice Identity -> Maybe (Splice Identity))
-> (Splices (Splice Identity) -> Splice Identity)
-> Splices (Splice Identity)
-> Maybe (Splice Identity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Splices (Splice Identity) -> Splice Identity
runEmbedTemplate ByteString
"pdf" (Splices (Splice Identity) -> Maybe (Splice Identity))
-> Splices (Splice Identity) -> Maybe (Splice Identity)
forall a b. (a -> b) -> a -> b
$ do
            Text
"ema: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 Text
url
      | Bool
otherwise -> Maybe (Splice Identity)
forall a. Maybe a
Nothing

imageExts :: [Text]
imageExts :: [Text]
imageExts =
  [ Text
".jpg",
    Text
".jpeg",
    Text
".png",
    Text
".svg",
    Text
".gif",
    Text
".bmp",
    Text
".webp"
  ]

videoExts :: [Text]
videoExts :: [Text]
videoExts =
  [ Text
".mp4",
    Text
".webm",
    Text
".ogv"
  ]