{-# 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

-- | A map from source positions to a pair of sequences:
-- first, elements that start at that position; then, elements
-- that end at that position.
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
(Int -> SourceMap -> ShowS)
-> (SourceMap -> String)
-> ([SourceMap] -> ShowS)
-> Show SourceMap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SourceMap -> ShowS
showsPrec :: Int -> SourceMap -> ShowS
$cshow :: SourceMap -> String
show :: SourceMap -> String
$cshowList :: [SourceMap] -> ShowS
showList :: [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 (((Seq Text, Seq Text)
 -> (Seq Text, Seq Text) -> (Seq Text, Seq Text))
-> Map SourcePos (Seq Text, Seq Text)
-> Map SourcePos (Seq Text, Seq Text)
-> Map SourcePos (Seq Text, Seq Text)
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 Map SourcePos (Seq Text, Seq Text)
forall a. Monoid a => a
mempty
  mappend :: SourceMap -> SourceMap -> SourceMap
mappend = SourceMap -> SourceMap -> SourceMap
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 Seq Text -> Seq Text -> Seq Text
forall a. Semigroup a => a -> a -> a
<> Seq Text
s2, Seq Text
e1 Seq Text -> Seq Text -> Seq Text
forall a. Semigroup a => a -> a -> a
<> Seq Text
e2)

-- | Use this when you want to extract a source map as well
-- as the parsed content.
newtype WithSourceMap a =
        WithSourceMap { forall a. WithSourceMap a -> State (Maybe Text, SourceMap) a
unWithSourceMap :: State (Maybe Text, SourceMap) a }
        deriving ((forall a b. (a -> b) -> WithSourceMap a -> WithSourceMap b)
-> (forall a b. a -> WithSourceMap b -> WithSourceMap a)
-> Functor WithSourceMap
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
$cfmap :: forall a b. (a -> b) -> WithSourceMap a -> WithSourceMap b
fmap :: forall a b. (a -> b) -> WithSourceMap a -> WithSourceMap b
$c<$ :: forall a b. a -> WithSourceMap b -> WithSourceMap a
<$ :: forall a b. a -> WithSourceMap b -> WithSourceMap a
Functor, Functor WithSourceMap
Functor WithSourceMap =>
(forall a. a -> WithSourceMap a)
-> (forall a b.
    WithSourceMap (a -> b) -> WithSourceMap a -> WithSourceMap b)
-> (forall a b c.
    (a -> b -> c)
    -> WithSourceMap a -> WithSourceMap b -> WithSourceMap c)
-> (forall a b.
    WithSourceMap a -> WithSourceMap b -> WithSourceMap b)
-> (forall a b.
    WithSourceMap a -> WithSourceMap b -> WithSourceMap a)
-> Applicative 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
$cpure :: forall a. a -> WithSourceMap a
pure :: forall a. a -> WithSourceMap a
$c<*> :: forall a b.
WithSourceMap (a -> b) -> WithSourceMap a -> WithSourceMap b
<*> :: forall a b.
WithSourceMap (a -> b) -> WithSourceMap a -> WithSourceMap b
$cliftA2 :: forall a b c.
(a -> b -> c)
-> WithSourceMap a -> WithSourceMap b -> WithSourceMap c
liftA2 :: forall a b c.
(a -> b -> c)
-> WithSourceMap a -> WithSourceMap b -> WithSourceMap c
$c*> :: forall a b. WithSourceMap a -> WithSourceMap b -> WithSourceMap b
*> :: forall a b. WithSourceMap a -> WithSourceMap b -> WithSourceMap b
$c<* :: forall a b. WithSourceMap a -> WithSourceMap b -> WithSourceMap a
<* :: forall a b. WithSourceMap a -> WithSourceMap b -> WithSourceMap a
Applicative, Applicative WithSourceMap
Applicative WithSourceMap =>
(forall a b.
 WithSourceMap a -> (a -> WithSourceMap b) -> WithSourceMap b)
-> (forall a b.
    WithSourceMap a -> WithSourceMap b -> WithSourceMap b)
-> (forall a. a -> WithSourceMap a)
-> Monad 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
$c>>= :: forall a b.
WithSourceMap a -> (a -> WithSourceMap b) -> WithSourceMap b
>>= :: forall a b.
WithSourceMap a -> (a -> WithSourceMap b) -> WithSourceMap b
$c>> :: forall a b. WithSourceMap a -> WithSourceMap b -> WithSourceMap b
>> :: forall a b. WithSourceMap a -> WithSourceMap b -> WithSourceMap b
$creturn :: forall a. a -> WithSourceMap a
return :: forall a. a -> WithSourceMap a
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) =
    State (Maybe Text, SourceMap) a -> WithSourceMap a
forall a. State (Maybe Text, SourceMap) a -> WithSourceMap a
WithSourceMap (a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>) (a -> a -> a)
-> State (Maybe Text, SourceMap) a
-> StateT (Maybe Text, SourceMap) Identity (a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> State (Maybe Text, SourceMap) a
x1 StateT (Maybe Text, SourceMap) Identity (a -> a)
-> State (Maybe Text, SourceMap) a
-> State (Maybe Text, SourceMap) a
forall a b.
StateT (Maybe Text, SourceMap) Identity (a -> b)
-> StateT (Maybe Text, SourceMap) Identity a
-> StateT (Maybe Text, SourceMap) Identity b
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 = State (Maybe Text, SourceMap) a -> WithSourceMap a
forall a. State (Maybe Text, SourceMap) a -> WithSourceMap a
WithSourceMap (a -> State (Maybe Text, SourceMap) a
forall a. a -> StateT (Maybe Text, SourceMap) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return a
forall a. Monoid a => a
mempty)
  mappend :: WithSourceMap a -> WithSourceMap a -> WithSourceMap a
mappend = WithSourceMap a -> WithSourceMap a -> WithSourceMap a
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) = a -> String
forall a. Show a => a -> String
show (a -> String) -> a -> String
forall a b. (a -> b) -> a -> b
$ State (Maybe Text, SourceMap) a -> (Maybe Text, SourceMap) -> a
forall s a. State s a -> s -> a
evalState State (Maybe Text, SourceMap) a
x (Maybe Text, SourceMap)
forall a. Monoid a => a
mempty

-- | Extract a parsed value and a source map from a
-- 'WithSourceMap'.
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)) = State (Maybe Text, SourceMap) a
-> (Maybe Text, SourceMap) -> (a, (Maybe Text, SourceMap))
forall s a. State s a -> s -> (a, s)
runState State (Maybe Text, SourceMap) a
x (Maybe Text
forall a. Monoid a => a
mempty, SourceMap
forall a. Monoid a => a
mempty)

addName :: Text -> WithSourceMap ()
addName :: Text -> WithSourceMap ()
addName Text
name =
  State (Maybe Text, SourceMap) () -> WithSourceMap ()
forall a. State (Maybe Text, SourceMap) a -> WithSourceMap a
WithSourceMap (State (Maybe Text, SourceMap) () -> WithSourceMap ())
-> State (Maybe Text, SourceMap) () -> WithSourceMap ()
forall a b. (a -> b) -> a -> b
$ ((Maybe Text, SourceMap) -> (Maybe Text, SourceMap))
-> State (Maybe Text, SourceMap) ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify (\(Maybe Text
_,SourceMap
sm) -> (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
name,SourceMap
sm))

instance (IsInline a, Semigroup a) => IsInline (WithSourceMap a) where
  lineBreak :: WithSourceMap a
lineBreak = a
forall a. IsInline a => a
lineBreak a -> WithSourceMap () -> WithSourceMap a
forall a b. a -> WithSourceMap b -> WithSourceMap a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> WithSourceMap ()
addName Text
"lineBreak"
  softBreak :: WithSourceMap a
softBreak = a
forall a. IsInline a => a
softBreak a -> WithSourceMap () -> WithSourceMap a
forall a b. a -> WithSourceMap b -> WithSourceMap a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> WithSourceMap ()
addName Text
"softBreak"
  str :: Text -> WithSourceMap a
str Text
t = Text -> a
forall a. IsInline a => Text -> a
str Text
t a -> WithSourceMap () -> WithSourceMap a
forall a b. a -> WithSourceMap b -> WithSourceMap a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> WithSourceMap ()
addName Text
"str"
  entity :: Text -> WithSourceMap a
entity Text
t = Text -> a
forall a. IsInline a => Text -> a
entity Text
t a -> WithSourceMap () -> WithSourceMap a
forall a b. a -> WithSourceMap b -> WithSourceMap a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> WithSourceMap ()
addName Text
"str"
  escapedChar :: Char -> WithSourceMap a
escapedChar Char
c = Char -> a
forall a. IsInline a => Char -> a
escapedChar Char
c a -> WithSourceMap () -> WithSourceMap a
forall a b. a -> WithSourceMap b -> WithSourceMap a
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 = (a -> a
forall a. IsInline a => a -> a
emph (a -> a) -> WithSourceMap a -> WithSourceMap a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WithSourceMap a
x) WithSourceMap a -> WithSourceMap () -> WithSourceMap a
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
"emph"
  strong :: WithSourceMap a -> WithSourceMap a
strong WithSourceMap a
x = (a -> a
forall a. IsInline a => a -> a
strong (a -> a) -> WithSourceMap a -> WithSourceMap a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WithSourceMap a
x) WithSourceMap a -> WithSourceMap () -> WithSourceMap a
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
"strong"
  link :: Text -> Text -> WithSourceMap a -> WithSourceMap a
link Text
dest Text
tit WithSourceMap a
x = (Text -> Text -> a -> a
forall a. IsInline a => Text -> Text -> a -> a
link Text
dest Text
tit (a -> a) -> WithSourceMap a -> WithSourceMap a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WithSourceMap a
x) WithSourceMap a -> WithSourceMap () -> WithSourceMap a
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
"link"
  image :: Text -> Text -> WithSourceMap a -> WithSourceMap a
image Text
dest Text
tit WithSourceMap a
x = (Text -> Text -> a -> a
forall a. IsInline a => Text -> Text -> a -> a
image Text
dest Text
tit (a -> a) -> WithSourceMap a -> WithSourceMap a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WithSourceMap a
x) WithSourceMap a -> WithSourceMap () -> WithSourceMap a
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
"image"
  code :: Text -> WithSourceMap a
code Text
t = Text -> a
forall a. IsInline a => Text -> a
code Text
t a -> WithSourceMap () -> WithSourceMap a
forall a b. a -> WithSourceMap b -> WithSourceMap a
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 = Format -> Text -> a
forall a. IsInline a => Format -> Text -> a
rawInline Format
f Text
t a -> WithSourceMap () -> WithSourceMap a
forall a b. a -> WithSourceMap b -> WithSourceMap a
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 = (b -> a
forall il b. IsBlock il b => il -> b
paragraph (b -> a) -> WithSourceMap b -> WithSourceMap a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WithSourceMap b
x) WithSourceMap a -> WithSourceMap () -> WithSourceMap a
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
"paragraph"
  plain :: WithSourceMap b -> WithSourceMap a
plain WithSourceMap b
x = (b -> a
forall il b. IsBlock il b => il -> b
plain (b -> a) -> WithSourceMap b -> WithSourceMap a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WithSourceMap b
x) WithSourceMap a -> WithSourceMap () -> WithSourceMap a
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
"plain"
  thematicBreak :: WithSourceMap a
thematicBreak = a
forall il b. IsBlock il b => b
thematicBreak a -> WithSourceMap () -> WithSourceMap a
forall a b. a -> WithSourceMap b -> WithSourceMap a
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 = (a -> a
forall il b. IsBlock il b => b -> b
blockQuote (a -> a) -> WithSourceMap a -> WithSourceMap a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WithSourceMap a
x) WithSourceMap a -> WithSourceMap () -> WithSourceMap a
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
"blockQuote"
  codeBlock :: Text -> Text -> WithSourceMap a
codeBlock Text
i Text
t = Text -> Text -> a
forall il b. IsBlock il b => Text -> Text -> b
codeBlock Text
i Text
t a -> WithSourceMap () -> WithSourceMap a
forall a b. a -> WithSourceMap b -> WithSourceMap a
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 = (Int -> b -> a
forall il b. IsBlock il b => Int -> il -> b
heading Int
lev (b -> a) -> WithSourceMap b -> WithSourceMap a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WithSourceMap b
x) WithSourceMap a -> WithSourceMap () -> WithSourceMap a
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
"heading" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
lev))
  rawBlock :: Format -> Text -> WithSourceMap a
rawBlock Format
f Text
t = Format -> Text -> a
forall il b. IsBlock il b => Format -> Text -> b
rawBlock Format
f Text
t a -> WithSourceMap () -> WithSourceMap a
forall a b. a -> WithSourceMap b -> WithSourceMap a
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 = Text -> (Text, Text) -> a
forall il b. IsBlock il b => Text -> (Text, Text) -> b
referenceLinkDefinition Text
k (Text, Text)
x a -> WithSourceMap () -> WithSourceMap a
forall a b. a -> WithSourceMap b -> WithSourceMap a
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 = (ListType -> ListSpacing -> [a] -> a
forall il b. IsBlock il b => ListType -> ListSpacing -> [b] -> b
list ListType
lt ListSpacing
ls ([a] -> a) -> WithSourceMap [a] -> WithSourceMap a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [WithSourceMap a] -> WithSourceMap [a]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [WithSourceMap a]
items) WithSourceMap a -> WithSourceMap () -> WithSourceMap a
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
"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) =
    State (Maybe Text, SourceMap) a -> WithSourceMap a
forall a. State (Maybe Text, SourceMap) a -> WithSourceMap a
WithSourceMap (State (Maybe Text, SourceMap) a -> WithSourceMap a)
-> State (Maybe Text, SourceMap) a -> WithSourceMap a
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) <- StateT (Maybe Text, SourceMap) Identity (Maybe Text, SourceMap)
forall (m :: * -> *) s. Monad m => StateT s m s
get
         case Maybe Text
mbt of
           Just Text
t -> do
             let ([SourcePos]
starts, [SourcePos]
ends) = [(SourcePos, SourcePos)] -> ([SourcePos], [SourcePos])
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 = (Maybe (Seq Text, Seq Text) -> Maybe (Seq Text, Seq Text))
-> SourcePos
-> Map SourcePos (Seq Text, Seq Text)
-> Map SourcePos (Seq Text, Seq Text)
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    ->
                                         (Seq Text, Seq Text) -> Maybe (Seq Text, Seq Text)
forall a. a -> Maybe a
Just (Text -> Seq Text
forall a. a -> Seq a
Seq.singleton Text
t, Seq Text
forall a. Monoid a => a
mempty)
                                       Just (Seq Text
s,Seq Text
e) ->
                                         (Seq Text, Seq Text) -> Maybe (Seq Text, Seq Text)
forall a. a -> Maybe a
Just (Text
t Text -> Seq Text -> Seq Text
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 = (Maybe (Seq Text, Seq Text) -> Maybe (Seq Text, Seq Text))
-> SourcePos
-> Map SourcePos (Seq Text, Seq Text)
-> Map SourcePos (Seq Text, Seq Text)
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    ->
                                       (Seq Text, Seq Text) -> Maybe (Seq Text, Seq Text)
forall a. a -> Maybe a
Just (Seq Text
forall a. Monoid a => a
mempty, Text -> Seq Text
forall a. a -> Seq a
Seq.singleton Text
t)
                                     Just (Seq Text
s,Seq Text
e) ->
                                       (Seq Text, Seq Text) -> Maybe (Seq Text, Seq Text)
forall a. a -> Maybe a
Just (Seq Text
s, Seq Text
e Seq Text -> Text -> Seq Text
forall a. Seq a -> a -> Seq a
Seq.|> Text
t))
             let sm' :: Map SourcePos (Seq Text, Seq Text)
sm' = (SourcePos
 -> Map SourcePos (Seq Text, Seq Text)
 -> Map SourcePos (Seq Text, Seq Text))
-> Map SourcePos (Seq Text, Seq Text)
-> [SourcePos]
-> Map SourcePos (Seq Text, Seq Text)
forall a b. (a -> b -> b) -> b -> [a] -> b
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'' = (SourcePos
 -> Map SourcePos (Seq Text, Seq Text)
 -> Map SourcePos (Seq Text, Seq Text))
-> Map SourcePos (Seq Text, Seq Text)
-> [SourcePos]
-> Map SourcePos (Seq Text, Seq Text)
forall a b. (a -> b -> b) -> b -> [a] -> b
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
             (Maybe Text, SourceMap) -> State (Maybe Text, SourceMap) ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (Maybe Text
forall a. Monoid a => a
mempty, Map SourcePos (Seq Text, Seq Text) -> SourceMap
SourceMap Map SourcePos (Seq Text, Seq Text)
sm'')
             a -> State (Maybe Text, SourceMap) a
forall a. a -> StateT (Maybe Text, SourceMap) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> State (Maybe Text, SourceMap) a)
-> a -> State (Maybe Text, SourceMap) a
forall a b. (a -> b) -> a -> b
$! a
res
           Maybe Text
Nothing -> a -> State (Maybe Text, SourceMap) a
forall a. a -> StateT (Maybe Text, SourceMap) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> State (Maybe Text, SourceMap) a)
-> a -> State (Maybe Text, SourceMap) a
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 = State (Maybe Text, SourceMap) a -> (Maybe Text, SourceMap) -> a
forall s a. State s a -> s -> a
evalState State (Maybe Text, SourceMap) a
x (Maybe Text
forall a. Monoid a => a
mempty, SourceMap
forall a. Monoid a => a
mempty)
    in  a -> Text
forall a. ToPlainText a => a -> Text
toPlainText a
v