module Emanote.Pandoc.Link where

import Commonmark.Extensions.WikiLink qualified as WL
import Relude
import Text.Pandoc.Definition qualified as B

-- | A Pandoc inline node that refers to something else.
--
-- There are, currently, only two possible nodes: link & image.
data InlineRef
  = InlineLink
  | InlineImage
  deriving stock (InlineRef -> InlineRef -> Bool
(InlineRef -> InlineRef -> Bool)
-> (InlineRef -> InlineRef -> Bool) -> Eq InlineRef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InlineRef -> InlineRef -> Bool
$c/= :: InlineRef -> InlineRef -> Bool
== :: InlineRef -> InlineRef -> Bool
$c== :: InlineRef -> InlineRef -> Bool
Eq, Int -> InlineRef -> ShowS
[InlineRef] -> ShowS
InlineRef -> String
(Int -> InlineRef -> ShowS)
-> (InlineRef -> String)
-> ([InlineRef] -> ShowS)
-> Show InlineRef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InlineRef] -> ShowS
$cshowList :: [InlineRef] -> ShowS
show :: InlineRef -> String
$cshow :: InlineRef -> String
showsPrec :: Int -> InlineRef -> ShowS
$cshowsPrec :: Int -> InlineRef -> ShowS
Show)

parseInlineRef :: B.Inline -> Maybe (InlineRef, B.Attr, [B.Inline], (Text, Text))
parseInlineRef :: Inline -> Maybe (InlineRef, Attr, [Inline], (Text, Text))
parseInlineRef = \case
  B.Link Attr
attr [Inline]
is (Text
url, Text
tit) ->
    (InlineRef, Attr, [Inline], (Text, Text))
-> Maybe (InlineRef, Attr, [Inline], (Text, Text))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (InlineRef
InlineLink, Attr
attr, [Inline]
is, (Text
url, Text
tit))
  B.Image Attr
attr [Inline]
is (Text
url, Text
tit) ->
    (InlineRef, Attr, [Inline], (Text, Text))
-> Maybe (InlineRef, Attr, [Inline], (Text, Text))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (InlineRef
InlineImage, Attr
attr, [Inline]
is, (Text
url, Text
tit))
  Inline
_ ->
    Maybe (InlineRef, Attr, [Inline], (Text, Text))
forall a. Maybe a
Nothing

-- | Given an inline that is known to be an InlineRef, reconstruct and return
-- its orginal Markdown source.
unParseLink :: HasCallStack => B.Inline -> Text
unParseLink :: HasCallStack => Inline -> Text
unParseLink Inline
inl =
  case Inline -> Maybe Text
WL.wikiLinkInlineRendered Inline
inl of
    Just Text
url ->
      Text
url
    Maybe Text
Nothing ->
      let (InlineRef
inlRef, Attr
_, [Inline]
is, (Text
url, Text
_tit)) = Inline -> (InlineRef, Attr, [Inline], (Text, Text))
parseInlineRefMust Inline
inl
          prefix :: Text
prefix = if InlineRef
inlRef InlineRef -> InlineRef -> Bool
forall a. Eq a => a -> a -> Bool
== InlineRef
InlineImage then Text
"![" else Text
"["
       in Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Inline] -> Text
WL.plainify [Inline]
is Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"](" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
url Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
  where
    parseInlineRefMust :: Inline -> (InlineRef, Attr, [Inline], (Text, Text))
parseInlineRefMust =
      (InlineRef, Attr, [Inline], (Text, Text))
-> Maybe (InlineRef, Attr, [Inline], (Text, Text))
-> (InlineRef, Attr, [Inline], (Text, Text))
forall a. a -> Maybe a -> a
fromMaybe (Text -> (InlineRef, Attr, [Inline], (Text, Text))
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"Non-InlineRef Inline") (Maybe (InlineRef, Attr, [Inline], (Text, Text))
 -> (InlineRef, Attr, [Inline], (Text, Text)))
-> (Inline -> Maybe (InlineRef, Attr, [Inline], (Text, Text)))
-> Inline
-> (InlineRef, Attr, [Inline], (Text, Text))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inline -> Maybe (InlineRef, Attr, [Inline], (Text, Text))
parseInlineRef