{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
module Commonmark.SourceMap
( SourceMap(..)
, WithSourceMap(..)
, runWithSourceMap
, addName
)
where
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Map.Strict as M
import qualified Data.Sequence as Seq
import Commonmark.Types
import Control.Monad.Trans.State
newtype SourceMap =
SourceMap { SourceMap -> Map SourcePos (Seq Text, Seq Text)
unSourceMap :: M.Map SourcePos (Seq.Seq Text, Seq.Seq Text) }
deriving (Int -> SourceMap -> ShowS
[SourceMap] -> ShowS
SourceMap -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SourceMap] -> ShowS
$cshowList :: [SourceMap] -> ShowS
show :: SourceMap -> String
$cshow :: SourceMap -> String
showsPrec :: Int -> SourceMap -> ShowS
$cshowsPrec :: Int -> SourceMap -> ShowS
Show)
instance Semigroup SourceMap where
(SourceMap Map SourcePos (Seq Text, Seq Text)
m1) <> :: SourceMap -> SourceMap -> SourceMap
<> (SourceMap Map SourcePos (Seq Text, Seq Text)
m2) =
Map SourcePos (Seq Text, Seq Text) -> SourceMap
SourceMap (forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith (Seq Text, Seq Text)
-> (Seq Text, Seq Text) -> (Seq Text, Seq Text)
combine Map SourcePos (Seq Text, Seq Text)
m1 Map SourcePos (Seq Text, Seq Text)
m2)
instance Monoid SourceMap where
mempty :: SourceMap
mempty = Map SourcePos (Seq Text, Seq Text) -> SourceMap
SourceMap forall a. Monoid a => a
mempty
mappend :: SourceMap -> SourceMap -> SourceMap
mappend = forall a. Semigroup a => a -> a -> a
(<>)
instance HasAttributes (WithSourceMap a) where
addAttributes :: Attributes -> WithSourceMap a -> WithSourceMap a
addAttributes Attributes
_attrs WithSourceMap a
x = WithSourceMap a
x
combine :: (Seq.Seq Text, Seq.Seq Text)
-> (Seq.Seq Text, Seq.Seq Text)
-> (Seq.Seq Text, Seq.Seq Text)
combine :: (Seq Text, Seq Text)
-> (Seq Text, Seq Text) -> (Seq Text, Seq Text)
combine (Seq Text
s1,Seq Text
e1) (Seq Text
s2,Seq Text
e2) = (Seq Text
s1 forall a. Semigroup a => a -> a -> a
<> Seq Text
s2, Seq Text
e1 forall a. Semigroup a => a -> a -> a
<> Seq Text
e2)
newtype WithSourceMap a =
WithSourceMap { forall a. WithSourceMap a -> State (Maybe Text, SourceMap) a
unWithSourceMap :: State (Maybe Text, SourceMap) a }
deriving (forall a b. a -> WithSourceMap b -> WithSourceMap a
forall a b. (a -> b) -> WithSourceMap a -> WithSourceMap b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> WithSourceMap b -> WithSourceMap a
$c<$ :: forall a b. a -> WithSourceMap b -> WithSourceMap a
fmap :: forall a b. (a -> b) -> WithSourceMap a -> WithSourceMap b
$cfmap :: forall a b. (a -> b) -> WithSourceMap a -> WithSourceMap b
Functor, Functor WithSourceMap
forall a. a -> WithSourceMap a
forall a b. WithSourceMap a -> WithSourceMap b -> WithSourceMap a
forall a b. WithSourceMap a -> WithSourceMap b -> WithSourceMap b
forall a b.
WithSourceMap (a -> b) -> WithSourceMap a -> WithSourceMap b
forall a b c.
(a -> b -> c)
-> WithSourceMap a -> WithSourceMap b -> WithSourceMap c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. WithSourceMap a -> WithSourceMap b -> WithSourceMap a
$c<* :: forall a b. WithSourceMap a -> WithSourceMap b -> WithSourceMap a
*> :: forall a b. WithSourceMap a -> WithSourceMap b -> WithSourceMap b
$c*> :: forall a b. WithSourceMap a -> WithSourceMap b -> WithSourceMap b
liftA2 :: forall a b c.
(a -> b -> c)
-> WithSourceMap a -> WithSourceMap b -> WithSourceMap c
$cliftA2 :: forall a b c.
(a -> b -> c)
-> WithSourceMap a -> WithSourceMap b -> WithSourceMap c
<*> :: forall a b.
WithSourceMap (a -> b) -> WithSourceMap a -> WithSourceMap b
$c<*> :: forall a b.
WithSourceMap (a -> b) -> WithSourceMap a -> WithSourceMap b
pure :: forall a. a -> WithSourceMap a
$cpure :: forall a. a -> WithSourceMap a
Applicative, Applicative WithSourceMap
forall a. a -> WithSourceMap a
forall a b. WithSourceMap a -> WithSourceMap b -> WithSourceMap b
forall a b.
WithSourceMap a -> (a -> WithSourceMap b) -> WithSourceMap b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> WithSourceMap a
$creturn :: forall a. a -> WithSourceMap a
>> :: forall a b. WithSourceMap a -> WithSourceMap b -> WithSourceMap b
$c>> :: forall a b. WithSourceMap a -> WithSourceMap b -> WithSourceMap b
>>= :: forall a b.
WithSourceMap a -> (a -> WithSourceMap b) -> WithSourceMap b
$c>>= :: forall a b.
WithSourceMap a -> (a -> WithSourceMap b) -> WithSourceMap b
Monad)
instance (Show a, Semigroup a) => Semigroup (WithSourceMap a) where
(WithSourceMap State (Maybe Text, SourceMap) a
x1) <> :: WithSourceMap a -> WithSourceMap a -> WithSourceMap a
<> (WithSourceMap State (Maybe Text, SourceMap) a
x2) =
forall a. State (Maybe Text, SourceMap) a -> WithSourceMap a
WithSourceMap (forall a. Semigroup a => a -> a -> a
(<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> State (Maybe Text, SourceMap) a
x1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> State (Maybe Text, SourceMap) a
x2)
instance (Show a, Semigroup a, Monoid a) => Monoid (WithSourceMap a) where
mempty :: WithSourceMap a
mempty = forall a. State (Maybe Text, SourceMap) a -> WithSourceMap a
WithSourceMap (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty)
mappend :: WithSourceMap a -> WithSourceMap a -> WithSourceMap a
mappend = forall a. Semigroup a => a -> a -> a
(<>)
instance (Show a, Monoid a) => Show (WithSourceMap a) where
show :: WithSourceMap a -> String
show (WithSourceMap State (Maybe Text, SourceMap) a
x) = forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall s a. State s a -> s -> a
evalState State (Maybe Text, SourceMap) a
x forall a. Monoid a => a
mempty
runWithSourceMap :: (Show a, Monoid a)
=> WithSourceMap a -> (a, SourceMap)
runWithSourceMap :: forall a. (Show a, Monoid a) => WithSourceMap a -> (a, SourceMap)
runWithSourceMap (WithSourceMap State (Maybe Text, SourceMap) a
x) = (a
v, SourceMap
sm)
where (a
v, (Maybe Text
_,SourceMap
sm)) = forall s a. State s a -> s -> (a, s)
runState State (Maybe Text, SourceMap) a
x (forall a. Monoid a => a
mempty, forall a. Monoid a => a
mempty)
addName :: Text -> WithSourceMap ()
addName :: Text -> WithSourceMap ()
addName Text
name =
forall a. State (Maybe Text, SourceMap) a -> WithSourceMap a
WithSourceMap forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify (\(Maybe Text
_,SourceMap
sm) -> (forall a. a -> Maybe a
Just Text
name,SourceMap
sm))
instance (IsInline a, Semigroup a) => IsInline (WithSourceMap a) where
lineBreak :: WithSourceMap a
lineBreak = forall a. IsInline a => a
lineBreak forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> WithSourceMap ()
addName Text
"lineBreak"
softBreak :: WithSourceMap a
softBreak = forall a. IsInline a => a
softBreak forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> WithSourceMap ()
addName Text
"softBreak"
str :: Text -> WithSourceMap a
str Text
t = forall a. IsInline a => Text -> a
str Text
t forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> WithSourceMap ()
addName Text
"str"
entity :: Text -> WithSourceMap a
entity Text
t = forall a. IsInline a => Text -> a
entity Text
t forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> WithSourceMap ()
addName Text
"str"
escapedChar :: Char -> WithSourceMap a
escapedChar Char
c = forall a. IsInline a => Char -> a
escapedChar Char
c forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> WithSourceMap ()
addName Text
"escapedChar"
emph :: WithSourceMap a -> WithSourceMap a
emph WithSourceMap a
x = (forall a. IsInline a => a -> a
emph forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WithSourceMap a
x) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> WithSourceMap ()
addName Text
"emph"
strong :: WithSourceMap a -> WithSourceMap a
strong WithSourceMap a
x = (forall a. IsInline a => a -> a
strong forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WithSourceMap a
x) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> WithSourceMap ()
addName Text
"strong"
link :: Text -> Text -> WithSourceMap a -> WithSourceMap a
link Text
dest Text
tit WithSourceMap a
x = (forall a. IsInline a => Text -> Text -> a -> a
link Text
dest Text
tit forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WithSourceMap a
x) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> WithSourceMap ()
addName Text
"link"
image :: Text -> Text -> WithSourceMap a -> WithSourceMap a
image Text
dest Text
tit WithSourceMap a
x = (forall a. IsInline a => Text -> Text -> a -> a
image Text
dest Text
tit forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WithSourceMap a
x) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> WithSourceMap ()
addName Text
"image"
code :: Text -> WithSourceMap a
code Text
t = forall a. IsInline a => Text -> a
code Text
t forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> WithSourceMap ()
addName Text
"code"
rawInline :: Format -> Text -> WithSourceMap a
rawInline Format
f Text
t = forall a. IsInline a => Format -> Text -> a
rawInline Format
f Text
t forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> WithSourceMap ()
addName Text
"rawInline"
instance (IsBlock b a, IsInline b, IsInline (WithSourceMap b), Semigroup a)
=> IsBlock (WithSourceMap b) (WithSourceMap a) where
paragraph :: WithSourceMap b -> WithSourceMap a
paragraph WithSourceMap b
x = (forall il b. IsBlock il b => il -> b
paragraph forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WithSourceMap b
x) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> WithSourceMap ()
addName Text
"paragraph"
plain :: WithSourceMap b -> WithSourceMap a
plain WithSourceMap b
x = (forall il b. IsBlock il b => il -> b
plain forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WithSourceMap b
x) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> WithSourceMap ()
addName Text
"plain"
thematicBreak :: WithSourceMap a
thematicBreak = forall il b. IsBlock il b => b
thematicBreak forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> WithSourceMap ()
addName Text
"thematicBreak"
blockQuote :: WithSourceMap a -> WithSourceMap a
blockQuote WithSourceMap a
x = (forall il b. IsBlock il b => b -> b
blockQuote forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WithSourceMap a
x) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> WithSourceMap ()
addName Text
"blockQuote"
codeBlock :: Text -> Text -> WithSourceMap a
codeBlock Text
i Text
t = forall il b. IsBlock il b => Text -> Text -> b
codeBlock Text
i Text
t forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> WithSourceMap ()
addName Text
"codeBlock"
heading :: Int -> WithSourceMap b -> WithSourceMap a
heading Int
lev WithSourceMap b
x = (forall il b. IsBlock il b => Int -> il -> b
heading Int
lev forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WithSourceMap b
x) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
Text -> WithSourceMap ()
addName (Text
"heading" forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show Int
lev))
rawBlock :: Format -> Text -> WithSourceMap a
rawBlock Format
f Text
t = forall il b. IsBlock il b => Format -> Text -> b
rawBlock Format
f Text
t forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> WithSourceMap ()
addName Text
"rawBlock"
referenceLinkDefinition :: Text -> (Text, Text) -> WithSourceMap a
referenceLinkDefinition Text
k (Text, Text)
x = forall il b. IsBlock il b => Text -> (Text, Text) -> b
referenceLinkDefinition Text
k (Text, Text)
x forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
Text -> WithSourceMap ()
addName Text
"referenceLinkDefinition"
list :: ListType -> ListSpacing -> [WithSourceMap a] -> WithSourceMap a
list ListType
lt ListSpacing
ls [WithSourceMap a]
items = (forall il b. IsBlock il b => ListType -> ListSpacing -> [b] -> b
list ListType
lt ListSpacing
ls forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [WithSourceMap a]
items) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> WithSourceMap ()
addName Text
"list"
instance (Rangeable a, Monoid a, Show a)
=> Rangeable (WithSourceMap a) where
ranged :: SourceRange -> WithSourceMap a -> WithSourceMap a
ranged (SourceRange [(SourcePos, SourcePos)]
rs) (WithSourceMap State (Maybe Text, SourceMap) a
x) =
forall a. State (Maybe Text, SourceMap) a -> WithSourceMap a
WithSourceMap forall a b. (a -> b) -> a -> b
$
do a
res <- State (Maybe Text, SourceMap) a
x
(Maybe Text
mbt, SourceMap Map SourcePos (Seq Text, Seq Text)
sm) <- forall (m :: * -> *) s. Monad m => StateT s m s
get
case Maybe Text
mbt of
Just Text
t -> do
let ([SourcePos]
starts, [SourcePos]
ends) = forall a b. [(a, b)] -> ([a], [b])
unzip [(SourcePos, SourcePos)]
rs
let addStart :: SourcePos
-> Map SourcePos (Seq Text, Seq Text)
-> Map SourcePos (Seq Text, Seq Text)
addStart = forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter (\case
Maybe (Seq Text, Seq Text)
Nothing ->
forall a. a -> Maybe a
Just (forall a. a -> Seq a
Seq.singleton Text
t, forall a. Monoid a => a
mempty)
Just (Seq Text
s,Seq Text
e) ->
forall a. a -> Maybe a
Just (Text
t forall a. a -> Seq a -> Seq a
Seq.<| Seq Text
s, Seq Text
e))
let addEnd :: SourcePos
-> Map SourcePos (Seq Text, Seq Text)
-> Map SourcePos (Seq Text, Seq Text)
addEnd = forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter (\case
Maybe (Seq Text, Seq Text)
Nothing ->
forall a. a -> Maybe a
Just (forall a. Monoid a => a
mempty, forall a. a -> Seq a
Seq.singleton Text
t)
Just (Seq Text
s,Seq Text
e) ->
forall a. a -> Maybe a
Just (Seq Text
s, Seq Text
e forall a. Seq a -> a -> Seq a
Seq.|> Text
t))
let sm' :: Map SourcePos (Seq Text, Seq Text)
sm' = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr SourcePos
-> Map SourcePos (Seq Text, Seq Text)
-> Map SourcePos (Seq Text, Seq Text)
addStart Map SourcePos (Seq Text, Seq Text)
sm [SourcePos]
starts
let sm'' :: Map SourcePos (Seq Text, Seq Text)
sm'' = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr SourcePos
-> Map SourcePos (Seq Text, Seq Text)
-> Map SourcePos (Seq Text, Seq Text)
addEnd Map SourcePos (Seq Text, Seq Text)
sm' [SourcePos]
ends
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (forall a. Monoid a => a
mempty, Map SourcePos (Seq Text, Seq Text) -> SourceMap
SourceMap Map SourcePos (Seq Text, Seq Text)
sm'')
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! a
res
Maybe Text
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! a
res
instance ToPlainText a => ToPlainText (WithSourceMap a) where
toPlainText :: WithSourceMap a -> Text
toPlainText (WithSourceMap State (Maybe Text, SourceMap) a
x) =
let v :: a
v = forall s a. State s a -> s -> a
evalState State (Maybe Text, SourceMap) a
x (forall a. Monoid a => a
mempty, forall a. Monoid a => a
mempty)
in forall a. ToPlainText a => a -> Text
toPlainText a
v