{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
#include "version-compatibility-macros.h"
module Prettyprinter.Render.Util.SimpleDocTree (
SimpleDocTree(..),
treeForm,
unAnnotateST,
reAnnotateST,
alterAnnotationsST,
renderSimplyDecorated,
renderSimplyDecoratedA,
) where
import Control.Applicative
import Data.Text (Text)
import qualified Data.Text as T
import Data.Typeable (Typeable)
import GHC.Generics
import Prettyprinter
import Prettyprinter.Internal
import Prettyprinter.Render.Util.Panic
import qualified Control.Monad.Fail as Fail
#if !(MONOID_IN_PRELUDE)
import Data.Monoid (Monoid (..))
#endif
#if !(FOLDABLE_TRAVERSABLE_IN_PRELUDE)
import Data.Foldable (Foldable (..))
import Data.Traversable (Traversable (..))
#endif
renderSimplyDecorated
:: Monoid out
=> (Text -> out)
-> (ann -> out -> out)
-> SimpleDocTree ann
-> out
renderSimplyDecorated :: (Text -> out) -> (ann -> out -> out) -> SimpleDocTree ann -> out
renderSimplyDecorated Text -> out
text ann -> out -> out
renderAnn = SimpleDocTree ann -> out
go
where
go :: SimpleDocTree ann -> out
go = \SimpleDocTree ann
sdt -> case SimpleDocTree ann
sdt of
SimpleDocTree ann
STEmpty -> out
forall a. Monoid a => a
mempty
STChar Char
c -> Text -> out
text (Char -> Text
T.singleton Char
c)
STText Int
_ Text
t -> Text -> out
text Text
t
STLine Int
i -> Text -> out
text (Char -> Text
T.singleton Char
'\n') out -> out -> out
forall a. Monoid a => a -> a -> a
`mappend` Text -> out
text (Int -> Text
textSpaces Int
i)
STAnn ann
ann SimpleDocTree ann
rest -> ann -> out -> out
renderAnn ann
ann (SimpleDocTree ann -> out
go SimpleDocTree ann
rest)
STConcat [SimpleDocTree ann]
xs -> (SimpleDocTree ann -> out) -> [SimpleDocTree ann] -> out
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap SimpleDocTree ann -> out
go [SimpleDocTree ann]
xs
{-# INLINE renderSimplyDecorated #-}
renderSimplyDecoratedA
:: (Applicative f, Monoid out)
=> (Text -> f out)
-> (ann -> f out -> f out)
-> SimpleDocTree ann
-> f out
renderSimplyDecoratedA :: (Text -> f out)
-> (ann -> f out -> f out) -> SimpleDocTree ann -> f out
renderSimplyDecoratedA Text -> f out
text ann -> f out -> f out
renderAnn = SimpleDocTree ann -> f out
go
where
go :: SimpleDocTree ann -> f out
go = \SimpleDocTree ann
sdt -> case SimpleDocTree ann
sdt of
SimpleDocTree ann
STEmpty -> out -> f out
forall (f :: * -> *) a. Applicative f => a -> f a
pure out
forall a. Monoid a => a
mempty
STChar Char
c -> Text -> f out
text (Char -> Text
T.singleton Char
c)
STText Int
_ Text
t -> Text -> f out
text Text
t
STLine Int
i -> Text -> f out
text (Char -> Text -> Text
T.cons Char
'\n' (Int -> Text
textSpaces Int
i))
STAnn ann
ann SimpleDocTree ann
rest -> ann -> f out -> f out
renderAnn ann
ann (SimpleDocTree ann -> f out
go SimpleDocTree ann
rest)
STConcat [SimpleDocTree ann]
xs -> ([out] -> out) -> f [out] -> f out
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [out] -> out
forall a. Monoid a => [a] -> a
mconcat ((SimpleDocTree ann -> f out) -> [SimpleDocTree ann] -> f [out]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse SimpleDocTree ann -> f out
go [SimpleDocTree ann]
xs)
{-# INLINE renderSimplyDecoratedA #-}
newtype UniqueParser s a = UniqueParser { UniqueParser s a -> s -> Maybe (a, s)
runParser :: s -> Maybe (a, s) }
deriving Typeable
instance Functor (UniqueParser s) where
fmap :: (a -> b) -> UniqueParser s a -> UniqueParser s b
fmap a -> b
f (UniqueParser s -> Maybe (a, s)
mx) = (s -> Maybe (b, s)) -> UniqueParser s b
forall s a. (s -> Maybe (a, s)) -> UniqueParser s a
UniqueParser (\s
s ->
((a, s) -> (b, s)) -> Maybe (a, s) -> Maybe (b, s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(a
x,s
s') -> (a -> b
f a
x, s
s')) (s -> Maybe (a, s)
mx s
s))
instance Applicative (UniqueParser s) where
pure :: a -> UniqueParser s a
pure a
x = (s -> Maybe (a, s)) -> UniqueParser s a
forall s a. (s -> Maybe (a, s)) -> UniqueParser s a
UniqueParser (\s
rest -> (a, s) -> Maybe (a, s)
forall a. a -> Maybe a
Just (a
x, s
rest))
UniqueParser s -> Maybe (a -> b, s)
mf <*> :: UniqueParser s (a -> b) -> UniqueParser s a -> UniqueParser s b
<*> UniqueParser s -> Maybe (a, s)
mx = (s -> Maybe (b, s)) -> UniqueParser s b
forall s a. (s -> Maybe (a, s)) -> UniqueParser s a
UniqueParser (\s
s -> do
(a -> b
f, s
s') <- s -> Maybe (a -> b, s)
mf s
s
(a
x, s
s'') <- s -> Maybe (a, s)
mx s
s'
(b, s) -> Maybe (b, s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> b
f a
x, s
s'') )
instance Monad (UniqueParser s) where
UniqueParser s -> Maybe (a, s)
p >>= :: UniqueParser s a -> (a -> UniqueParser s b) -> UniqueParser s b
>>= a -> UniqueParser s b
f = (s -> Maybe (b, s)) -> UniqueParser s b
forall s a. (s -> Maybe (a, s)) -> UniqueParser s a
UniqueParser (\s
s -> do
(a
a', s
s') <- s -> Maybe (a, s)
p s
s
let UniqueParser s -> Maybe (b, s)
p' = a -> UniqueParser s b
f a
a'
s -> Maybe (b, s)
p' s
s' )
#if !(APPLICATIVE_MONAD)
return = pure
#endif
#if FAIL_IN_MONAD
fail = Fail.fail
#endif
instance Fail.MonadFail (UniqueParser s) where
fail :: String -> UniqueParser s a
fail String
_err = UniqueParser s a
forall (f :: * -> *) a. Alternative f => f a
empty
instance Alternative (UniqueParser s) where
empty :: UniqueParser s a
empty = (s -> Maybe (a, s)) -> UniqueParser s a
forall s a. (s -> Maybe (a, s)) -> UniqueParser s a
UniqueParser (Maybe (a, s) -> s -> Maybe (a, s)
forall a b. a -> b -> a
const Maybe (a, s)
forall (f :: * -> *) a. Alternative f => f a
empty)
UniqueParser s -> Maybe (a, s)
p <|> :: UniqueParser s a -> UniqueParser s a -> UniqueParser s a
<|> UniqueParser s -> Maybe (a, s)
q = (s -> Maybe (a, s)) -> UniqueParser s a
forall s a. (s -> Maybe (a, s)) -> UniqueParser s a
UniqueParser (\s
s -> s -> Maybe (a, s)
p s
s Maybe (a, s) -> Maybe (a, s) -> Maybe (a, s)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> s -> Maybe (a, s)
q s
s)
data SimpleDocTok ann
= TokEmpty
| TokChar Char
| TokText !Int Text
| TokLine Int
| TokAnnPush ann
| TokAnnPop
deriving (SimpleDocTok ann -> SimpleDocTok ann -> Bool
(SimpleDocTok ann -> SimpleDocTok ann -> Bool)
-> (SimpleDocTok ann -> SimpleDocTok ann -> Bool)
-> Eq (SimpleDocTok ann)
forall ann. Eq ann => SimpleDocTok ann -> SimpleDocTok ann -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SimpleDocTok ann -> SimpleDocTok ann -> Bool
$c/= :: forall ann. Eq ann => SimpleDocTok ann -> SimpleDocTok ann -> Bool
== :: SimpleDocTok ann -> SimpleDocTok ann -> Bool
$c== :: forall ann. Eq ann => SimpleDocTok ann -> SimpleDocTok ann -> Bool
Eq, Eq (SimpleDocTok ann)
Eq (SimpleDocTok ann)
-> (SimpleDocTok ann -> SimpleDocTok ann -> Ordering)
-> (SimpleDocTok ann -> SimpleDocTok ann -> Bool)
-> (SimpleDocTok ann -> SimpleDocTok ann -> Bool)
-> (SimpleDocTok ann -> SimpleDocTok ann -> Bool)
-> (SimpleDocTok ann -> SimpleDocTok ann -> Bool)
-> (SimpleDocTok ann -> SimpleDocTok ann -> SimpleDocTok ann)
-> (SimpleDocTok ann -> SimpleDocTok ann -> SimpleDocTok ann)
-> Ord (SimpleDocTok ann)
SimpleDocTok ann -> SimpleDocTok ann -> Bool
SimpleDocTok ann -> SimpleDocTok ann -> Ordering
SimpleDocTok ann -> SimpleDocTok ann -> SimpleDocTok ann
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
forall ann. Ord ann => Eq (SimpleDocTok ann)
forall ann. Ord ann => SimpleDocTok ann -> SimpleDocTok ann -> Bool
forall ann.
Ord ann =>
SimpleDocTok ann -> SimpleDocTok ann -> Ordering
forall ann.
Ord ann =>
SimpleDocTok ann -> SimpleDocTok ann -> SimpleDocTok ann
min :: SimpleDocTok ann -> SimpleDocTok ann -> SimpleDocTok ann
$cmin :: forall ann.
Ord ann =>
SimpleDocTok ann -> SimpleDocTok ann -> SimpleDocTok ann
max :: SimpleDocTok ann -> SimpleDocTok ann -> SimpleDocTok ann
$cmax :: forall ann.
Ord ann =>
SimpleDocTok ann -> SimpleDocTok ann -> SimpleDocTok ann
>= :: SimpleDocTok ann -> SimpleDocTok ann -> Bool
$c>= :: forall ann. Ord ann => SimpleDocTok ann -> SimpleDocTok ann -> Bool
> :: SimpleDocTok ann -> SimpleDocTok ann -> Bool
$c> :: forall ann. Ord ann => SimpleDocTok ann -> SimpleDocTok ann -> Bool
<= :: SimpleDocTok ann -> SimpleDocTok ann -> Bool
$c<= :: forall ann. Ord ann => SimpleDocTok ann -> SimpleDocTok ann -> Bool
< :: SimpleDocTok ann -> SimpleDocTok ann -> Bool
$c< :: forall ann. Ord ann => SimpleDocTok ann -> SimpleDocTok ann -> Bool
compare :: SimpleDocTok ann -> SimpleDocTok ann -> Ordering
$ccompare :: forall ann.
Ord ann =>
SimpleDocTok ann -> SimpleDocTok ann -> Ordering
$cp1Ord :: forall ann. Ord ann => Eq (SimpleDocTok ann)
Ord, Int -> SimpleDocTok ann -> ShowS
[SimpleDocTok ann] -> ShowS
SimpleDocTok ann -> String
(Int -> SimpleDocTok ann -> ShowS)
-> (SimpleDocTok ann -> String)
-> ([SimpleDocTok ann] -> ShowS)
-> Show (SimpleDocTok ann)
forall ann. Show ann => Int -> SimpleDocTok ann -> ShowS
forall ann. Show ann => [SimpleDocTok ann] -> ShowS
forall ann. Show ann => SimpleDocTok ann -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SimpleDocTok ann] -> ShowS
$cshowList :: forall ann. Show ann => [SimpleDocTok ann] -> ShowS
show :: SimpleDocTok ann -> String
$cshow :: forall ann. Show ann => SimpleDocTok ann -> String
showsPrec :: Int -> SimpleDocTok ann -> ShowS
$cshowsPrec :: forall ann. Show ann => Int -> SimpleDocTok ann -> ShowS
Show, Typeable)
data SimpleDocTree ann
= STEmpty
| STChar Char
| STText !Int Text
| STLine !Int
| STAnn ann (SimpleDocTree ann)
| STConcat [SimpleDocTree ann]
deriving (SimpleDocTree ann -> SimpleDocTree ann -> Bool
(SimpleDocTree ann -> SimpleDocTree ann -> Bool)
-> (SimpleDocTree ann -> SimpleDocTree ann -> Bool)
-> Eq (SimpleDocTree ann)
forall ann.
Eq ann =>
SimpleDocTree ann -> SimpleDocTree ann -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SimpleDocTree ann -> SimpleDocTree ann -> Bool
$c/= :: forall ann.
Eq ann =>
SimpleDocTree ann -> SimpleDocTree ann -> Bool
== :: SimpleDocTree ann -> SimpleDocTree ann -> Bool
$c== :: forall ann.
Eq ann =>
SimpleDocTree ann -> SimpleDocTree ann -> Bool
Eq, Eq (SimpleDocTree ann)
Eq (SimpleDocTree ann)
-> (SimpleDocTree ann -> SimpleDocTree ann -> Ordering)
-> (SimpleDocTree ann -> SimpleDocTree ann -> Bool)
-> (SimpleDocTree ann -> SimpleDocTree ann -> Bool)
-> (SimpleDocTree ann -> SimpleDocTree ann -> Bool)
-> (SimpleDocTree ann -> SimpleDocTree ann -> Bool)
-> (SimpleDocTree ann -> SimpleDocTree ann -> SimpleDocTree ann)
-> (SimpleDocTree ann -> SimpleDocTree ann -> SimpleDocTree ann)
-> Ord (SimpleDocTree ann)
SimpleDocTree ann -> SimpleDocTree ann -> Bool
SimpleDocTree ann -> SimpleDocTree ann -> Ordering
SimpleDocTree ann -> SimpleDocTree ann -> SimpleDocTree ann
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
forall ann. Ord ann => Eq (SimpleDocTree ann)
forall ann.
Ord ann =>
SimpleDocTree ann -> SimpleDocTree ann -> Bool
forall ann.
Ord ann =>
SimpleDocTree ann -> SimpleDocTree ann -> Ordering
forall ann.
Ord ann =>
SimpleDocTree ann -> SimpleDocTree ann -> SimpleDocTree ann
min :: SimpleDocTree ann -> SimpleDocTree ann -> SimpleDocTree ann
$cmin :: forall ann.
Ord ann =>
SimpleDocTree ann -> SimpleDocTree ann -> SimpleDocTree ann
max :: SimpleDocTree ann -> SimpleDocTree ann -> SimpleDocTree ann
$cmax :: forall ann.
Ord ann =>
SimpleDocTree ann -> SimpleDocTree ann -> SimpleDocTree ann
>= :: SimpleDocTree ann -> SimpleDocTree ann -> Bool
$c>= :: forall ann.
Ord ann =>
SimpleDocTree ann -> SimpleDocTree ann -> Bool
> :: SimpleDocTree ann -> SimpleDocTree ann -> Bool
$c> :: forall ann.
Ord ann =>
SimpleDocTree ann -> SimpleDocTree ann -> Bool
<= :: SimpleDocTree ann -> SimpleDocTree ann -> Bool
$c<= :: forall ann.
Ord ann =>
SimpleDocTree ann -> SimpleDocTree ann -> Bool
< :: SimpleDocTree ann -> SimpleDocTree ann -> Bool
$c< :: forall ann.
Ord ann =>
SimpleDocTree ann -> SimpleDocTree ann -> Bool
compare :: SimpleDocTree ann -> SimpleDocTree ann -> Ordering
$ccompare :: forall ann.
Ord ann =>
SimpleDocTree ann -> SimpleDocTree ann -> Ordering
$cp1Ord :: forall ann. Ord ann => Eq (SimpleDocTree ann)
Ord, Int -> SimpleDocTree ann -> ShowS
[SimpleDocTree ann] -> ShowS
SimpleDocTree ann -> String
(Int -> SimpleDocTree ann -> ShowS)
-> (SimpleDocTree ann -> String)
-> ([SimpleDocTree ann] -> ShowS)
-> Show (SimpleDocTree ann)
forall ann. Show ann => Int -> SimpleDocTree ann -> ShowS
forall ann. Show ann => [SimpleDocTree ann] -> ShowS
forall ann. Show ann => SimpleDocTree ann -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SimpleDocTree ann] -> ShowS
$cshowList :: forall ann. Show ann => [SimpleDocTree ann] -> ShowS
show :: SimpleDocTree ann -> String
$cshow :: forall ann. Show ann => SimpleDocTree ann -> String
showsPrec :: Int -> SimpleDocTree ann -> ShowS
$cshowsPrec :: forall ann. Show ann => Int -> SimpleDocTree ann -> ShowS
Show, (forall x. SimpleDocTree ann -> Rep (SimpleDocTree ann) x)
-> (forall x. Rep (SimpleDocTree ann) x -> SimpleDocTree ann)
-> Generic (SimpleDocTree ann)
forall x. Rep (SimpleDocTree ann) x -> SimpleDocTree ann
forall x. SimpleDocTree ann -> Rep (SimpleDocTree ann) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall ann x. Rep (SimpleDocTree ann) x -> SimpleDocTree ann
forall ann x. SimpleDocTree ann -> Rep (SimpleDocTree ann) x
$cto :: forall ann x. Rep (SimpleDocTree ann) x -> SimpleDocTree ann
$cfrom :: forall ann x. SimpleDocTree ann -> Rep (SimpleDocTree ann) x
Generic, Typeable)
instance Functor SimpleDocTree where
fmap :: (a -> b) -> SimpleDocTree a -> SimpleDocTree b
fmap = (a -> b) -> SimpleDocTree a -> SimpleDocTree b
forall a b. (a -> b) -> SimpleDocTree a -> SimpleDocTree b
reAnnotateST
nextToken :: UniqueParser (SimpleDocStream ann) (SimpleDocTok ann)
nextToken :: UniqueParser (SimpleDocStream ann) (SimpleDocTok ann)
nextToken = (SimpleDocStream ann
-> Maybe (SimpleDocTok ann, SimpleDocStream ann))
-> UniqueParser (SimpleDocStream ann) (SimpleDocTok ann)
forall s a. (s -> Maybe (a, s)) -> UniqueParser s a
UniqueParser (\SimpleDocStream ann
sds -> case SimpleDocStream ann
sds of
SimpleDocStream ann
SFail -> Maybe (SimpleDocTok ann, SimpleDocStream ann)
forall void. void
panicUncaughtFail
SimpleDocStream ann
SEmpty -> Maybe (SimpleDocTok ann, SimpleDocStream ann)
forall (f :: * -> *) a. Alternative f => f a
empty
SChar Char
c SimpleDocStream ann
rest -> (SimpleDocTok ann, SimpleDocStream ann)
-> Maybe (SimpleDocTok ann, SimpleDocStream ann)
forall a. a -> Maybe a
Just (Char -> SimpleDocTok ann
forall ann. Char -> SimpleDocTok ann
TokChar Char
c , SimpleDocStream ann
rest)
SText Int
l Text
t SimpleDocStream ann
rest -> (SimpleDocTok ann, SimpleDocStream ann)
-> Maybe (SimpleDocTok ann, SimpleDocStream ann)
forall a. a -> Maybe a
Just (Int -> Text -> SimpleDocTok ann
forall ann. Int -> Text -> SimpleDocTok ann
TokText Int
l Text
t , SimpleDocStream ann
rest)
SLine Int
i SimpleDocStream ann
rest -> (SimpleDocTok ann, SimpleDocStream ann)
-> Maybe (SimpleDocTok ann, SimpleDocStream ann)
forall a. a -> Maybe a
Just (Int -> SimpleDocTok ann
forall ann. Int -> SimpleDocTok ann
TokLine Int
i , SimpleDocStream ann
rest)
SAnnPush ann
ann SimpleDocStream ann
rest -> (SimpleDocTok ann, SimpleDocStream ann)
-> Maybe (SimpleDocTok ann, SimpleDocStream ann)
forall a. a -> Maybe a
Just (ann -> SimpleDocTok ann
forall ann. ann -> SimpleDocTok ann
TokAnnPush ann
ann , SimpleDocStream ann
rest)
SAnnPop SimpleDocStream ann
rest -> (SimpleDocTok ann, SimpleDocStream ann)
-> Maybe (SimpleDocTok ann, SimpleDocStream ann)
forall a. a -> Maybe a
Just (SimpleDocTok ann
forall ann. SimpleDocTok ann
TokAnnPop , SimpleDocStream ann
rest) )
sdocToTreeParser :: UniqueParser (SimpleDocStream ann) (SimpleDocTree ann)
sdocToTreeParser :: UniqueParser (SimpleDocStream ann) (SimpleDocTree ann)
sdocToTreeParser = ([SimpleDocTree ann] -> SimpleDocTree ann)
-> UniqueParser (SimpleDocStream ann) [SimpleDocTree ann]
-> UniqueParser (SimpleDocStream ann) (SimpleDocTree ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [SimpleDocTree ann] -> SimpleDocTree ann
forall ann. [SimpleDocTree ann] -> SimpleDocTree ann
wrap (UniqueParser (SimpleDocStream ann) (SimpleDocTree ann)
-> UniqueParser (SimpleDocStream ann) [SimpleDocTree ann]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many UniqueParser (SimpleDocStream ann) (SimpleDocTree ann)
forall ann. UniqueParser (SimpleDocStream ann) (SimpleDocTree ann)
contentPiece)
where
wrap :: [SimpleDocTree ann] -> SimpleDocTree ann
wrap :: [SimpleDocTree ann] -> SimpleDocTree ann
wrap = \[SimpleDocTree ann]
sdts -> case [SimpleDocTree ann]
sdts of
[] -> SimpleDocTree ann
forall ann. SimpleDocTree ann
STEmpty
[SimpleDocTree ann
x] -> SimpleDocTree ann
x
[SimpleDocTree ann]
xs -> [SimpleDocTree ann] -> SimpleDocTree ann
forall ann. [SimpleDocTree ann] -> SimpleDocTree ann
STConcat [SimpleDocTree ann]
xs
contentPiece :: UniqueParser (SimpleDocStream ann) (SimpleDocTree ann)
contentPiece = UniqueParser (SimpleDocStream ann) (SimpleDocTok ann)
forall ann. UniqueParser (SimpleDocStream ann) (SimpleDocTok ann)
nextToken UniqueParser (SimpleDocStream ann) (SimpleDocTok ann)
-> (SimpleDocTok ann
-> UniqueParser (SimpleDocStream ann) (SimpleDocTree ann))
-> UniqueParser (SimpleDocStream ann) (SimpleDocTree ann)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SimpleDocTok ann
tok -> case SimpleDocTok ann
tok of
SimpleDocTok ann
TokEmpty -> SimpleDocTree ann
-> UniqueParser (SimpleDocStream ann) (SimpleDocTree ann)
forall (f :: * -> *) a. Applicative f => a -> f a
pure SimpleDocTree ann
forall ann. SimpleDocTree ann
STEmpty
TokChar Char
c -> SimpleDocTree ann
-> UniqueParser (SimpleDocStream ann) (SimpleDocTree ann)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> SimpleDocTree ann
forall ann. Char -> SimpleDocTree ann
STChar Char
c)
TokText Int
l Text
t -> SimpleDocTree ann
-> UniqueParser (SimpleDocStream ann) (SimpleDocTree ann)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Text -> SimpleDocTree ann
forall ann. Int -> Text -> SimpleDocTree ann
STText Int
l Text
t)
TokLine Int
i -> SimpleDocTree ann
-> UniqueParser (SimpleDocStream ann) (SimpleDocTree ann)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> SimpleDocTree ann
forall ann. Int -> SimpleDocTree ann
STLine Int
i)
SimpleDocTok ann
TokAnnPop -> UniqueParser (SimpleDocStream ann) (SimpleDocTree ann)
forall (f :: * -> *) a. Alternative f => f a
empty
TokAnnPush ann
ann -> do SimpleDocTree ann
annotatedContents <- UniqueParser (SimpleDocStream ann) (SimpleDocTree ann)
forall ann. UniqueParser (SimpleDocStream ann) (SimpleDocTree ann)
sdocToTreeParser
SimpleDocTok ann
TokAnnPop <- UniqueParser (SimpleDocStream ann) (SimpleDocTok ann)
forall ann. UniqueParser (SimpleDocStream ann) (SimpleDocTok ann)
nextToken
SimpleDocTree ann
-> UniqueParser (SimpleDocStream ann) (SimpleDocTree ann)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ann -> SimpleDocTree ann -> SimpleDocTree ann
forall ann. ann -> SimpleDocTree ann -> SimpleDocTree ann
STAnn ann
ann SimpleDocTree ann
annotatedContents)
treeForm :: SimpleDocStream ann -> SimpleDocTree ann
treeForm :: SimpleDocStream ann -> SimpleDocTree ann
treeForm SimpleDocStream ann
sdoc = case UniqueParser (SimpleDocStream ann) (SimpleDocTree ann)
-> SimpleDocStream ann
-> Maybe (SimpleDocTree ann, SimpleDocStream ann)
forall s a. UniqueParser s a -> s -> Maybe (a, s)
runParser UniqueParser (SimpleDocStream ann) (SimpleDocTree ann)
forall ann. UniqueParser (SimpleDocStream ann) (SimpleDocTree ann)
sdocToTreeParser SimpleDocStream ann
sdoc of
Maybe (SimpleDocTree ann, SimpleDocStream ann)
Nothing -> SimpleDocTree ann
forall void. void
panicSimpleDocTreeConversionFailed
Just (SimpleDocTree ann
sdoct, SimpleDocStream ann
SEmpty) -> SimpleDocTree ann
sdoct
Just (SimpleDocTree ann
_, SimpleDocStream ann
_unconsumed) -> SimpleDocTree ann
forall void. void
panicInputNotFullyConsumed
unAnnotateST :: SimpleDocTree ann -> SimpleDocTree xxx
unAnnotateST :: SimpleDocTree ann -> SimpleDocTree xxx
unAnnotateST = (ann -> [xxx]) -> SimpleDocTree ann -> SimpleDocTree xxx
forall ann ann'.
(ann -> [ann']) -> SimpleDocTree ann -> SimpleDocTree ann'
alterAnnotationsST ([xxx] -> ann -> [xxx]
forall a b. a -> b -> a
const [])
reAnnotateST :: (ann -> ann') -> SimpleDocTree ann -> SimpleDocTree ann'
reAnnotateST :: (ann -> ann') -> SimpleDocTree ann -> SimpleDocTree ann'
reAnnotateST ann -> ann'
f = (ann -> [ann']) -> SimpleDocTree ann -> SimpleDocTree ann'
forall ann ann'.
(ann -> [ann']) -> SimpleDocTree ann -> SimpleDocTree ann'
alterAnnotationsST (ann' -> [ann']
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ann' -> [ann']) -> (ann -> ann') -> ann -> [ann']
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ann -> ann'
f)
alterAnnotationsST :: (ann -> [ann']) -> SimpleDocTree ann -> SimpleDocTree ann'
alterAnnotationsST :: (ann -> [ann']) -> SimpleDocTree ann -> SimpleDocTree ann'
alterAnnotationsST ann -> [ann']
re = SimpleDocTree ann -> SimpleDocTree ann'
go
where
go :: SimpleDocTree ann -> SimpleDocTree ann'
go = \SimpleDocTree ann
sdt -> case SimpleDocTree ann
sdt of
SimpleDocTree ann
STEmpty -> SimpleDocTree ann'
forall ann. SimpleDocTree ann
STEmpty
STChar Char
c -> Char -> SimpleDocTree ann'
forall ann. Char -> SimpleDocTree ann
STChar Char
c
STText Int
l Text
t -> Int -> Text -> SimpleDocTree ann'
forall ann. Int -> Text -> SimpleDocTree ann
STText Int
l Text
t
STLine Int
i -> Int -> SimpleDocTree ann'
forall ann. Int -> SimpleDocTree ann
STLine Int
i
STConcat [SimpleDocTree ann]
xs -> [SimpleDocTree ann'] -> SimpleDocTree ann'
forall ann. [SimpleDocTree ann] -> SimpleDocTree ann
STConcat ((SimpleDocTree ann -> SimpleDocTree ann')
-> [SimpleDocTree ann] -> [SimpleDocTree ann']
forall a b. (a -> b) -> [a] -> [b]
map SimpleDocTree ann -> SimpleDocTree ann'
go [SimpleDocTree ann]
xs)
STAnn ann
ann SimpleDocTree ann
rest -> (ann' -> SimpleDocTree ann' -> SimpleDocTree ann')
-> SimpleDocTree ann' -> [ann'] -> SimpleDocTree ann'
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Prelude.foldr ann' -> SimpleDocTree ann' -> SimpleDocTree ann'
forall ann. ann -> SimpleDocTree ann -> SimpleDocTree ann
STAnn (SimpleDocTree ann -> SimpleDocTree ann'
go SimpleDocTree ann
rest) (ann -> [ann']
re ann
ann)
instance Foldable SimpleDocTree where
foldMap :: (a -> m) -> SimpleDocTree a -> m
foldMap a -> m
f = SimpleDocTree a -> m
go
where
go :: SimpleDocTree a -> m
go = \SimpleDocTree a
sdt -> case SimpleDocTree a
sdt of
SimpleDocTree a
STEmpty -> m
forall a. Monoid a => a
mempty
STChar Char
_ -> m
forall a. Monoid a => a
mempty
STText Int
_ Text
_ -> m
forall a. Monoid a => a
mempty
STLine Int
_ -> m
forall a. Monoid a => a
mempty
STAnn a
ann SimpleDocTree a
rest -> a -> m
f a
ann m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` SimpleDocTree a -> m
go SimpleDocTree a
rest
STConcat [SimpleDocTree a]
xs -> [m] -> m
forall a. Monoid a => [a] -> a
mconcat ((SimpleDocTree a -> m) -> [SimpleDocTree a] -> [m]
forall a b. (a -> b) -> [a] -> [b]
map SimpleDocTree a -> m
go [SimpleDocTree a]
xs)
instance Traversable SimpleDocTree where
traverse :: (a -> f b) -> SimpleDocTree a -> f (SimpleDocTree b)
traverse a -> f b
f = SimpleDocTree a -> f (SimpleDocTree b)
go
where
go :: SimpleDocTree a -> f (SimpleDocTree b)
go = \SimpleDocTree a
sdt -> case SimpleDocTree a
sdt of
SimpleDocTree a
STEmpty -> SimpleDocTree b -> f (SimpleDocTree b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure SimpleDocTree b
forall ann. SimpleDocTree ann
STEmpty
STChar Char
c -> SimpleDocTree b -> f (SimpleDocTree b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> SimpleDocTree b
forall ann. Char -> SimpleDocTree ann
STChar Char
c)
STText Int
l Text
t -> SimpleDocTree b -> f (SimpleDocTree b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Text -> SimpleDocTree b
forall ann. Int -> Text -> SimpleDocTree ann
STText Int
l Text
t)
STLine Int
i -> SimpleDocTree b -> f (SimpleDocTree b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> SimpleDocTree b
forall ann. Int -> SimpleDocTree ann
STLine Int
i)
STAnn a
ann SimpleDocTree a
rest -> b -> SimpleDocTree b -> SimpleDocTree b
forall ann. ann -> SimpleDocTree ann -> SimpleDocTree ann
STAnn (b -> SimpleDocTree b -> SimpleDocTree b)
-> f b -> f (SimpleDocTree b -> SimpleDocTree b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
ann f (SimpleDocTree b -> SimpleDocTree b)
-> f (SimpleDocTree b) -> f (SimpleDocTree b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SimpleDocTree a -> f (SimpleDocTree b)
go SimpleDocTree a
rest
STConcat [SimpleDocTree a]
xs -> [SimpleDocTree b] -> SimpleDocTree b
forall ann. [SimpleDocTree ann] -> SimpleDocTree ann
STConcat ([SimpleDocTree b] -> SimpleDocTree b)
-> f [SimpleDocTree b] -> f (SimpleDocTree b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SimpleDocTree a -> f (SimpleDocTree b))
-> [SimpleDocTree a] -> f [SimpleDocTree b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse SimpleDocTree a -> f (SimpleDocTree b)
go [SimpleDocTree a]
xs