{-# LANGUAGE DeriveAnyClass #-}
module Commonmark.Extensions.WikiLink (
WikiLink,
WikiLinkType (..),
mkWikiLinkFromSlugs,
mkWikiLinkFromInline,
delineateLink,
allowedWikiLinks,
wikilinkInline,
wikiLinkInlineRendered,
wikilinkSpec,
Anchor,
anchorSuffix,
plainify,
) where
import Commonmark qualified as CM
import Commonmark.Pandoc qualified as CP
import Commonmark.TokParsers qualified as CT
import Control.Monad (liftM2)
import Data.Aeson (ToJSON (toJSON))
import Data.Data (Data)
import Data.List.NonEmpty qualified as NE
import Data.Map.Strict qualified as Map
import Data.Text qualified as T
import Network.URI.Encode qualified as UE
import Network.URI.Slug (Slug)
import Network.URI.Slug qualified as Slug
import Text.Megaparsec qualified as M
import Text.Pandoc.Builder qualified as B
import Text.Pandoc.Walk qualified as W
import Text.Parsec qualified as P
import Text.Read (Read (readsPrec))
import Text.Show qualified (Show (show))
newtype WikiLink = WikiLink {WikiLink -> NonEmpty Slug
unWikiLink :: NonEmpty Slug}
deriving stock (WikiLink -> WikiLink -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WikiLink -> WikiLink -> Bool
$c/= :: WikiLink -> WikiLink -> Bool
== :: WikiLink -> WikiLink -> Bool
$c== :: WikiLink -> WikiLink -> Bool
Eq, Eq WikiLink
WikiLink -> WikiLink -> Bool
WikiLink -> WikiLink -> Ordering
WikiLink -> WikiLink -> WikiLink
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: WikiLink -> WikiLink -> WikiLink
$cmin :: WikiLink -> WikiLink -> WikiLink
max :: WikiLink -> WikiLink -> WikiLink
$cmax :: WikiLink -> WikiLink -> WikiLink
>= :: WikiLink -> WikiLink -> Bool
$c>= :: WikiLink -> WikiLink -> Bool
> :: WikiLink -> WikiLink -> Bool
$c> :: WikiLink -> WikiLink -> Bool
<= :: WikiLink -> WikiLink -> Bool
$c<= :: WikiLink -> WikiLink -> Bool
< :: WikiLink -> WikiLink -> Bool
$c< :: WikiLink -> WikiLink -> Bool
compare :: WikiLink -> WikiLink -> Ordering
$ccompare :: WikiLink -> WikiLink -> Ordering
Ord, Typeable, Typeable @Type WikiLink
WikiLink -> DataType
WikiLink -> Constr
(forall b. Data b => b -> b) -> WikiLink -> WikiLink
forall a.
Typeable @Type a
-> (forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
Typeable @(Type -> Type) t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable @(Type -> Type -> Type) t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> WikiLink -> u
forall u. (forall d. Data d => d -> u) -> WikiLink -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WikiLink -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WikiLink -> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> WikiLink -> m WikiLink
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WikiLink -> m WikiLink
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WikiLink
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WikiLink -> c WikiLink
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable @(Type -> Type) t =>
(forall d. Data d => c (t d)) -> Maybe (c WikiLink)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable @(Type -> Type -> Type) t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c WikiLink)
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WikiLink -> m WikiLink
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WikiLink -> m WikiLink
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WikiLink -> m WikiLink
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WikiLink -> m WikiLink
gmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> WikiLink -> m WikiLink
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> WikiLink -> m WikiLink
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> WikiLink -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> WikiLink -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> WikiLink -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> WikiLink -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WikiLink -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WikiLink -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WikiLink -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WikiLink -> r
gmapT :: (forall b. Data b => b -> b) -> WikiLink -> WikiLink
$cgmapT :: (forall b. Data b => b -> b) -> WikiLink -> WikiLink
dataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable @(Type -> Type -> Type) t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c WikiLink)
$cdataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable @(Type -> Type -> Type) t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c WikiLink)
dataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable @(Type -> Type) t =>
(forall d. Data d => c (t d)) -> Maybe (c WikiLink)
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable @(Type -> Type) t =>
(forall d. Data d => c (t d)) -> Maybe (c WikiLink)
dataTypeOf :: WikiLink -> DataType
$cdataTypeOf :: WikiLink -> DataType
toConstr :: WikiLink -> Constr
$ctoConstr :: WikiLink -> Constr
gunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WikiLink
$cgunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WikiLink
gfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WikiLink -> c WikiLink
$cgfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WikiLink -> c WikiLink
Data)
instance ToJSON WikiLink where
toJSON :: WikiLink -> Value
toJSON = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. WikiLink -> Text
wikilinkUrl
instance Show WikiLink where
show :: WikiLink -> [Char]
show WikiLink
wl =
forall a. ToString a => a -> [Char]
toString forall a b. (a -> b) -> a -> b
$ Text
"[[" forall a. Semigroup a => a -> a -> a
<> WikiLink -> Text
wikilinkUrl WikiLink
wl forall a. Semigroup a => a -> a -> a
<> Text
"]]"
mkWikiLinkFromSlugs :: NonEmpty Slug -> WikiLink
mkWikiLinkFromSlugs :: NonEmpty Slug -> WikiLink
mkWikiLinkFromSlugs = NonEmpty Slug -> WikiLink
WikiLink
mkWikiLinkFromUrl :: (Monad m, Alternative m) => Text -> m WikiLink
mkWikiLinkFromUrl :: forall (m :: Type -> Type).
(Monad m, Alternative m) =>
Text -> m WikiLink
mkWikiLinkFromUrl Text
s = do
NonEmpty Slug
slugs <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (f :: Type -> Type) a. Alternative f => f a
empty forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe (NonEmpty a)
nonEmpty forall a b. (a -> b) -> a -> b
$ Text -> Slug
Slug.decodeSlug forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> [Text]
T.splitOn Text
"/" Text
s
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ NonEmpty Slug -> WikiLink
WikiLink NonEmpty Slug
slugs
mkWikiLinkFromInline :: B.Inline -> Maybe (WikiLink, [B.Inline])
mkWikiLinkFromInline :: Inline -> Maybe (WikiLink, [Inline])
mkWikiLinkFromInline Inline
inl = do
B.Link (Text
_id, [Text]
_class, [(Text, Text)]
otherAttrs) [Inline]
is (Text
url, Text
tit) <- forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Inline
inl
(Left (WikiLinkType
_, WikiLink
wl), Maybe Anchor
_manchor) <- [(Text, Text)]
-> Text
-> Maybe (Either (WikiLinkType, WikiLink) [Char], Maybe Anchor)
delineateLink ([(Text, Text)]
otherAttrs forall a. Semigroup a => a -> a -> a
<> forall x. One x => OneItem x -> x
one (Text
"title", Text
tit)) Text
url
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (WikiLink
wl, [Inline]
is)
newtype Anchor = Anchor Text
deriving newtype (Anchor -> Anchor -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Anchor -> Anchor -> Bool
$c/= :: Anchor -> Anchor -> Bool
== :: Anchor -> Anchor -> Bool
$c== :: Anchor -> Anchor -> Bool
Eq, Int -> Anchor -> ShowS
[Anchor] -> ShowS
Anchor -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Anchor] -> ShowS
$cshowList :: [Anchor] -> ShowS
show :: Anchor -> [Char]
$cshow :: Anchor -> [Char]
showsPrec :: Int -> Anchor -> ShowS
$cshowsPrec :: Int -> Anchor -> ShowS
Show, Eq Anchor
Anchor -> Anchor -> Bool
Anchor -> Anchor -> Ordering
Anchor -> Anchor -> Anchor
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Anchor -> Anchor -> Anchor
$cmin :: Anchor -> Anchor -> Anchor
max :: Anchor -> Anchor -> Anchor
$cmax :: Anchor -> Anchor -> Anchor
>= :: Anchor -> Anchor -> Bool
$c>= :: Anchor -> Anchor -> Bool
> :: Anchor -> Anchor -> Bool
$c> :: Anchor -> Anchor -> Bool
<= :: Anchor -> Anchor -> Bool
$c<= :: Anchor -> Anchor -> Bool
< :: Anchor -> Anchor -> Bool
$c< :: Anchor -> Anchor -> Bool
compare :: Anchor -> Anchor -> Ordering
$ccompare :: Anchor -> Anchor -> Ordering
Ord)
mkAnchor :: String -> Maybe Anchor
mkAnchor :: [Char] -> Maybe Anchor
mkAnchor (Char
'#' : [Char]
name) = forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Anchor
Anchor forall a b. (a -> b) -> a -> b
$ forall a. ToText a => a -> Text
toText [Char]
name
mkAnchor [Char]
_ = forall a. Maybe a
Nothing
anchorSuffix :: Maybe Anchor -> Text
anchorSuffix :: Maybe Anchor -> Text
anchorSuffix = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (\(Anchor Text
a) -> Text
"#" forall a. Semigroup a => a -> a -> a
<> Text
a)
dropUrlAnchor :: Text -> (Text, Maybe Anchor)
dropUrlAnchor :: Text -> (Text, Maybe Anchor)
dropUrlAnchor = forall (p :: Type -> Type -> Type) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ([Char] -> Maybe Anchor
mkAnchor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToString a => a -> [Char]
toString) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> (Text, Text)
T.breakOn Text
"#"
delineateLink :: [(Text, Text)] -> Text -> Maybe (Either (WikiLinkType, WikiLink) FilePath, Maybe Anchor)
delineateLink :: [(Text, Text)]
-> Text
-> Maybe (Either (WikiLinkType, WikiLink) [Char], Maybe Anchor)
delineateLink (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList -> Map Text Text
attrs) Text
url = do
forall (f :: Type -> Type). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Text
"://" Text -> Text -> Bool
`T.isInfixOf` Text
url
Maybe (Either (WikiLinkType, WikiLink) [Char], Maybe Anchor)
wikiLink forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> Maybe (Either (WikiLinkType, WikiLink) [Char], Maybe Anchor)
internalLink
where
wikiLink :: Maybe (Either (WikiLinkType, WikiLink) [Char], Maybe Anchor)
wikiLink = do
WikiLinkType
wlType :: WikiLinkType <- forall a. Read a => [Char] -> Maybe a
readMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToString a => a -> [Char]
toString forall (m :: Type -> Type) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
htmlAttr forall a b. (a -> b) -> a -> b
$ Map Text Text
attrs
let (Text
s, Maybe Anchor
manc) = Text -> (Text, Maybe Anchor)
dropUrlAnchor Text
url
WikiLink
wl <- forall (m :: Type -> Type).
(Monad m, Alternative m) =>
Text -> m WikiLink
mkWikiLinkFromUrl Text
s
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left (WikiLinkType
wlType, WikiLink
wl), Maybe Anchor
manc)
internalLink :: Maybe (Either (WikiLinkType, WikiLink) [Char], Maybe Anchor)
internalLink = do
forall (f :: Type -> Type). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Text
":" Text -> Text -> Bool
`T.isInfixOf` Text
url
let (Text
s, Maybe Anchor
manc) = Text -> (Text, Maybe Anchor)
dropUrlAnchor Text
url
forall (f :: Type -> Type). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Text -> Bool
T.null Text
s
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ ShowS
UE.decode (forall a. ToString a => a -> [Char]
toString Text
s), Maybe Anchor
manc)
wikilinkUrl :: WikiLink -> Text
wikilinkUrl :: WikiLink -> Text
wikilinkUrl =
Text -> [Text] -> Text
T.intercalate Text
"/" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Slug -> Text
Slug.unSlug forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. WikiLink -> NonEmpty Slug
unWikiLink
wikilinkInline :: WikiLinkType -> WikiLink -> B.Inlines -> B.Inlines
wikilinkInline :: WikiLinkType -> WikiLink -> Inlines -> Inlines
wikilinkInline WikiLinkType
typ WikiLink
wl = (Text, [Text], [(Text, Text)])
-> Text -> Text -> Inlines -> Inlines
B.linkWith (Text, [Text], [(Text, Text)])
attrs (WikiLink -> Text
wikilinkUrl WikiLink
wl) Text
""
where
attrs :: (Text, [Text], [(Text, Text)])
attrs = (Text
"", [], [(Text
htmlAttr, forall b a. (Show a, IsString b) => a -> b
show WikiLinkType
typ)])
wikiLinkInlineRendered :: B.Inline -> Maybe Text
wikiLinkInlineRendered :: Inline -> Maybe Text
wikiLinkInlineRendered Inline
x = do
(WikiLink
wl, [Inline]
inl) <- Inline -> Maybe (WikiLink, [Inline])
mkWikiLinkFromInline Inline
x
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [Inline]
inl of
Maybe (NonEmpty Inline)
Nothing -> forall b a. (Show a, IsString b) => a -> b
show WikiLink
wl
Just NonEmpty Inline
_ ->
let inlStr :: Text
inlStr = [Inline] -> Text
plainify [Inline]
inl
in if Text
inlStr forall a. Eq a => a -> a -> Bool
== WikiLink -> Text
wikilinkUrl WikiLink
wl
then forall b a. (Show a, IsString b) => a -> b
show WikiLink
wl
else Text
"[[" forall a. Semigroup a => a -> a -> a
<> WikiLink -> Text
wikilinkUrl WikiLink
wl forall a. Semigroup a => a -> a -> a
<> Text
"|" forall a. Semigroup a => a -> a -> a
<> [Inline] -> Text
plainify [Inline]
inl forall a. Semigroup a => a -> a -> a
<> Text
"]]"
allowedWikiLinks :: HasCallStack => NonEmpty Slug -> NonEmpty (WikiLinkType, WikiLink)
allowedWikiLinks :: HasCallStack => NonEmpty Slug -> NonEmpty (WikiLinkType, WikiLink)
allowedWikiLinks NonEmpty Slug
slugs =
let wls :: NonEmpty WikiLink
wls = NonEmpty Slug -> WikiLink
WikiLink forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {a}. NonEmpty a -> NonEmpty (NonEmpty a)
tailsNE NonEmpty Slug
slugs
NonEmpty WikiLinkType
typs :: NonEmpty WikiLinkType = forall a. [a] -> NonEmpty a
NE.fromList forall a. (Bounded a, Enum a) => [a]
universe
in forall (m :: Type -> Type) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) NonEmpty WikiLinkType
typs NonEmpty WikiLink
wls
where
tailsNE :: NonEmpty a -> NonEmpty (NonEmpty a)
tailsNE =
forall a. [a] -> NonEmpty a
NE.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall a. [a] -> Maybe (NonEmpty a)
nonEmpty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [[a]]
tails forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList
data WikiLinkType
=
WikiLinkNormal
|
WikiLinkBranch
|
WikiLinkTag
|
WikiLinkEmbed
deriving stock (WikiLinkType -> WikiLinkType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WikiLinkType -> WikiLinkType -> Bool
$c/= :: WikiLinkType -> WikiLinkType -> Bool
== :: WikiLinkType -> WikiLinkType -> Bool
$c== :: WikiLinkType -> WikiLinkType -> Bool
Eq, Int -> WikiLinkType -> ShowS
[WikiLinkType] -> ShowS
WikiLinkType -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [WikiLinkType] -> ShowS
$cshowList :: [WikiLinkType] -> ShowS
show :: WikiLinkType -> [Char]
$cshow :: WikiLinkType -> [Char]
showsPrec :: Int -> WikiLinkType -> ShowS
$cshowsPrec :: Int -> WikiLinkType -> ShowS
Show, Eq WikiLinkType
WikiLinkType -> WikiLinkType -> Bool
WikiLinkType -> WikiLinkType -> Ordering
WikiLinkType -> WikiLinkType -> WikiLinkType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: WikiLinkType -> WikiLinkType -> WikiLinkType
$cmin :: WikiLinkType -> WikiLinkType -> WikiLinkType
max :: WikiLinkType -> WikiLinkType -> WikiLinkType
$cmax :: WikiLinkType -> WikiLinkType -> WikiLinkType
>= :: WikiLinkType -> WikiLinkType -> Bool
$c>= :: WikiLinkType -> WikiLinkType -> Bool
> :: WikiLinkType -> WikiLinkType -> Bool
$c> :: WikiLinkType -> WikiLinkType -> Bool
<= :: WikiLinkType -> WikiLinkType -> Bool
$c<= :: WikiLinkType -> WikiLinkType -> Bool
< :: WikiLinkType -> WikiLinkType -> Bool
$c< :: WikiLinkType -> WikiLinkType -> Bool
compare :: WikiLinkType -> WikiLinkType -> Ordering
$ccompare :: WikiLinkType -> WikiLinkType -> Ordering
Ord, Typeable, Typeable @Type WikiLinkType
WikiLinkType -> DataType
WikiLinkType -> Constr
(forall b. Data b => b -> b) -> WikiLinkType -> WikiLinkType
forall a.
Typeable @Type a
-> (forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
Typeable @(Type -> Type) t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable @(Type -> Type -> Type) t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> WikiLinkType -> u
forall u. (forall d. Data d => d -> u) -> WikiLinkType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WikiLinkType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WikiLinkType -> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> WikiLinkType -> m WikiLinkType
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WikiLinkType -> m WikiLinkType
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WikiLinkType
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WikiLinkType -> c WikiLinkType
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable @(Type -> Type) t =>
(forall d. Data d => c (t d)) -> Maybe (c WikiLinkType)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable @(Type -> Type -> Type) t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c WikiLinkType)
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WikiLinkType -> m WikiLinkType
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WikiLinkType -> m WikiLinkType
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WikiLinkType -> m WikiLinkType
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WikiLinkType -> m WikiLinkType
gmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> WikiLinkType -> m WikiLinkType
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> WikiLinkType -> m WikiLinkType
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> WikiLinkType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> WikiLinkType -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> WikiLinkType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> WikiLinkType -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WikiLinkType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WikiLinkType -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WikiLinkType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WikiLinkType -> r
gmapT :: (forall b. Data b => b -> b) -> WikiLinkType -> WikiLinkType
$cgmapT :: (forall b. Data b => b -> b) -> WikiLinkType -> WikiLinkType
dataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable @(Type -> Type -> Type) t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c WikiLinkType)
$cdataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable @(Type -> Type -> Type) t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c WikiLinkType)
dataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable @(Type -> Type) t =>
(forall d. Data d => c (t d)) -> Maybe (c WikiLinkType)
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable @(Type -> Type) t =>
(forall d. Data d => c (t d)) -> Maybe (c WikiLinkType)
dataTypeOf :: WikiLinkType -> DataType
$cdataTypeOf :: WikiLinkType -> DataType
toConstr :: WikiLinkType -> Constr
$ctoConstr :: WikiLinkType -> Constr
gunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WikiLinkType
$cgunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WikiLinkType
gfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WikiLinkType -> c WikiLinkType
$cgfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WikiLinkType -> c WikiLinkType
Data, Int -> WikiLinkType
WikiLinkType -> Int
WikiLinkType -> [WikiLinkType]
WikiLinkType -> WikiLinkType
WikiLinkType -> WikiLinkType -> [WikiLinkType]
WikiLinkType -> WikiLinkType -> WikiLinkType -> [WikiLinkType]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: WikiLinkType -> WikiLinkType -> WikiLinkType -> [WikiLinkType]
$cenumFromThenTo :: WikiLinkType -> WikiLinkType -> WikiLinkType -> [WikiLinkType]
enumFromTo :: WikiLinkType -> WikiLinkType -> [WikiLinkType]
$cenumFromTo :: WikiLinkType -> WikiLinkType -> [WikiLinkType]
enumFromThen :: WikiLinkType -> WikiLinkType -> [WikiLinkType]
$cenumFromThen :: WikiLinkType -> WikiLinkType -> [WikiLinkType]
enumFrom :: WikiLinkType -> [WikiLinkType]
$cenumFrom :: WikiLinkType -> [WikiLinkType]
fromEnum :: WikiLinkType -> Int
$cfromEnum :: WikiLinkType -> Int
toEnum :: Int -> WikiLinkType
$ctoEnum :: Int -> WikiLinkType
pred :: WikiLinkType -> WikiLinkType
$cpred :: WikiLinkType -> WikiLinkType
succ :: WikiLinkType -> WikiLinkType
$csucc :: WikiLinkType -> WikiLinkType
Enum, WikiLinkType
forall a. a -> a -> Bounded a
maxBound :: WikiLinkType
$cmaxBound :: WikiLinkType
minBound :: WikiLinkType
$cminBound :: WikiLinkType
Bounded, forall x. Rep WikiLinkType x -> WikiLinkType
forall x. WikiLinkType -> Rep WikiLinkType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WikiLinkType x -> WikiLinkType
$cfrom :: forall x. WikiLinkType -> Rep WikiLinkType x
Generic)
deriving anyclass ([WikiLinkType] -> Encoding
[WikiLinkType] -> Value
WikiLinkType -> Encoding
WikiLinkType -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [WikiLinkType] -> Encoding
$ctoEncodingList :: [WikiLinkType] -> Encoding
toJSONList :: [WikiLinkType] -> Value
$ctoJSONList :: [WikiLinkType] -> Value
toEncoding :: WikiLinkType -> Encoding
$ctoEncoding :: WikiLinkType -> Encoding
toJSON :: WikiLinkType -> Value
$ctoJSON :: WikiLinkType -> Value
ToJSON)
instance Read WikiLinkType where
readsPrec :: Int -> ReadS WikiLinkType
readsPrec Int
_ [Char]
s
| [Char]
s forall a. Eq a => a -> a -> Bool
== forall b a. (Show a, IsString b) => a -> b
show WikiLinkType
WikiLinkNormal = [(WikiLinkType
WikiLinkNormal, [Char]
"")]
| [Char]
s forall a. Eq a => a -> a -> Bool
== forall b a. (Show a, IsString b) => a -> b
show WikiLinkType
WikiLinkBranch = [(WikiLinkType
WikiLinkBranch, [Char]
"")]
| [Char]
s forall a. Eq a => a -> a -> Bool
== forall b a. (Show a, IsString b) => a -> b
show WikiLinkType
WikiLinkTag = [(WikiLinkType
WikiLinkTag, [Char]
"")]
| [Char]
s forall a. Eq a => a -> a -> Bool
== forall b a. (Show a, IsString b) => a -> b
show WikiLinkType
WikiLinkEmbed = [(WikiLinkType
WikiLinkEmbed, [Char]
"")]
| Bool
otherwise = []
htmlAttr :: Text
htmlAttr :: Text
htmlAttr = Text
"data-wikilink-type"
class HasWikiLink il where
wikilink :: WikiLinkType -> WikiLink -> Maybe il -> il
instance HasWikiLink (CP.Cm b B.Inlines) where
wikilink :: WikiLinkType -> WikiLink -> Maybe (Cm b Inlines) -> Cm b Inlines
wikilink WikiLinkType
typ WikiLink
wl Maybe (Cm b Inlines)
il =
forall b a. a -> Cm b a
CP.Cm forall a b. (a -> b) -> a -> b
$ WikiLinkType -> WikiLink -> Inlines -> Inlines
wikilinkInline WikiLinkType
typ WikiLink
wl forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty forall b a. Cm b a -> a
CP.unCm Maybe (Cm b Inlines)
il
wikilinkSpec ::
(Monad m, CM.IsInline il, HasWikiLink il) =>
CM.SyntaxSpec m il bl
wikilinkSpec :: forall (m :: Type -> Type) il bl.
(Monad m, IsInline il, HasWikiLink il) =>
SyntaxSpec m il bl
wikilinkSpec =
forall a. Monoid a => a
mempty
{ syntaxInlineParsers :: [InlineParser m il]
CM.syntaxInlineParsers =
[ forall s u (m :: Type -> Type) a.
ParsecT s u m a -> ParsecT s u m a
P.try forall a b. (a -> b) -> a -> b
$
forall s (m :: Type -> Type) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
P.choice
[ forall s u (m :: Type -> Type) a.
ParsecT s u m a -> ParsecT s u m a
P.try (forall (m :: Type -> Type) s.
Monad m =>
Char -> ParsecT [Tok] s m Tok
CT.symbol Char
'#' forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> forall {m :: Type -> Type} {b} {s}.
(Monad m, HasWikiLink b, IsInline b) =>
WikiLinkType -> ParsecT [Tok] s m b
pWikilink WikiLinkType
WikiLinkTag)
, forall s u (m :: Type -> Type) a.
ParsecT s u m a -> ParsecT s u m a
P.try (forall (m :: Type -> Type) s.
Monad m =>
Char -> ParsecT [Tok] s m Tok
CT.symbol Char
'!' forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> forall {m :: Type -> Type} {b} {s}.
(Monad m, HasWikiLink b, IsInline b) =>
WikiLinkType -> ParsecT [Tok] s m b
pWikilink WikiLinkType
WikiLinkEmbed)
, forall s u (m :: Type -> Type) a.
ParsecT s u m a -> ParsecT s u m a
P.try (forall {m :: Type -> Type} {b} {s}.
(Monad m, HasWikiLink b, IsInline b) =>
WikiLinkType -> ParsecT [Tok] s m b
pWikilink WikiLinkType
WikiLinkBranch forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* forall (m :: Type -> Type) s.
Monad m =>
Char -> ParsecT [Tok] s m Tok
CT.symbol Char
'#')
, forall s u (m :: Type -> Type) a.
ParsecT s u m a -> ParsecT s u m a
P.try (forall {m :: Type -> Type} {b} {s}.
(Monad m, HasWikiLink b, IsInline b) =>
WikiLinkType -> ParsecT [Tok] s m b
pWikilink WikiLinkType
WikiLinkNormal)
]
]
}
where
pWikilink :: WikiLinkType -> ParsecT [Tok] s m b
pWikilink WikiLinkType
typ = do
forall (m :: Type -> Type) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
2 forall a b. (a -> b) -> a -> b
$ forall (m :: Type -> Type) s.
Monad m =>
Char -> ParsecT [Tok] s m Tok
CT.symbol Char
'['
forall s (m :: Type -> Type) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
P.notFollowedBy (forall (m :: Type -> Type) s.
Monad m =>
Char -> ParsecT [Tok] s m Tok
CT.symbol Char
'[')
Text
url <-
[Tok] -> Text
CM.untokenize forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: Type -> Type) a. Alternative f => f a -> f [a]
many (forall {m :: Type -> Type} {t :: Type -> Type} {s}.
(Monad m, Foldable t, Functor t) =>
t (Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyNoneOf [Tok -> Bool
isPipe, Tok -> Bool
isAnchor, Tok -> Bool
isClose])
WikiLink
wl <- forall (m :: Type -> Type).
(Monad m, Alternative m) =>
Text -> m WikiLink
mkWikiLinkFromUrl Text
url
Maybe Text
_anchor <-
forall (f :: Type -> Type) a. Alternative f => f a -> f (Maybe a)
M.optional forall a b. (a -> b) -> a -> b
$
[Tok] -> Text
CM.untokenize
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ( forall (m :: Type -> Type) s.
Monad m =>
Char -> ParsecT [Tok] s m Tok
CT.symbol Char
'#'
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> forall (f :: Type -> Type) a. Alternative f => f a -> f [a]
many (forall {m :: Type -> Type} {t :: Type -> Type} {s}.
(Monad m, Foldable t, Functor t) =>
t (Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyNoneOf [Tok -> Bool
isPipe, Tok -> Bool
isClose])
)
Maybe Text
title <-
forall (f :: Type -> Type) a. Alternative f => f a -> f (Maybe a)
M.optional forall a b. (a -> b) -> a -> b
$
[Tok] -> Text
CM.untokenize
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ( forall (m :: Type -> Type) s.
Monad m =>
Char -> ParsecT [Tok] s m Tok
CT.symbol Char
'|'
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> forall (f :: Type -> Type) a. Alternative f => f a -> f [a]
many (forall {m :: Type -> Type} {t :: Type -> Type} {s}.
(Monad m, Foldable t, Functor t) =>
t (Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyNoneOf [Tok -> Bool
isClose])
)
forall (m :: Type -> Type) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
2 forall a b. (a -> b) -> a -> b
$ forall (m :: Type -> Type) s.
Monad m =>
Char -> ParsecT [Tok] s m Tok
CT.symbol Char
']'
forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall il.
HasWikiLink il =>
WikiLinkType -> WikiLink -> Maybe il -> il
wikilink WikiLinkType
typ WikiLink
wl (forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. IsInline a => Text -> a
CM.str Maybe Text
title)
satisfyNoneOf :: t (Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyNoneOf t (Tok -> Bool)
toks =
forall (m :: Type -> Type) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
CT.satisfyTok forall a b. (a -> b) -> a -> b
$ \Tok
t -> Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: Type -> Type). Foldable t => t Bool -> Bool
or forall a b. (a -> b) -> a -> b
$ t (Tok -> Bool)
toks forall (f :: Type -> Type) a b. Functor f => f a -> (a -> b) -> f b
<&> \Tok -> Bool
tok -> Tok -> Bool
tok Tok
t
isAnchor :: Tok -> Bool
isAnchor =
Char -> Tok -> Bool
isSymbol Char
'#'
isPipe :: Tok -> Bool
isPipe =
Char -> Tok -> Bool
isSymbol Char
'|'
isClose :: Tok -> Bool
isClose =
Char -> Tok -> Bool
isSymbol Char
']'
isSymbol :: Char -> Tok -> Bool
isSymbol Char
c =
TokType -> Tok -> Bool
CT.hasType (Char -> TokType
CM.Symbol Char
c)
plainify :: [B.Inline] -> Text
plainify :: [Inline] -> Text
plainify = forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
W.query forall a b. (a -> b) -> a -> b
$ \case
B.Str Text
x -> Text
x
B.Code (Text, [Text], [(Text, Text)])
_attr Text
x -> Text
x
Inline
B.Space -> Text
" "
Inline
B.SoftBreak -> Text
" "
Inline
B.LineBreak -> Text
" "
B.RawInline Format
_fmt Text
s -> Text
s
B.Span (Text, [Text], [(Text, Text)])
_ [Inline]
_ -> Text
""
B.Math MathType
_mathTyp Text
s -> Text
s
(Inline -> Maybe (WikiLink, [Inline])
mkWikiLinkFromInline -> Just (WikiLink
wl, [Inline]
customText)) ->
if forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Inline]
customText
then forall b a. (Show a, IsString b) => a -> b
show WikiLink
wl
else [Inline] -> Text
plainify [Inline]
customText
Inline
_ -> Text
""