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] <- 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
  forall (f :: Type -> Type). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ InlineRef
inlRef forall a. Eq a => a -> a -> Bool
== InlineRef
Link.InlineLink
  let parentR :: Maybe (R @() 'Folder)
parentR = 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)
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 forall a. Semigroup a => a -> a -> a
<> 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
  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 forall a b. (a -> b) -> a -> b
$
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Model -> RenderCtx -> Note -> Maybe (Splice Identity)
embedResourceRoute Model
model RenderCtx
ctx) (forall a b. a -> b -> a
const 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] <- 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
  forall (f :: Type -> Type). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ InlineRef
inlRef forall a. Eq a => a -> a -> Bool
== InlineRef
Link.InlineImage
  let parentR :: Maybe (R @() 'Folder)
parentR = 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)
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 forall a. Semigroup a => a -> a -> a
<> 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
  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 forall a b. (a -> b) -> a -> b
$
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) (Model -> Text -> StaticFile -> Maybe (Splice Identity)
embedStaticFileRoute Model
model 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
  forall (f :: Type -> Type). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ InlineRef
inlRef forall a. Eq a => a -> a -> Bool
== InlineRef
Link.InlineLink
  let parentR :: Maybe (R @() 'Folder)
parentR = 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)
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 forall a. Semigroup a => a -> a -> a
<> 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
  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 forall a b. (a -> b) -> a -> b
$
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) (Model -> Text -> StaticFile -> Maybe (Splice Identity)
embedStaticFileRoute Model
model forall a b. (a -> b) -> a -> b
$ 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 <- forall (m :: Type -> Type) (n :: Type -> Type).
Monad n =>
ByteString -> HeistT m n Template
HE.lookupHtmlTemplateMust forall a b. (a -> b) -> a -> b
$ ByteString
"/templates/filters/embed-" 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
  forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Splices (Splice Identity) -> Splice Identity
runEmbedTemplate ByteString
"note" forall a b. (a -> b) -> a -> b
$ do
    Text
"ema:note:title" forall k v. k -> v -> MapSyntax k v
## forall b.
(Walkable Inline b, (b :: Type) ~ ([Inline] :: Type)) =>
RenderCtx -> (b -> b) -> Title -> Splice Identity
Tit.titleSplice RenderCtx
ctx forall b. Walkable Inline b => b -> b
preparePandoc (Note -> Title
MN._noteTitle Note
note)
    Text
"ema:note:url" forall k v. k -> v -> MapSyntax k v
## forall (m :: Type -> Type) (n :: Type -> Type).
Monad m =>
Text -> HeistT n m Template
HI.textSplice (HasCallStack => Model -> SiteRoute -> Text
SR.siteRouteUrl Model
model forall a b. (a -> b) -> a -> b
$ LMLRoute -> SiteRoute
SR.lmlSiteRoute forall a b. (a -> b) -> a -> b
$ Note
note forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Lens' Note LMLRoute
MN.noteRoute)
    Text
"ema:note:pandoc" 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 forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Lens' StaticFile FilePath
SF.staticFilePath
      url :: Text
url = HasCallStack => Model -> SiteRoute -> Text
SF.siteRouteUrl Model
model forall a b. (a -> b) -> a -> b
$ StaticFile -> SiteRoute
SF.staticFileSiteRoute StaticFile
staticFile
  if
      | forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
any (Text -> Text -> Bool
`T.isSuffixOf` forall a. ToText a => a -> Text
toText FilePath
fp) [Text]
imageExts ->
          forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Splices (Splice Identity) -> Splice Identity
runEmbedTemplate ByteString
"image" forall a b. (a -> b) -> a -> b
$ do
            Text
"ema:url" forall k v. k -> v -> MapSyntax k v
## forall (m :: Type -> Type) (n :: Type -> Type).
Monad m =>
Text -> HeistT n m Template
HI.textSplice Text
url
            Text
"ema:alt" forall k v. k -> v -> MapSyntax k v
## forall (m :: Type -> Type) (n :: Type -> Type).
Monad m =>
Text -> HeistT n m Template
HI.textSplice Text
altText
      | forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
any (Text -> Text -> Bool
`T.isSuffixOf` forall a. ToText a => a -> Text
toText FilePath
fp) [Text]
videoExts -> do
          forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Splices (Splice Identity) -> Splice Identity
runEmbedTemplate ByteString
"video" forall a b. (a -> b) -> a -> b
$ do
            Text
"ema:url" forall k v. k -> v -> MapSyntax k v
## 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` forall a. ToText a => a -> Text
toText FilePath
fp -> do
          forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Splices (Splice Identity) -> Splice Identity
runEmbedTemplate ByteString
"pdf" forall a b. (a -> b) -> a -> b
$ do
            Text
"ema:url" forall k v. k -> v -> MapSyntax k v
## forall (m :: Type -> Type) (n :: Type -> Type).
Monad m =>
Text -> HeistT n m Template
HI.textSplice Text
url
      | Bool
otherwise -> 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"
  ]