{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Commonmark.Extensions.Wikilinks
  ( wikilinksSpec
  , TitlePosition(..)
  , HasWikilinks(..)
  )
where
import Commonmark.Types
import Commonmark.Tokens
import Commonmark.Syntax
import Commonmark.SourceMap
import Commonmark.TokParsers
import Commonmark.Html
import Text.Parsec
import Data.Text (Text, strip)

class HasWikilinks il where
  wikilink :: Text -> il -> il

instance Rangeable (Html a) => HasWikilinks (Html a) where
  wikilink :: Text -> Html a -> Html a
wikilink Text
url Html a
il = forall a. IsInline a => Text -> Text -> a -> a
link Text
url Text
"wikilink" Html a
il

instance (HasWikilinks il, Semigroup il, Monoid il)
        => HasWikilinks (WithSourceMap il) where
  wikilink :: Text -> WithSourceMap il -> WithSourceMap il
wikilink Text
url WithSourceMap il
il = (forall il. HasWikilinks il => Text -> il -> il
wikilink Text
url forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WithSourceMap il
il) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> WithSourceMap ()
addName Text
"wikilink"

-- | Determines whether @[[foo|bar]]@ is a link to page @bar@
-- with title (description) @foo@ ('TitleBeforePipe'), as in
-- GitHub wikis, or a link to page @foo@ with title @bar@
-- ('TitleAfterPipe'), as in Obsidian and Foam.
data TitlePosition = TitleBeforePipe | TitleAfterPipe
  deriving (Int -> TitlePosition -> ShowS
[TitlePosition] -> ShowS
TitlePosition -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TitlePosition] -> ShowS
$cshowList :: [TitlePosition] -> ShowS
show :: TitlePosition -> String
$cshow :: TitlePosition -> String
showsPrec :: Int -> TitlePosition -> ShowS
$cshowsPrec :: Int -> TitlePosition -> ShowS
Show, TitlePosition -> TitlePosition -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TitlePosition -> TitlePosition -> Bool
$c/= :: TitlePosition -> TitlePosition -> Bool
== :: TitlePosition -> TitlePosition -> Bool
$c== :: TitlePosition -> TitlePosition -> Bool
Eq)

wikilinksSpec :: (Monad m, IsInline il, HasWikilinks il)
              => TitlePosition
              -> SyntaxSpec m il bl
wikilinksSpec :: forall (m :: * -> *) il bl.
(Monad m, IsInline il, HasWikilinks il) =>
TitlePosition -> SyntaxSpec m il bl
wikilinksSpec TitlePosition
titlepos = forall a. Monoid a => a
mempty
  { syntaxInlineParsers :: [InlineParser m il]
syntaxInlineParsers = [ forall {u}. ParsecT [Tok] u (StateT Enders m) il
pWikilink ]
  }
  where
   pWikilink :: ParsecT [Tok] u (StateT Enders m) il
pWikilink = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
     forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'['
     forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'['
     forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'[')
     [Tok]
toks <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokType -> Tok -> Bool
hasType (Char -> TokType
Symbol Char
']')))
     let isPipe :: Tok -> Bool
isPipe (Tok (Symbol Char
'|') SourcePos
_ Text
_) = Bool
True
         isPipe Tok
_ = Bool
False
     let (Text
title, Text
url) =
           case forall a. (a -> Bool) -> [a] -> ([a], [a])
break Tok -> Bool
isPipe [Tok]
toks of
              ([Tok]
xs, [])   -> ([Tok] -> Text
untokenize [Tok]
xs, [Tok] -> Text
untokenize [Tok]
xs)
              ([Tok]
xs, Tok
_:[Tok]
ys) ->
                case TitlePosition
titlepos of
                  TitlePosition
TitleBeforePipe -> ([Tok] -> Text
untokenize [Tok]
xs, [Tok] -> Text
untokenize [Tok]
ys)
                  TitlePosition
TitleAfterPipe  -> ([Tok] -> Text
untokenize [Tok]
ys, [Tok] -> Text
untokenize [Tok]
xs)
     forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
']'
     forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
']'
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall il. HasWikilinks il => Text -> il -> il
wikilink (Text -> Text
strip Text
url) (forall a. IsInline a => Text -> a
str (Text -> Text
strip Text
title))