    {-# 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 =  Attribute -> Html a -> Html a
    forall a. Attribute -> Html a -> Html a
    addAttribute (Text
    "class", Text
    "wikilink") (Html a -> Html a) -> Html a -> Html a
    forall a b. (a -> b) -> a -> b
    $ Text -> Text -> Html a -> Html a
    forall a. IsInline a => Text -> Text -> a -> a
    link Text
    url Text
    "" 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 = (Text -> il -> il
    forall il. HasWikilinks il => Text -> il -> il
    wikilink Text
    url (il -> il) -> WithSourceMap il -> WithSourceMap il
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> WithSourceMap il
    il) WithSourceMap il -> WithSourceMap () -> WithSourceMap il
    forall a b. WithSourceMap a -> WithSourceMap b -> WithSourceMap a
    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
    (Int -> TitlePosition -> ShowS)
    -> (TitlePosition -> String)
    -> ([TitlePosition] -> ShowS)
    -> Show TitlePosition
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> TitlePosition -> ShowS
    showsPrec :: Int -> TitlePosition -> ShowS
    $cshow :: TitlePosition -> String
    show :: TitlePosition -> String
    $cshowList :: [TitlePosition] -> ShowS
    showList :: [TitlePosition] -> ShowS
    Show, TitlePosition -> TitlePosition -> Bool
    (TitlePosition -> TitlePosition -> Bool)
    -> (TitlePosition -> TitlePosition -> Bool) -> Eq TitlePosition
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: TitlePosition -> TitlePosition -> Bool
    == :: TitlePosition -> TitlePosition -> Bool
    $c/= :: TitlePosition -> TitlePosition -> Bool
    /= :: 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 = SyntaxSpec m il bl
    forall a. Monoid a => a
    mempty
      { syntaxInlineParsers = [ pWikilink ]
      }
      where
       pWikilink :: ParsecT [Tok] u (StateT Enders m) il
    pWikilink = ParsecT [Tok] u (StateT Enders m) il
    -> ParsecT [Tok] u (StateT Enders m) il
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
    try (ParsecT [Tok] u (StateT Enders m) il
     -> ParsecT [Tok] u (StateT Enders m) il)
    -> ParsecT [Tok] u (StateT Enders m) il
    -> ParsecT [Tok] u (StateT Enders m) il
    forall a b. (a -> b) -> a -> b
    $ do
         Char -> ParsecT [Tok] u (StateT Enders m) Tok
    forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
    symbol Char
    '['
         Char -> ParsecT [Tok] u (StateT Enders m) Tok
    forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
    symbol Char
    '['
         ParsecT [Tok] u (StateT Enders m) Tok
    -> ParsecT [Tok] u (StateT Enders m) ()
    forall s (m :: * -> *) t a u.
    (Stream s m t, Show a) =>
    ParsecT s u m a -> ParsecT s u m ()
    notFollowedBy (Char -> ParsecT [Tok] u (StateT Enders m) Tok
    forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
    symbol Char
    '[')
         toks <- ParsecT [Tok] u (StateT Enders m) Tok
    -> ParsecT [Tok] u (StateT Enders m) [Tok]
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
    many ((Tok -> Bool) -> ParsecT [Tok] u (StateT Enders m) Tok
    forall (m :: * -> *) s.
    Monad m =>
    (Tok -> Bool) -> ParsecT [Tok] s m Tok
    satisfyTok (Bool -> Bool
    not (Bool -> Bool) -> (Tok -> Bool) -> Tok -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TokType -> Tok -> Bool
    hasType (Char -> TokType
    Symbol Char
    ']')))
         let isPipe (Tok (Symbol Char
    '|') SourcePos
    _ Text
    _) = Bool
    True
             isPipe Tok
    _ = Bool
    False
         let (title, url) =
               case break isPipe 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)
         symbol ']'
         symbol ']'
         return $ wikilink (strip url) (str (strip title))