{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Commonmark.Extensions.Wikilinks
( wikilinksSpec
, TitlePosition(..)
, HasWikilinks(..)
)
where
import Commonmark.Entity
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"
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
unEntity [Tok]
xs, [Tok] -> Text
unEntity [Tok]
xs)
([Tok]
xs, Tok
_:[Tok]
ys) ->
case TitlePosition
titlepos of
TitlePosition
TitleBeforePipe -> ([Tok] -> Text
unEntity [Tok]
xs, [Tok] -> Text
unEntity [Tok]
ys)
TitlePosition
TitleAfterPipe -> ([Tok] -> Text
unEntity [Tok]
ys, [Tok] -> Text
unEntity [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))