module Emanote.Pandoc.Renderer.Url (
  urlResolvingSplice,
  plainifyWikiLinkSplice,
  renderSomeInlineRefWith,
) where

import Commonmark.Extensions.WikiLink qualified as WL
import Data.Text qualified as T
import Emanote.Model (Model)
import Emanote.Model qualified as M
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.Title qualified as Tit
import Emanote.Pandoc.Link qualified as Link
import Emanote.Pandoc.Renderer (PandocInlineRenderer)
import Emanote.Route qualified as R
import Emanote.Route.SiteRoute qualified as SR
import Heist.Extra.Splices.Pandoc qualified as HP
import Heist.Extra.Splices.Pandoc qualified as Splices
import Heist.Extra.Splices.Pandoc.Ctx (ctxSansCustomSplicing)
import Heist.Interpreted qualified as HI
import Optics.Core (review)
import Relude
import Text.Pandoc.Definition qualified as B
import Text.Pandoc.Walk qualified as W

-- | Resolve all URLs in inlines (<a> and <img>)
urlResolvingSplice :: PandocInlineRenderer Model R.LMLRoute
urlResolvingSplice :: PandocInlineRenderer Model LMLRoute
urlResolvingSplice Model
model PandocRenderers Model LMLRoute
_nf (RenderCtx -> RenderCtx
ctxSansCustomSplicing -> RenderCtx
ctx) LMLRoute
noteRoute Inline
inl = do
  (InlineRef
inlRef, attr :: Attr
attr@(Text
id', [Text]
cls, [(Text, Text)]
otherAttrs), [Inline]
is, (Text
url, Text
tit)) <- Inline -> Maybe (InlineRef, Attr, [Inline], (Text, Text))
Link.parseInlineRef Inline
inl
  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
  (UnresolvedRelTarget
uRel, 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 SiteRoute
rRel = Model -> UnresolvedRelTarget -> ResolvedRelTarget SiteRoute
Resolve.resolveUnresolvedRelTarget Model
model UnresolvedRelTarget
uRel
  forall a.
(a -> SiteRoute)
-> ([Inline], (Text, Text))
-> ResolvedRelTarget a
-> Model
-> RenderCtx
-> Inline
-> (a -> Maybe (Splice Identity))
-> Maybe (Splice Identity)
renderSomeInlineRefWith forall a. a -> a
id ([Inline]
is, (Text
url, Text
tit)) ResolvedRelTarget SiteRoute
rRel Model
model RenderCtx
ctx Inline
inl forall a b. (a -> b) -> a -> b
$ \SiteRoute
sr ->
    case InlineRef
inlRef of
      InlineRef
Link.InlineLink -> do
        -- TODO: If uRel is `Rel.URTWikiLink (WL.WikiLinkEmbed, _)`, *and* it appears
        -- in B.Para (so do this in block-level custom splice), then embed it.
        -- We don't do this here, as this inline splice can't embed block elements.
        let ([Inline]
newIs, (Text
newUrl', Bool
isNotEmaLink)) = HasCallStack =>
Model -> SiteRoute -> ([Inline], Text) -> ([Inline], (Text, Bool))
replaceLinkNodeWithRoute Model
model SiteRoute
sr ([Inline]
is, Text
url)
            newOtherAttrs :: [(Text, Text)]
newOtherAttrs = [(Text, Text)]
otherAttrs forall a. Semigroup a => a -> a -> a
<> [(Text, Text)
openInNewTabAttr | Model -> Bool
M.inLiveServer Model
model Bool -> Bool -> Bool
&& Bool
isNotEmaLink]
            newAttr :: Attr
newAttr = (Text
id', [Text]
cls, [(Text, Text)]
newOtherAttrs)
            newUrl :: Text
newUrl = Text
newUrl' forall a. Semigroup a => a -> a -> a
<> Maybe Anchor -> Text
WL.anchorSuffix Maybe Anchor
mAnchor
        forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ RenderCtx -> Inline -> Splice Identity
HP.rpInline RenderCtx
ctx forall a b. (a -> b) -> a -> b
$ Attr -> [Inline] -> (Text, Text) -> Inline
B.Link Attr
newAttr [Inline]
newIs (Text
newUrl, Text
tit)
      InlineRef
Link.InlineImage -> do
        let ([Inline]
newIs, (Text
newUrl, Bool
_)) =
              HasCallStack =>
Model -> SiteRoute -> ([Inline], Text) -> ([Inline], (Text, Bool))
replaceLinkNodeWithRoute Model
model SiteRoute
sr (forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ Text -> [Inline] -> NonEmpty Inline
nonEmptyInlines Text
url [Inline]
is, Text
url)
        forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ RenderCtx -> Inline -> Splice Identity
HP.rpInline RenderCtx
ctx forall a b. (a -> b) -> a -> b
$ Attr -> [Inline] -> (Text, Text) -> Inline
B.Image Attr
attr [Inline]
newIs (Text
newUrl, Text
tit)

openInNewTabAttr :: (Text, Text)
openInNewTabAttr :: (Text, Text)
openInNewTabAttr =
  (Text
"target", Text
"_blank")

renderSomeInlineRefWith ::
  (a -> SR.SiteRoute) ->
  -- | AST Node attributes of @InlineRef@
  ([B.Inline], (Text, Text)) ->
  Rel.ResolvedRelTarget a ->
  Model ->
  Splices.RenderCtx ->
  B.Inline ->
  (a -> Maybe (HI.Splice Identity)) ->
  Maybe (HI.Splice Identity)
renderSomeInlineRefWith :: forall a.
(a -> SiteRoute)
-> ([Inline], (Text, Text))
-> ResolvedRelTarget a
-> Model
-> RenderCtx
-> Inline
-> (a -> Maybe (Splice Identity))
-> Maybe (Splice Identity)
renderSomeInlineRefWith a -> SiteRoute
getSr ([Inline]
is, (Text
url, Text
tit)) ResolvedRelTarget a
rRel Model
model (RenderCtx -> RenderCtx
ctxSansCustomSplicing -> RenderCtx
ctx) Inline
origInl a -> Maybe (Splice Identity)
f = do
  case ResolvedRelTarget a
rRel of
    ResolvedRelTarget a
Rel.RRTMissing -> do
      forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ do
        Template
raw <-
          RenderCtx -> Inline -> Splice Identity
HP.rpInline
            RenderCtx
ctx
            ( Text -> [Inline] -> Inline
tooltip
                Text
"Link is broken"
                [ [Inline] -> Inline
B.Strikeout forall a b. (a -> b) -> a -> b
$ forall x. One x => OneItem x -> x
one forall a b. (a -> b) -> a -> b
$ Text -> Inline
B.Str forall a b. (a -> b) -> a -> b
$ HasCallStack => Inline -> Text
Link.unParseLink Inline
origInl
                , Text -> Inline
B.Str Text
"❌"
                ]
            )
        Template
details <-
          RenderCtx -> Inline -> Splice Identity
HP.rpInline RenderCtx
ctx forall a b. (a -> b) -> a -> b
$
            -- FIXME: This aside is meaningless for non-wikilink links (regular
            -- Markdown links)
            Attr -> [Inline] -> Inline
B.Span (Text
"", [Text
"emanote:error:aside"], []) forall a b. (a -> b) -> a -> b
$
              forall x. One x => OneItem x -> x
one forall a b. (a -> b) -> a -> b
$
                Text -> [Inline] -> Inline
tooltip Text
"Find notes containing this broken link" forall a b. (a -> b) -> a -> b
$
                  forall x. One x => OneItem x -> x
one forall a b. (a -> b) -> a -> b
$
                    Attr -> [Inline] -> (Text, Text) -> Inline
B.Link Attr
B.nullAttr (forall x. One x => OneItem x -> x
one forall a b. (a -> b) -> a -> b
$ [Inline] -> Inline
B.Emph forall a b. (a -> b) -> a -> b
$ forall x. One x => OneItem x -> x
one forall a b. (a -> b) -> a -> b
$ Text -> Inline
B.Str Text
"backlinks") (Text
url, Text
"")
        if Model -> Bool
M.inLiveServer Model
model
          then forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Template
raw forall a. Semigroup a => a -> a -> a
<> Template
details
          else forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Template
raw
    Rel.RRTAmbiguous NonEmpty a
srs -> do
      forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ do
        Template
raw <- RenderCtx -> Inline -> Splice Identity
HP.rpInline RenderCtx
ctx (Text -> [Inline] -> Inline
tooltip Text
"Link is ambiguous" [[Inline] -> Inline
B.Strikeout forall a b. (a -> b) -> a -> b
$ forall x. One x => OneItem x -> x
one forall a b. (a -> b) -> a -> b
$ Text -> Inline
B.Str forall a b. (a -> b) -> a -> b
$ HasCallStack => Inline -> Text
Link.unParseLink Inline
origInl, Text -> Inline
B.Str Text
"❗"])
        Template
candidates <-
          forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall a b. (a -> b) -> a -> b
$
            forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList NonEmpty a
srs
              forall (f :: Type -> Type) a b. Functor f => f a -> (a -> b) -> f b
<&> \(a -> SiteRoute
getSr -> SiteRoute
sr) -> do
                let (Prism' FilePath SiteRoute
rp, ModelEma
_) = Model -> (Prism' FilePath SiteRoute, ModelEma)
M.withoutRoutePrism Model
model
                    srRoute :: Text
srRoute = forall a. ToText a => a -> Text
toText forall a b. (a -> b) -> a -> b
$ forall k (is :: IxList) t b.
Is k A_Review =>
Optic' k is t b -> b -> t
review Prism' FilePath SiteRoute
rp SiteRoute
sr
                    ([Inline]
_newIs, (Text
newUrl, Bool
isNotEmaLink)) = HasCallStack =>
Model -> SiteRoute -> ([Inline], Text) -> ([Inline], (Text, Bool))
replaceLinkNodeWithRoute Model
model SiteRoute
sr ([Inline]
is, Text
srRoute)
                    linkAttr :: [(Text, Text)]
linkAttr = [(Text, Text)
openInNewTabAttr | Model -> Bool
M.inLiveServer Model
model Bool -> Bool -> Bool
&& Bool
isNotEmaLink]
                    newIs :: [Inline]
newIs = forall x. One x => OneItem x -> x
one forall a b. (a -> b) -> a -> b
$ Text -> Inline
B.Str forall a b. (a -> b) -> a -> b
$ forall b a. (Show a, IsString b) => a -> b
show SiteRoute
sr
                RenderCtx -> Inline -> Splice Identity
HP.rpInline RenderCtx
ctx forall a b. (a -> b) -> a -> b
$
                  Attr -> [Inline] -> Inline
B.Span (Text
"", [Text
"emanote:error:aside"], []) forall a b. (a -> b) -> a -> b
$
                    forall x. One x => OneItem x -> x
one forall a b. (a -> b) -> a -> b
$
                      Text -> [Inline] -> Inline
tooltip (forall b a. (Show a, IsString b) => a -> b
show SiteRoute
sr forall a. Semigroup a => a -> a -> a
<> Text
" -> " forall a. Semigroup a => a -> a -> a
<> Text
srRoute) forall a b. (a -> b) -> a -> b
$
                        forall x. One x => OneItem x -> x
one forall a b. (a -> b) -> a -> b
$
                          Attr -> [Inline] -> (Text, Text) -> Inline
B.Link (Text
"", forall a. Monoid a => a
mempty, [(Text, Text)]
linkAttr) [Inline]
newIs (Text
newUrl, Text
tit)
        if Model -> Bool
M.inLiveServer Model
model
          then forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Template
raw forall a. Semigroup a => a -> a -> a
<> Template
candidates
          else forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Template
raw
    Rel.RRTFound a
sr -> do
      a -> Maybe (Splice Identity)
f a
sr
  where
    tooltip :: Text -> [B.Inline] -> B.Inline
    tooltip :: Text -> [Inline] -> Inline
tooltip Text
s = Attr -> [Inline] -> Inline
B.Span (Text
"", [], forall x. One x => OneItem x -> x
one (Text
"title", Text
s))

plainifyWikiLinkSplice :: PandocInlineRenderer Model R.LMLRoute
plainifyWikiLinkSplice :: PandocInlineRenderer Model LMLRoute
plainifyWikiLinkSplice Model
_model PandocRenderers Model LMLRoute
_nf (RenderCtx -> RenderCtx
ctxSansCustomSplicing -> RenderCtx
ctx) LMLRoute
_ Inline
inl = do
  Text
s <- Inline -> Maybe Text
WL.wikiLinkInlineRendered Inline
inl
  forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ RenderCtx -> Inline -> Splice Identity
HP.rpInline RenderCtx
ctx forall a b. (a -> b) -> a -> b
$ Text -> Inline
B.Str Text
s

inlinesWithWikiLinksPlainified :: [B.Inline] -> [B.Inline]
inlinesWithWikiLinksPlainified :: [Inline] -> [Inline]
inlinesWithWikiLinksPlainified = forall a b. Walkable a b => (a -> a) -> b -> b
W.walk forall a b. (a -> b) -> a -> b
$ \case
  (Inline -> Maybe Text
WL.wikiLinkInlineRendered -> Just Text
s) ->
    Text -> Inline
B.Str Text
s
  Inline
x -> Inline
x

replaceLinkNodeWithRoute ::
  HasCallStack =>
  Model ->
  SR.SiteRoute ->
  ([B.Inline], Text) ->
  ([B.Inline], (Text, Bool))
replaceLinkNodeWithRoute :: HasCallStack =>
Model -> SiteRoute -> ([Inline], Text) -> ([Inline], (Text, Bool))
replaceLinkNodeWithRoute Model
model SiteRoute
r ([Inline]
inner, Text
url) =
  ( [Inline] -> [Inline]
inlinesWithWikiLinksPlainified forall a b. (a -> b) -> a -> b
$ Model -> Text -> Maybe SiteRoute -> [Inline] -> [Inline]
nonEmptyLinkInlines Model
model Text
url (forall a. a -> Maybe a
Just SiteRoute
r) [Inline]
inner
  , let linkUrl :: Text
linkUrl = HasCallStack => Model -> SiteRoute -> Text
SR.siteRouteUrl Model
model SiteRoute
r
     in (Text
linkUrl, Text
"?" Text -> Text -> Bool
`T.isInfixOf` Text
linkUrl)
  )
  where
    nonEmptyLinkInlines :: Model -> Text -> Maybe SR.SiteRoute -> [B.Inline] -> [B.Inline]
    nonEmptyLinkInlines :: Model -> Text -> Maybe SiteRoute -> [Inline] -> [Inline]
nonEmptyLinkInlines Model
model' Text
url' Maybe SiteRoute
mr = \case
      [] ->
        forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$
          Text -> [Inline] -> NonEmpty Inline
nonEmptyInlines Text
url forall a b. (a -> b) -> a -> b
$
            forall a. a -> Maybe a -> a
fromMaybe [] forall a b. (a -> b) -> a -> b
$
              Model -> Text -> SiteRoute -> Maybe [Inline]
siteRouteDefaultInnerText Model
model' Text
url' forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe SiteRoute
mr
      [Inline]
x -> [Inline]
x

-- | Ensure that inlines list is non-empty, using the provided singleton value if necessary.
nonEmptyInlines :: Text -> [B.Inline] -> NonEmpty B.Inline
nonEmptyInlines :: Text -> [Inline] -> NonEmpty Inline
nonEmptyInlines Text
x =
  forall a. a -> Maybe a -> a
fromMaybe (forall x. One x => OneItem x -> x
one forall a b. (a -> b) -> a -> b
$ Text -> Inline
B.Str Text
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe (NonEmpty a)
nonEmpty

siteRouteDefaultInnerText :: Model -> Text -> SR.SiteRoute -> Maybe [B.Inline]
siteRouteDefaultInnerText :: Model -> Text -> SiteRoute -> Maybe [Inline]
siteRouteDefaultInnerText Model
model Text
url = \case
  SR.SiteRoute_MissingR FilePath
_ -> forall a. Maybe a
Nothing
  SR.SiteRoute_AmbiguousR FilePath
_ NonEmpty LMLRoute
_ -> forall a. Maybe a
Nothing
  SR.SiteRoute_VirtualRoute VirtualRoute
_ -> forall a. Maybe a
Nothing
  SR.SiteRoute_ResourceRoute ResourceRoute
resR ->
    case ResourceRoute
resR of
      SR.ResourceRoute_LML LMLRoute
lmlR ->
        Title -> [Inline]
Tit.toInlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. Note -> Title
MN._noteTitle forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: Type -> Type). LMLRoute -> ModelT f -> Maybe Note
M.modelLookupNoteByRoute LMLRoute
lmlR Model
model
      SR.ResourceRoute_StaticFile StaticFileRoute
_ FilePath
_ ->
        -- Just append a file: prefix, to existing wiki-link.
        forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Inline
B.Str Text
"File:" forall a. a -> [a] -> [a]
: [Text -> Inline
B.Str Text
url]