{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE CPP #-}
module Language.Haskell.Exts.ExactPrint
( exactPrint
, ExactP
) where
import Language.Haskell.Exts.Syntax
import Language.Haskell.Exts.SrcLoc
import Language.Haskell.Exts.Comments
import Control.Monad (when, liftM, ap, unless)
import qualified Control.Monad.Fail as Fail
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative (Applicative(..))
#endif
import Control.Arrow ((***), (&&&))
import Prelude hiding (exp)
import Data.List (intersperse)
type Pos = (Int,Int)
pos :: (SrcInfo loc) => loc -> Pos
pos :: loc -> Pos
pos loc
ss = (loc -> Int
forall si. SrcInfo si => si -> Int
startLine loc
ss, loc -> Int
forall si. SrcInfo si => si -> Int
startColumn loc
ss)
newtype EP x = EP (Pos -> [Comment] -> (x, Pos, [Comment], ShowS))
instance Functor EP where
fmap :: (a -> b) -> EP a -> EP b
fmap = (a -> b) -> EP a -> EP b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
instance Applicative EP where
pure :: a -> EP a
pure = a -> EP a
forall (m :: * -> *) a. Monad m => a -> m a
return
<*> :: EP (a -> b) -> EP a -> EP b
(<*>) = EP (a -> b) -> EP a -> EP b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Monad EP where
return :: a -> EP a
return a
x = (Pos -> [Comment] -> (a, Pos, [Comment], ShowS)) -> EP a
forall x. (Pos -> [Comment] -> (x, Pos, [Comment], ShowS)) -> EP x
EP ((Pos -> [Comment] -> (a, Pos, [Comment], ShowS)) -> EP a)
-> (Pos -> [Comment] -> (a, Pos, [Comment], ShowS)) -> EP a
forall a b. (a -> b) -> a -> b
$ \Pos
l [Comment]
cs -> (a
x, Pos
l, [Comment]
cs, ShowS
forall a. a -> a
id)
EP Pos -> [Comment] -> (a, Pos, [Comment], ShowS)
m >>= :: EP a -> (a -> EP b) -> EP b
>>= a -> EP b
k = (Pos -> [Comment] -> (b, Pos, [Comment], ShowS)) -> EP b
forall x. (Pos -> [Comment] -> (x, Pos, [Comment], ShowS)) -> EP x
EP ((Pos -> [Comment] -> (b, Pos, [Comment], ShowS)) -> EP b)
-> (Pos -> [Comment] -> (b, Pos, [Comment], ShowS)) -> EP b
forall a b. (a -> b) -> a -> b
$ \Pos
l0 [Comment]
c0 -> let
(a
a, Pos
l1, [Comment]
c1, ShowS
s1) = Pos -> [Comment] -> (a, Pos, [Comment], ShowS)
m Pos
l0 [Comment]
c0
EP Pos -> [Comment] -> (b, Pos, [Comment], ShowS)
f = a -> EP b
k a
a
(b
b, Pos
l2, [Comment]
c2, ShowS
s2) = Pos -> [Comment] -> (b, Pos, [Comment], ShowS)
f Pos
l1 [Comment]
c1
in (b
b, Pos
l2, [Comment]
c2, ShowS
s1 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s2)
instance Fail.MonadFail EP where
fail :: String -> EP a
fail = String -> EP a
forall a. HasCallStack => String -> a
error
runEP :: EP () -> [Comment] -> String
runEP :: EP () -> [Comment] -> String
runEP (EP Pos -> [Comment] -> ((), Pos, [Comment], ShowS)
f) [Comment]
cs = let (()
_,Pos
_,[Comment]
_,ShowS
s) = Pos -> [Comment] -> ((), Pos, [Comment], ShowS)
f (Int
1,Int
1) [Comment]
cs in ShowS
s String
""
getPos :: EP Pos
getPos :: EP Pos
getPos = (Pos -> [Comment] -> (Pos, Pos, [Comment], ShowS)) -> EP Pos
forall x. (Pos -> [Comment] -> (x, Pos, [Comment], ShowS)) -> EP x
EP (\Pos
l [Comment]
cs -> (Pos
l,Pos
l,[Comment]
cs,ShowS
forall a. a -> a
id))
setPos :: Pos -> EP ()
setPos :: Pos -> EP ()
setPos Pos
l = (Pos -> [Comment] -> ((), Pos, [Comment], ShowS)) -> EP ()
forall x. (Pos -> [Comment] -> (x, Pos, [Comment], ShowS)) -> EP x
EP (\Pos
_ [Comment]
cs -> ((),Pos
l,[Comment]
cs,ShowS
forall a. a -> a
id))
printString :: String -> EP ()
printString :: String -> EP ()
printString String
str =
(Pos -> [Comment] -> ((), Pos, [Comment], ShowS)) -> EP ()
forall x. (Pos -> [Comment] -> (x, Pos, [Comment], ShowS)) -> EP x
EP (\(Int
l,Int
c) [Comment]
cs -> let (Int
l', Int
c') = (Pos -> Char -> Pos) -> Pos -> String -> Pos
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Pos -> Char -> Pos
forall a b. (Num a, Num b) => (a, b) -> Char -> (a, b)
go (Int
l, Int
c) String
str
go :: (a, b) -> Char -> (a, b)
go (a
cl, b
_) Char
'\n' = (a
cl a -> a -> a
forall a. Num a => a -> a -> a
+ a
1, b
1)
go (a
cl, b
cc) Char
_ = (a
cl, b
cc b -> b -> b
forall a. Num a => a -> a -> a
+ b
1)
in ((), (Int
l', Int
c'), [Comment]
cs, String -> ShowS
showString String
str))
getComment :: EP (Maybe Comment)
= (Pos -> [Comment] -> (Maybe Comment, Pos, [Comment], ShowS))
-> EP (Maybe Comment)
forall x. (Pos -> [Comment] -> (x, Pos, [Comment], ShowS)) -> EP x
EP ((Pos -> [Comment] -> (Maybe Comment, Pos, [Comment], ShowS))
-> EP (Maybe Comment))
-> (Pos -> [Comment] -> (Maybe Comment, Pos, [Comment], ShowS))
-> EP (Maybe Comment)
forall a b. (a -> b) -> a -> b
$ \Pos
l [Comment]
cs ->
let x :: Maybe Comment
x = case [Comment]
cs of
Comment
c:[Comment]
_ -> Comment -> Maybe Comment
forall a. a -> Maybe a
Just Comment
c
[Comment]
_ -> Maybe Comment
forall a. Maybe a
Nothing
in (Maybe Comment
x, Pos
l, [Comment]
cs, ShowS
forall a. a -> a
id)
dropComment :: EP ()
= (Pos -> [Comment] -> ((), Pos, [Comment], ShowS)) -> EP ()
forall x. (Pos -> [Comment] -> (x, Pos, [Comment], ShowS)) -> EP x
EP ((Pos -> [Comment] -> ((), Pos, [Comment], ShowS)) -> EP ())
-> (Pos -> [Comment] -> ((), Pos, [Comment], ShowS)) -> EP ()
forall a b. (a -> b) -> a -> b
$ \Pos
l [Comment]
cs ->
let cs' :: [Comment]
cs' = case [Comment]
cs of
(Comment
_:[Comment]
cs1) -> [Comment]
cs1
[Comment]
_ -> [Comment]
cs
in ((), Pos
l, [Comment]
cs', ShowS
forall a. a -> a
id)
newLine :: EP ()
newLine :: EP ()
newLine = do
(Int
l,Int
_) <- EP Pos
getPos
String -> EP ()
printString String
"\n"
Pos -> EP ()
setPos (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1,Int
1)
padUntil :: Pos -> EP ()
padUntil :: Pos -> EP ()
padUntil (Int
l,Int
c) = do
(Int
l1,Int
c1) <- EP Pos
getPos
case () of
()
_ | Int
l1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
l Bool -> Bool -> Bool
&& Int
c1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
c -> String -> EP ()
printString (String -> EP ()) -> String -> EP ()
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
c1) Char
' '
| Int
l1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
l -> EP ()
newLine EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pos -> EP ()
padUntil (Int
l,Int
c)
| Bool
otherwise -> () -> EP ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
mPrintComments :: Pos -> EP ()
Pos
p = do
Maybe Comment
mc <- EP (Maybe Comment)
getComment
case Maybe Comment
mc of
Maybe Comment
Nothing -> () -> EP ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just (Comment Bool
multi SrcSpan
s String
str) ->
Bool -> EP () -> EP ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
s Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
< Pos
p) (EP () -> EP ()) -> EP () -> EP ()
forall a b. (a -> b) -> a -> b
$ do
EP ()
dropComment
Pos -> EP ()
padUntil (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
s)
Bool -> String -> EP ()
printComment Bool
multi String
str
Pos -> EP ()
setPos (SrcSpan -> Int
srcSpanEndLine SrcSpan
s, SrcSpan -> Int
srcSpanEndColumn SrcSpan
s)
Pos -> EP ()
mPrintComments Pos
p
printComment :: Bool -> String -> EP ()
Bool
b String
str
| Bool
b = String -> EP ()
printString (String -> EP ()) -> String -> EP ()
forall a b. (a -> b) -> a -> b
$ String
"{-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
str String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"-}"
| Bool
otherwise = String -> EP ()
printString (String -> EP ()) -> String -> EP ()
forall a b. (a -> b) -> a -> b
$ String
"--" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
str
printWhitespace :: Pos -> EP ()
printWhitespace :: Pos -> EP ()
printWhitespace Pos
p = Pos -> EP ()
mPrintComments Pos
p EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pos -> EP ()
padUntil Pos
p
printStringAt :: Pos -> String -> EP ()
printStringAt :: Pos -> String -> EP ()
printStringAt Pos
p String
str = Pos -> EP ()
printWhitespace Pos
p EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> EP ()
printString String
str
errorEP :: String -> EP a
errorEP :: String -> EP a
errorEP = String -> EP a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
exactPrint :: (ExactP ast) => ast SrcSpanInfo -> [Comment] -> String
exactPrint :: ast SrcSpanInfo -> [Comment] -> String
exactPrint ast SrcSpanInfo
ast = EP () -> [Comment] -> String
runEP (ast SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC ast SrcSpanInfo
ast)
exactPC :: (ExactP ast) => ast SrcSpanInfo -> EP ()
exactPC :: ast SrcSpanInfo -> EP ()
exactPC ast SrcSpanInfo
ast = let p :: Pos
p = SrcSpanInfo -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos (ast SrcSpanInfo -> SrcSpanInfo
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann ast SrcSpanInfo
ast) in Pos -> EP ()
mPrintComments Pos
p EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pos -> EP ()
padUntil Pos
p EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ast SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP ast SrcSpanInfo
ast
printSeq :: [(Pos, EP ())] -> EP ()
printSeq :: [(Pos, EP ())] -> EP ()
printSeq [] = () -> EP ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
printSeq ((Pos
p,EP ()
pr):[(Pos, EP ())]
xs) = Pos -> EP ()
printWhitespace Pos
p EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EP ()
pr EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [(Pos, EP ())] -> EP ()
printSeq [(Pos, EP ())]
xs
printStrs :: SrcInfo loc => [(loc, String)] -> EP ()
printStrs :: [(loc, String)] -> EP ()
printStrs = [(Pos, EP ())] -> EP ()
printSeq ([(Pos, EP ())] -> EP ())
-> ([(loc, String)] -> [(Pos, EP ())]) -> [(loc, String)] -> EP ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((loc, String) -> (Pos, EP ()))
-> [(loc, String)] -> [(Pos, EP ())]
forall a b. (a -> b) -> [a] -> [b]
map (loc -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos (loc -> Pos) -> (String -> EP ()) -> (loc, String) -> (Pos, EP ())
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** String -> EP ()
printString)
printPoints :: SrcSpanInfo -> [String] -> EP ()
printPoints :: SrcSpanInfo -> [String] -> EP ()
printPoints SrcSpanInfo
l = [(SrcSpan, String)] -> EP ()
forall loc. SrcInfo loc => [(loc, String)] -> EP ()
printStrs ([(SrcSpan, String)] -> EP ())
-> ([String] -> [(SrcSpan, String)]) -> [String] -> EP ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l)
printInterleaved, printInterleaved' :: (ExactP ast, SrcInfo loc) => [(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved :: [(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved [(loc, String)]
sistrs [ast SrcSpanInfo]
asts = [(Pos, EP ())] -> EP ()
printSeq ([(Pos, EP ())] -> EP ()) -> [(Pos, EP ())] -> EP ()
forall a b. (a -> b) -> a -> b
$
[(Pos, EP ())] -> [(Pos, EP ())] -> [(Pos, EP ())]
forall a. [a] -> [a] -> [a]
interleave (((loc, String) -> (Pos, EP ()))
-> [(loc, String)] -> [(Pos, EP ())]
forall a b. (a -> b) -> [a] -> [b]
map (loc -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos (loc -> Pos) -> (String -> EP ()) -> (loc, String) -> (Pos, EP ())
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** String -> EP ()
printString ) [(loc, String)]
sistrs)
((ast SrcSpanInfo -> (Pos, EP ()))
-> [ast SrcSpanInfo] -> [(Pos, EP ())]
forall a b. (a -> b) -> [a] -> [b]
map (SrcSpanInfo -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos (SrcSpanInfo -> Pos)
-> (ast SrcSpanInfo -> SrcSpanInfo) -> ast SrcSpanInfo -> Pos
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ast SrcSpanInfo -> SrcSpanInfo
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann (ast SrcSpanInfo -> Pos)
-> (ast SrcSpanInfo -> EP ()) -> ast SrcSpanInfo -> (Pos, EP ())
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ast SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP) [ast SrcSpanInfo]
asts)
printInterleaved' :: [(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved' [(loc, String)]
sistrs (ast SrcSpanInfo
a:[ast SrcSpanInfo]
asts) = ast SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC ast SrcSpanInfo
a EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [(loc, String)] -> [ast SrcSpanInfo] -> EP ()
forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved [(loc, String)]
sistrs [ast SrcSpanInfo]
asts
printInterleaved' [(loc, String)]
_ [ast SrcSpanInfo]
_ = String -> EP ()
forall a. String -> a
internalError String
"printInterleaved'"
printStreams :: [(Pos, EP ())] -> [(Pos, EP ())] -> EP ()
printStreams :: [(Pos, EP ())] -> [(Pos, EP ())] -> EP ()
printStreams [] [(Pos, EP ())]
ys = [(Pos, EP ())] -> EP ()
printSeq [(Pos, EP ())]
ys
printStreams [(Pos, EP ())]
xs [] = [(Pos, EP ())] -> EP ()
printSeq [(Pos, EP ())]
xs
printStreams (x :: (Pos, EP ())
x@(Pos
p1,EP ()
ep1):[(Pos, EP ())]
xs) (y :: (Pos, EP ())
y@(Pos
p2,EP ()
ep2):[(Pos, EP ())]
ys)
| Pos
p1 Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
<= Pos
p2 = Pos -> EP ()
printWhitespace Pos
p1 EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EP ()
ep1 EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [(Pos, EP ())] -> [(Pos, EP ())] -> EP ()
printStreams [(Pos, EP ())]
xs ((Pos, EP ())
y(Pos, EP ()) -> [(Pos, EP ())] -> [(Pos, EP ())]
forall a. a -> [a] -> [a]
:[(Pos, EP ())]
ys)
| Bool
otherwise = Pos -> EP ()
printWhitespace Pos
p2 EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EP ()
ep2 EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [(Pos, EP ())] -> [(Pos, EP ())] -> EP ()
printStreams ((Pos, EP ())
x(Pos, EP ()) -> [(Pos, EP ())] -> [(Pos, EP ())]
forall a. a -> [a] -> [a]
:[(Pos, EP ())]
xs) [(Pos, EP ())]
ys
interleave :: [a] -> [a] -> [a]
interleave :: [a] -> [a] -> [a]
interleave [] [a]
ys = [a]
ys
interleave [a]
xs [] = [a]
xs
interleave (a
x:[a]
xs) (a
y:[a]
ys) = a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
interleave [a]
xs [a]
ys
maybeEP :: (a -> EP ()) -> Maybe a -> EP ()
maybeEP :: (a -> EP ()) -> Maybe a -> EP ()
maybeEP = EP () -> (a -> EP ()) -> Maybe a -> EP ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> EP ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
bracketList :: (ExactP ast) => (String, String, String) -> [SrcSpan] -> [ast SrcSpanInfo] -> EP ()
bracketList :: (String, String, String) -> [SrcSpan] -> [ast SrcSpanInfo] -> EP ()
bracketList (String
a,String
b,String
c) [SrcSpan]
poss [ast SrcSpanInfo]
asts = [(SrcSpan, String)] -> [ast SrcSpanInfo] -> EP ()
forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved ([SrcSpan] -> (String, String, String) -> [(SrcSpan, String)]
forall a b. [a] -> (b, b, b) -> [(a, b)]
pList [SrcSpan]
poss (String
a,String
b,String
c)) [ast SrcSpanInfo]
asts
pList :: [a] -> (b, b, b) -> [(a, b)]
pList :: [a] -> (b, b, b) -> [(a, b)]
pList (a
p:[a]
ps) (b
a,b
b,b
c) = (a
p,b
a) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [a] -> (b, b) -> [(a, b)]
forall a b. [a] -> (b, b) -> [(a, b)]
pList' [a]
ps (b
b,b
c)
pList [a]
_ (b, b, b)
_ = String -> [(a, b)]
forall a. String -> a
internalError String
"pList"
pList' :: [a] -> (b, b) -> [(a, b)]
pList' :: [a] -> (b, b) -> [(a, b)]
pList' [] (b, b)
_ = []
pList' [a
p] (b
_,b
c) = [(a
p,b
c)]
pList' (a
p:[a]
ps) (b
b,b
c) = (a
p, b
b) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [a] -> (b, b) -> [(a, b)]
forall a b. [a] -> (b, b) -> [(a, b)]
pList' [a]
ps (b
b,b
c)
parenList, squareList, squareColonList, curlyList, parenHashList,
unboxedSumTypeList :: (ExactP ast) => [SrcSpan] -> [ast SrcSpanInfo] -> EP ()
parenList :: [SrcSpan] -> [ast SrcSpanInfo] -> EP ()
parenList = (String, String, String) -> [SrcSpan] -> [ast SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
(String, String, String) -> [SrcSpan] -> [ast SrcSpanInfo] -> EP ()
bracketList (String
"(",String
",",String
")")
squareList :: [SrcSpan] -> [ast SrcSpanInfo] -> EP ()
squareList = (String, String, String) -> [SrcSpan] -> [ast SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
(String, String, String) -> [SrcSpan] -> [ast SrcSpanInfo] -> EP ()
bracketList (String
"[",String
",",String
"]")
squareColonList :: [SrcSpan] -> [ast SrcSpanInfo] -> EP ()
squareColonList = (String, String, String) -> [SrcSpan] -> [ast SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
(String, String, String) -> [SrcSpan] -> [ast SrcSpanInfo] -> EP ()
bracketList (String
"[:",String
",",String
":]")
curlyList :: [SrcSpan] -> [ast SrcSpanInfo] -> EP ()
curlyList = (String, String, String) -> [SrcSpan] -> [ast SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
(String, String, String) -> [SrcSpan] -> [ast SrcSpanInfo] -> EP ()
bracketList (String
"{",String
",",String
"}")
parenHashList :: [SrcSpan] -> [ast SrcSpanInfo] -> EP ()
parenHashList = (String, String, String) -> [SrcSpan] -> [ast SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
(String, String, String) -> [SrcSpan] -> [ast SrcSpanInfo] -> EP ()
bracketList (String
"(#",String
",",String
"#)")
unboxedSumTypeList :: [SrcSpan] -> [ast SrcSpanInfo] -> EP ()
unboxedSumTypeList = (String, String, String) -> [SrcSpan] -> [ast SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
(String, String, String) -> [SrcSpan] -> [ast SrcSpanInfo] -> EP ()
bracketList (String
"(#", String
"|", String
"#)")
layoutList :: (ExactP ast) => [SrcSpan] -> [ast SrcSpanInfo] -> EP ()
layoutList :: [SrcSpan] -> [ast SrcSpanInfo] -> EP ()
layoutList [SrcSpan]
poss [ast SrcSpanInfo]
asts = [(Pos, EP ())] -> [(Pos, EP ())] -> EP ()
printStreams
(((SrcSpan, String) -> (Pos, EP ()))
-> [(SrcSpan, String)] -> [(Pos, EP ())]
forall a b. (a -> b) -> [a] -> [b]
map (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos (SrcSpan -> Pos)
-> (String -> EP ()) -> (SrcSpan, String) -> (Pos, EP ())
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** String -> EP ()
printString) ([(SrcSpan, String)] -> [(Pos, EP ())])
-> [(SrcSpan, String)] -> [(Pos, EP ())]
forall a b. (a -> b) -> a -> b
$ [SrcSpan] -> [(SrcSpan, String)]
lList [SrcSpan]
poss)
((ast SrcSpanInfo -> (Pos, EP ()))
-> [ast SrcSpanInfo] -> [(Pos, EP ())]
forall a b. (a -> b) -> [a] -> [b]
map (SrcSpanInfo -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos (SrcSpanInfo -> Pos)
-> (ast SrcSpanInfo -> SrcSpanInfo) -> ast SrcSpanInfo -> Pos
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ast SrcSpanInfo -> SrcSpanInfo
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann (ast SrcSpanInfo -> Pos)
-> (ast SrcSpanInfo -> EP ()) -> ast SrcSpanInfo -> (Pos, EP ())
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ast SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP) [ast SrcSpanInfo]
asts)
lList :: [SrcSpan] -> [(SrcSpan, String)]
lList :: [SrcSpan] -> [(SrcSpan, String)]
lList (SrcSpan
p:[SrcSpan]
ps) = (if SrcSpan -> Bool
isNullSpan SrcSpan
p then (SrcSpan
p,String
"") else (SrcSpan
p,String
"{")) (SrcSpan, String) -> [(SrcSpan, String)] -> [(SrcSpan, String)]
forall a. a -> [a] -> [a]
: [SrcSpan] -> [(SrcSpan, String)]
lList' [SrcSpan]
ps
lList [SrcSpan]
_ = String -> [(SrcSpan, String)]
forall a. String -> a
internalError String
"lList"
lList' :: [SrcSpan] -> [(SrcSpan, String)]
lList' :: [SrcSpan] -> [(SrcSpan, String)]
lList' [] = []
lList' [SrcSpan
p] = [if SrcSpan -> Bool
isNullSpan SrcSpan
p then (SrcSpan
p,String
"") else (SrcSpan
p,String
"}")]
lList' (SrcSpan
p:[SrcSpan]
ps) = (if SrcSpan -> Bool
isNullSpan SrcSpan
p then (SrcSpan
p,String
"") else (SrcSpan
p,String
";")) (SrcSpan, String) -> [(SrcSpan, String)] -> [(SrcSpan, String)]
forall a. a -> [a] -> [a]
: [SrcSpan] -> [(SrcSpan, String)]
lList' [SrcSpan]
ps
printSemi :: SrcSpan -> EP ()
printSemi :: SrcSpan -> EP ()
printSemi SrcSpan
p = do
Pos -> EP ()
printWhitespace (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
p)
Bool -> EP () -> EP ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (SrcSpan -> Bool
isNullSpan SrcSpan
p) (EP () -> EP ()) -> EP () -> EP ()
forall a b. (a -> b) -> a -> b
$ String -> EP ()
printString String
";"
class Annotated ast => ExactP ast where
exactP :: ast SrcSpanInfo -> EP ()
instance ExactP Literal where
exactP :: Literal SrcSpanInfo -> EP ()
exactP Literal SrcSpanInfo
lit = case Literal SrcSpanInfo
lit of
Char SrcSpanInfo
_ Char
_ String
rw -> String -> EP ()
printString (Char
'\''Char -> ShowS
forall a. a -> [a] -> [a]
:String
rw String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\'")
String SrcSpanInfo
_ String
_ String
rw -> String -> EP ()
printString (Char
'\"'Char -> ShowS
forall a. a -> [a] -> [a]
:String
rw String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\"")
Int SrcSpanInfo
_ Integer
_ String
rw -> String -> EP ()
printString String
rw
Frac SrcSpanInfo
_ Rational
_ String
rw -> String -> EP ()
printString String
rw
PrimInt SrcSpanInfo
_ Integer
_ String
rw -> String -> EP ()
printString (String
rw String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"#" )
PrimWord SrcSpanInfo
_ Integer
_ String
rw -> String -> EP ()
printString (String
rw String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"##")
PrimFloat SrcSpanInfo
_ Rational
_ String
rw -> String -> EP ()
printString (String
rw String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"#" )
PrimDouble SrcSpanInfo
_ Rational
_ String
rw -> String -> EP ()
printString (String
rw String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"##")
PrimChar SrcSpanInfo
_ Char
_ String
rw -> String -> EP ()
printString (Char
'\''Char -> ShowS
forall a. a -> [a] -> [a]
:String
rw String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\'#" )
PrimString SrcSpanInfo
_ String
_ String
rw -> String -> EP ()
printString (Char
'\"'Char -> ShowS
forall a. a -> [a] -> [a]
:String
rw String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\"#" )
instance ExactP Sign where
exactP :: Sign SrcSpanInfo -> EP ()
exactP Sign SrcSpanInfo
sg = case Sign SrcSpanInfo
sg of
Signless SrcSpanInfo
_ -> () -> EP ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Negative SrcSpanInfo
l -> Pos -> String -> EP ()
printStringAt (SrcSpanInfo -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpanInfo
l) String
"-"
instance ExactP ModuleName where
exactP :: ModuleName SrcSpanInfo -> EP ()
exactP (ModuleName SrcSpanInfo
_ String
str) = String -> EP ()
printString String
str
instance ExactP SpecialCon where
exactP :: SpecialCon SrcSpanInfo -> EP ()
exactP SpecialCon SrcSpanInfo
sc = case SpecialCon SrcSpanInfo
sc of
UnitCon SrcSpanInfo
l -> SrcSpanInfo -> [String] -> EP ()
printPoints SrcSpanInfo
l [String
"(",String
")"]
ListCon SrcSpanInfo
l -> SrcSpanInfo -> [String] -> EP ()
printPoints SrcSpanInfo
l [String
"[",String
"]"]
FunCon SrcSpanInfo
l -> case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
_,SrcSpan
b,SrcSpan
_] -> Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"->"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: SpecialCon is given wrong number of srcInfoPoints"
TupleCon SrcSpanInfo
l Boxed
b Int
n -> SrcSpanInfo -> [String] -> EP ()
printPoints SrcSpanInfo
l ([String] -> EP ()) -> [String] -> EP ()
forall a b. (a -> b) -> a -> b
$
case Boxed
b of
Boxed
Unboxed -> String
"(#"String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Int -> String -> [String]
forall a. Int -> a -> [a]
replicate (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) String
"," [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"#)"]
Boxed
_ -> String
"(" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Int -> String -> [String]
forall a. Int -> a -> [a]
replicate (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) String
"," [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
")"]
Cons SrcSpanInfo
_ -> String -> EP ()
printString String
":"
UnboxedSingleCon SrcSpanInfo
l -> SrcSpanInfo -> [String] -> EP ()
printPoints SrcSpanInfo
l [String
"(#",String
"#)"]
ExprHole SrcSpanInfo
l -> Pos -> String -> EP ()
printStringAt (SrcSpanInfo -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpanInfo
l) String
"_"
isSymbolName :: Name l -> Bool
isSymbolName :: Name l -> Bool
isSymbolName (Symbol l
_ String
_) = Bool
True
isSymbolName Name l
_ = Bool
False
isSymbolQName :: QName l -> Bool
isSymbolQName :: QName l -> Bool
isSymbolQName (UnQual l
_ Name l
n) = Name l -> Bool
forall l. Name l -> Bool
isSymbolName Name l
n
isSymbolQName (Qual l
_ ModuleName l
_ Name l
n) = Name l -> Bool
forall l. Name l -> Bool
isSymbolName Name l
n
isSymbolQName (Special l
_ Cons{}) = Bool
True
isSymbolQName (Special l
_ FunCon{}) = Bool
True
isSymbolQName QName l
_ = Bool
False
instance ExactP QName where
exactP :: QName SrcSpanInfo -> EP ()
exactP QName SrcSpanInfo
qn
| QName SrcSpanInfo -> Bool
forall l. QName l -> Bool
isSymbolQName QName SrcSpanInfo
qn =
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints (QName SrcSpanInfo -> SrcSpanInfo
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann QName SrcSpanInfo
qn) of
[SrcSpan
_,SrcSpan
b,SrcSpan
c] -> do
String -> EP ()
printString String
"("
Pos -> EP ()
printWhitespace (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b)
QName SrcSpanInfo -> EP ()
epQName QName SrcSpanInfo
qn
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
c) String
")"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: QName is given wrong number of srcInfoPoints"
| Bool
otherwise = QName SrcSpanInfo -> EP ()
epQName QName SrcSpanInfo
qn
epQName :: QName SrcSpanInfo -> EP ()
epQName :: QName SrcSpanInfo -> EP ()
epQName QName SrcSpanInfo
qn = case QName SrcSpanInfo
qn of
Qual SrcSpanInfo
_ ModuleName SrcSpanInfo
mn Name SrcSpanInfo
n -> ModuleName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP ModuleName SrcSpanInfo
mn EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> EP ()
printString String
"." EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Name SrcSpanInfo
n
UnQual SrcSpanInfo
_ Name SrcSpanInfo
n -> Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Name SrcSpanInfo
n
Special SrcSpanInfo
_ SpecialCon SrcSpanInfo
sc -> SpecialCon SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP SpecialCon SrcSpanInfo
sc
epInfixQName :: QName SrcSpanInfo -> EP ()
epInfixQName :: QName SrcSpanInfo -> EP ()
epInfixQName QName SrcSpanInfo
qn
| QName SrcSpanInfo -> Bool
forall l. QName l -> Bool
isSymbolQName QName SrcSpanInfo
qn = Pos -> EP ()
printWhitespace (SrcSpanInfo -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos (QName SrcSpanInfo -> SrcSpanInfo
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann QName SrcSpanInfo
qn)) EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> QName SrcSpanInfo -> EP ()
epQName QName SrcSpanInfo
qn
| Bool
otherwise =
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints (QName SrcSpanInfo -> SrcSpanInfo
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann QName SrcSpanInfo
qn) of
[SrcSpan
a,SrcSpan
b,SrcSpan
c] -> do
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"`"
Pos -> EP ()
printWhitespace (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b)
QName SrcSpanInfo -> EP ()
epQName QName SrcSpanInfo
qn
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
c) String
"`"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: QName (epInfixName) is given wrong number of srcInfoPoints"
instance ExactP Name where
exactP :: Name SrcSpanInfo -> EP ()
exactP Name SrcSpanInfo
n = case Name SrcSpanInfo
n of
Ident SrcSpanInfo
_ String
str -> String -> EP ()
printString String
str
Symbol SrcSpanInfo
l String
str ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
_,SrcSpan
b,SrcSpan
c] -> do
String -> EP ()
printString String
"("
Pos -> EP ()
printWhitespace (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b)
String -> EP ()
printString String
str
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
c) String
")"
[] -> String -> EP ()
printString String
str
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Name is given wrong number of srcInfoPoints"
epInfixName :: Name SrcSpanInfo -> EP ()
epInfixName :: Name SrcSpanInfo -> EP ()
epInfixName Name SrcSpanInfo
n
| Name SrcSpanInfo -> Bool
forall l. Name l -> Bool
isSymbolName Name SrcSpanInfo
n = Pos -> EP ()
printWhitespace (SrcSpanInfo -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos (Name SrcSpanInfo -> SrcSpanInfo
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann Name SrcSpanInfo
n)) EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Name SrcSpanInfo
n
| Bool
otherwise =
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints (Name SrcSpanInfo -> SrcSpanInfo
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann Name SrcSpanInfo
n) of
[SrcSpan
a,SrcSpan
b,SrcSpan
c] -> do
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"`"
Pos -> EP ()
printWhitespace (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b)
Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Name SrcSpanInfo
n
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
c) String
"`"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Name (epInfixName) is given wrong number of srcInfoPoints"
instance ExactP IPName where
exactP :: IPName SrcSpanInfo -> EP ()
exactP IPName SrcSpanInfo
ipn = case IPName SrcSpanInfo
ipn of
IPDup SrcSpanInfo
_ String
str -> String -> EP ()
printString (String -> EP ()) -> String -> EP ()
forall a b. (a -> b) -> a -> b
$ Char
'?'Char -> ShowS
forall a. a -> [a] -> [a]
:String
str
IPLin SrcSpanInfo
_ String
str -> String -> EP ()
printString (String -> EP ()) -> String -> EP ()
forall a b. (a -> b) -> a -> b
$ Char
'%'Char -> ShowS
forall a. a -> [a] -> [a]
:String
str
instance ExactP QOp where
exactP :: QOp SrcSpanInfo -> EP ()
exactP QOp SrcSpanInfo
qop = case QOp SrcSpanInfo
qop of
QVarOp SrcSpanInfo
_ QName SrcSpanInfo
qn -> QName SrcSpanInfo -> EP ()
epInfixQName QName SrcSpanInfo
qn
QConOp SrcSpanInfo
_ QName SrcSpanInfo
qn -> QName SrcSpanInfo -> EP ()
epInfixQName QName SrcSpanInfo
qn
instance ExactP Op where
exactP :: Op SrcSpanInfo -> EP ()
exactP Op SrcSpanInfo
op = case Op SrcSpanInfo
op of
VarOp SrcSpanInfo
_ Name SrcSpanInfo
n -> Name SrcSpanInfo -> EP ()
epInfixName Name SrcSpanInfo
n
ConOp SrcSpanInfo
_ Name SrcSpanInfo
n -> Name SrcSpanInfo -> EP ()
epInfixName Name SrcSpanInfo
n
instance ExactP CName where
exactP :: CName SrcSpanInfo -> EP ()
exactP CName SrcSpanInfo
cn = case CName SrcSpanInfo
cn of
VarName SrcSpanInfo
_ Name SrcSpanInfo
n -> Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Name SrcSpanInfo
n
ConName SrcSpanInfo
_ Name SrcSpanInfo
n -> Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Name SrcSpanInfo
n
instance ExactP Namespace where
exactP :: Namespace SrcSpanInfo -> EP ()
exactP Namespace SrcSpanInfo
ns = case Namespace SrcSpanInfo
ns of
NoNamespace SrcSpanInfo
_ -> () -> EP ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
TypeNamespace SrcSpanInfo
l -> Pos -> String -> EP ()
printStringAt (SrcSpanInfo -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpanInfo
l) String
"type"
PatternNamespace SrcSpanInfo
l -> Pos -> String -> EP ()
printStringAt (SrcSpanInfo -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpanInfo
l) String
"pattern"
instance ExactP ExportSpec where
exactP :: ExportSpec SrcSpanInfo -> EP ()
exactP ExportSpec SrcSpanInfo
espec = case ExportSpec SrcSpanInfo
espec of
EVar SrcSpanInfo
_ QName SrcSpanInfo
qn -> QName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC QName SrcSpanInfo
qn
EAbs SrcSpanInfo
_ Namespace SrcSpanInfo
ns QName SrcSpanInfo
qn -> Namespace SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Namespace SrcSpanInfo
ns EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> QName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC QName SrcSpanInfo
qn
EThingWith SrcSpanInfo
l EWildcard SrcSpanInfo
wc QName SrcSpanInfo
qn [CName SrcSpanInfo]
cns ->
let names :: [CName SrcSpanInfo]
names = case EWildcard SrcSpanInfo
wc of
NoWildcard {} -> [CName SrcSpanInfo]
cns
EWildcard SrcSpanInfo
wcl Int
n ->
let ([CName SrcSpanInfo]
before,[CName SrcSpanInfo]
after) = Int
-> [CName SrcSpanInfo]
-> ([CName SrcSpanInfo], [CName SrcSpanInfo])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [CName SrcSpanInfo]
cns
wildcardName :: CName SrcSpanInfo
wildcardName = SrcSpanInfo -> Name SrcSpanInfo -> CName SrcSpanInfo
forall l. l -> Name l -> CName l
VarName SrcSpanInfo
wcl (SrcSpanInfo -> String -> Name SrcSpanInfo
forall l. l -> String -> Name l
Ident SrcSpanInfo
wcl String
"..")
in [CName SrcSpanInfo]
before [CName SrcSpanInfo] -> [CName SrcSpanInfo] -> [CName SrcSpanInfo]
forall a. [a] -> [a] -> [a]
++ [CName SrcSpanInfo
wildcardName] [CName SrcSpanInfo] -> [CName SrcSpanInfo] -> [CName SrcSpanInfo]
forall a. [a] -> [a] -> [a]
++ [CName SrcSpanInfo]
after
k :: Int
k = [SrcSpan] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l)
in QName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP QName SrcSpanInfo
qn EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [(SrcSpan, String)] -> [CName SrcSpanInfo] -> EP ()
forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved ([SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) ([String] -> [(SrcSpan, String)])
-> [String] -> [(SrcSpan, String)]
forall a b. (a -> b) -> a -> b
$ String
"("String -> [String] -> [String]
forall a. a -> [a] -> [a]
:Int -> String -> [String]
forall a. Int -> a -> [a]
replicate (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2) String
"," [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
")"]) [CName SrcSpanInfo]
names
EModuleContents SrcSpanInfo
_ ModuleName SrcSpanInfo
mn -> String -> EP ()
printString String
"module" EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ModuleName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC ModuleName SrcSpanInfo
mn
instance ExactP ExportSpecList where
exactP :: ExportSpecList SrcSpanInfo -> EP ()
exactP (ExportSpecList SrcSpanInfo
l [ExportSpec SrcSpanInfo]
ess) =
let k :: Int
k = [SrcSpan] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l)
in [(SrcSpan, String)] -> [ExportSpec SrcSpanInfo] -> EP ()
forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved ([SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) ([String] -> [(SrcSpan, String)])
-> [String] -> [(SrcSpan, String)]
forall a b. (a -> b) -> a -> b
$ String
"("String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Int -> String -> [String]
forall a. Int -> a -> [a]
replicate (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2) String
"," [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
")"]) [ExportSpec SrcSpanInfo]
ess
instance ExactP ImportSpecList where
exactP :: ImportSpecList SrcSpanInfo -> EP ()
exactP (ImportSpecList SrcSpanInfo
l Bool
hid [ImportSpec SrcSpanInfo]
ispecs) = do
let pts :: [SrcSpan]
pts = SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l
[SrcSpan]
pts1 <- if Bool
hid then do
let (SrcSpan
x:[SrcSpan]
pts') = [SrcSpan]
pts
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
x) String
"hiding"
[SrcSpan] -> EP [SrcSpan]
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts'
else [SrcSpan] -> EP [SrcSpan]
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts
let k :: Int
k = [SrcSpan] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SrcSpan]
pts1
[(SrcSpan, String)] -> [ImportSpec SrcSpanInfo] -> EP ()
forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved ([SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SrcSpan]
pts1 ([String] -> [(SrcSpan, String)])
-> [String] -> [(SrcSpan, String)]
forall a b. (a -> b) -> a -> b
$ String
"("String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Int -> String -> [String]
forall a. Int -> a -> [a]
replicate (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2) String
"," [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
")"]) [ImportSpec SrcSpanInfo]
ispecs
instance ExactP ImportSpec where
exactP :: ImportSpec SrcSpanInfo -> EP ()
exactP ImportSpec SrcSpanInfo
ispec = case ImportSpec SrcSpanInfo
ispec of
IVar SrcSpanInfo
_ Name SrcSpanInfo
qn -> Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Name SrcSpanInfo
qn
IAbs SrcSpanInfo
_ Namespace SrcSpanInfo
ns Name SrcSpanInfo
n -> Namespace SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Namespace SrcSpanInfo
ns EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Name SrcSpanInfo
n
IThingAll SrcSpanInfo
l Name SrcSpanInfo
n -> Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Name SrcSpanInfo
n EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SrcSpanInfo -> [String] -> EP ()
printPoints SrcSpanInfo
l [String
"(",String
"..",String
")"]
IThingWith SrcSpanInfo
l Name SrcSpanInfo
n [CName SrcSpanInfo]
cns ->
let k :: Int
k = [SrcSpan] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l)
in Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Name SrcSpanInfo
n EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [(SrcSpan, String)] -> [CName SrcSpanInfo] -> EP ()
forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved ([SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) ([String] -> [(SrcSpan, String)])
-> [String] -> [(SrcSpan, String)]
forall a b. (a -> b) -> a -> b
$ String
"("String -> [String] -> [String]
forall a. a -> [a] -> [a]
:Int -> String -> [String]
forall a. Int -> a -> [a]
replicate (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2) String
"," [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
")"]) [CName SrcSpanInfo]
cns
instance ExactP ImportDecl where
exactP :: ImportDecl SrcSpanInfo -> EP ()
exactP (ImportDecl SrcSpanInfo
l ModuleName SrcSpanInfo
mn Bool
qf Bool
src Bool
safe Maybe String
mpkg Maybe (ModuleName SrcSpanInfo)
mas Maybe (ImportSpecList SrcSpanInfo)
mispecs) = do
String -> EP ()
printString String
"import"
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
(SrcSpan
_:[SrcSpan]
pts) -> do
[SrcSpan]
pts1 <- if Bool
src then
case [SrcSpan]
pts of
SrcSpan
x:SrcSpan
y:[SrcSpan]
pts' -> do
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
x) String
"{-# SOURCE"
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
y) String
"#-}"
[SrcSpan] -> EP [SrcSpan]
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts'
[SrcSpan]
_ -> String -> EP [SrcSpan]
forall a. String -> EP a
errorEP String
"ExactP: ImportDecl is given too few srcInfoPoints"
else [SrcSpan] -> EP [SrcSpan]
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts
[SrcSpan]
pts2 <- if Bool
safe then
case [SrcSpan]
pts1 of
SrcSpan
x:[SrcSpan]
pts' -> do
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
x) String
"safe"
[SrcSpan] -> EP [SrcSpan]
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts'
[SrcSpan]
_ -> String -> EP [SrcSpan]
forall a. String -> EP a
errorEP String
"ExactP: ImportDecl is given too few srcInfoPoints"
else [SrcSpan] -> EP [SrcSpan]
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts1
[SrcSpan]
pts3 <- if Bool
qf then
case [SrcSpan]
pts2 of
SrcSpan
x:[SrcSpan]
pts' -> do
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
x) String
"qualified"
[SrcSpan] -> EP [SrcSpan]
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts'
[SrcSpan]
_ -> String -> EP [SrcSpan]
forall a. String -> EP a
errorEP String
"ExactP: ImportDecl is given too few srcInfoPoints"
else [SrcSpan] -> EP [SrcSpan]
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts2
[SrcSpan]
pts4 <- case Maybe String
mpkg of
Just String
pkg ->
case [SrcSpan]
pts3 of
SrcSpan
x:[SrcSpan]
pts' -> do
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
x) (String -> EP ()) -> String -> EP ()
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. Show a => a -> String
show String
pkg
[SrcSpan] -> EP [SrcSpan]
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts'
[SrcSpan]
_ -> String -> EP [SrcSpan]
forall a. String -> EP a
errorEP String
"ExactP: ImportDecl is given too few srcInfoPoints"
Maybe String
_ -> [SrcSpan] -> EP [SrcSpan]
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts3
ModuleName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC ModuleName SrcSpanInfo
mn
[SrcSpan]
_ <- case Maybe (ModuleName SrcSpanInfo)
mas of
Just ModuleName SrcSpanInfo
as ->
case [SrcSpan]
pts4 of
SrcSpan
x:[SrcSpan]
pts' -> do
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
x) String
"as"
ModuleName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC ModuleName SrcSpanInfo
as
[SrcSpan] -> EP [SrcSpan]
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts'
[SrcSpan]
_ -> String -> EP [SrcSpan]
forall a. String -> EP a
errorEP String
"ExactP: ImportDecl is given too few srcInfoPoints"
Maybe (ModuleName SrcSpanInfo)
_ -> [SrcSpan] -> EP [SrcSpan]
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts4
case Maybe (ImportSpecList SrcSpanInfo)
mispecs of
Maybe (ImportSpecList SrcSpanInfo)
Nothing -> () -> EP ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just ImportSpecList SrcSpanInfo
ispecs -> ImportSpecList SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC ImportSpecList SrcSpanInfo
ispecs
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: ImportDecl is given too few srcInfoPoints"
instance ExactP Module where
exactP :: Module SrcSpanInfo -> EP ()
exactP Module SrcSpanInfo
mdl = case Module SrcSpanInfo
mdl of
Module SrcSpanInfo
l Maybe (ModuleHead SrcSpanInfo)
mmh [ModulePragma SrcSpanInfo]
oss [ImportDecl SrcSpanInfo]
ids [Decl SrcSpanInfo]
decls -> do
let ([SrcSpan]
oPts, [SrcSpan]
pts) = Int -> [SrcSpan] -> ([SrcSpan], [SrcSpan])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max ([ModulePragma SrcSpanInfo] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ModulePragma SrcSpanInfo]
oss Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
2) (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l)
[SrcSpan] -> [ModulePragma SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
layoutList [SrcSpan]
oPts [ModulePragma SrcSpanInfo]
oss
(ModuleHead SrcSpanInfo -> EP ())
-> Maybe (ModuleHead SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP ModuleHead SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (ModuleHead SrcSpanInfo)
mmh
[(Pos, EP ())] -> [(Pos, EP ())] -> EP ()
printStreams (((SrcSpan, String) -> (Pos, EP ()))
-> [(SrcSpan, String)] -> [(Pos, EP ())]
forall a b. (a -> b) -> [a] -> [b]
map (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos (SrcSpan -> Pos)
-> (String -> EP ()) -> (SrcSpan, String) -> (Pos, EP ())
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** String -> EP ()
printString) ([(SrcSpan, String)] -> [(Pos, EP ())])
-> [(SrcSpan, String)] -> [(Pos, EP ())]
forall a b. (a -> b) -> a -> b
$ [SrcSpan] -> [(SrcSpan, String)]
lList [SrcSpan]
pts)
((ImportDecl SrcSpanInfo -> (Pos, EP ()))
-> [ImportDecl SrcSpanInfo] -> [(Pos, EP ())]
forall a b. (a -> b) -> [a] -> [b]
map (SrcSpanInfo -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos (SrcSpanInfo -> Pos)
-> (ImportDecl SrcSpanInfo -> SrcSpanInfo)
-> ImportDecl SrcSpanInfo
-> Pos
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImportDecl SrcSpanInfo -> SrcSpanInfo
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann (ImportDecl SrcSpanInfo -> Pos)
-> (ImportDecl SrcSpanInfo -> EP ())
-> ImportDecl SrcSpanInfo
-> (Pos, EP ())
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ImportDecl SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC) [ImportDecl SrcSpanInfo]
ids [(Pos, EP ())] -> [(Pos, EP ())] -> [(Pos, EP ())]
forall a. [a] -> [a] -> [a]
++ (Decl SrcSpanInfo -> (Pos, EP ()))
-> [Decl SrcSpanInfo] -> [(Pos, EP ())]
forall a b. (a -> b) -> [a] -> [b]
map (SrcSpanInfo -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos (SrcSpanInfo -> Pos)
-> (Decl SrcSpanInfo -> SrcSpanInfo) -> Decl SrcSpanInfo -> Pos
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Decl SrcSpanInfo -> SrcSpanInfo
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann (Decl SrcSpanInfo -> Pos)
-> (Decl SrcSpanInfo -> EP ()) -> Decl SrcSpanInfo -> (Pos, EP ())
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Decl SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC) ([Decl SrcSpanInfo] -> [Decl SrcSpanInfo]
sepFunBinds [Decl SrcSpanInfo]
decls))
XmlPage SrcSpanInfo
l ModuleName SrcSpanInfo
_mn [ModulePragma SrcSpanInfo]
oss XName SrcSpanInfo
xn [XAttr SrcSpanInfo]
attrs Maybe (Exp SrcSpanInfo)
mat [Exp SrcSpanInfo]
es -> do
let ([SrcSpan]
oPts, [SrcSpan]
pPts) = Int -> [SrcSpan] -> ([SrcSpan], [SrcSpan])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max ([ModulePragma SrcSpanInfo] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ModulePragma SrcSpanInfo]
oss Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
2) ([SrcSpan] -> ([SrcSpan], [SrcSpan]))
-> [SrcSpan] -> ([SrcSpan], [SrcSpan])
forall a b. (a -> b) -> a -> b
$ SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l
case [SrcSpan]
pPts of
[SrcSpan
a,SrcSpan
b,SrcSpan
c,SrcSpan
d,SrcSpan
e] -> do
[SrcSpan] -> [ModulePragma SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
layoutList [SrcSpan]
oPts [ModulePragma SrcSpanInfo]
oss
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"<"
XName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC XName SrcSpanInfo
xn
(XAttr SrcSpanInfo -> EP ()) -> [XAttr SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ XAttr SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [XAttr SrcSpanInfo]
attrs
(Exp SrcSpanInfo -> EP ()) -> Maybe (Exp SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (Exp SrcSpanInfo)
mat
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
">"
(Exp SrcSpanInfo -> EP ()) -> [Exp SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [Exp SrcSpanInfo]
es
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
c) String
"</"
Pos -> EP ()
printWhitespace (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
d)
XName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP XName SrcSpanInfo
xn
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
e) String
">"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Module: XmlPage is given wrong number of srcInfoPoints"
XmlHybrid SrcSpanInfo
l Maybe (ModuleHead SrcSpanInfo)
mmh [ModulePragma SrcSpanInfo]
oss [ImportDecl SrcSpanInfo]
ids [Decl SrcSpanInfo]
decls XName SrcSpanInfo
xn [XAttr SrcSpanInfo]
attrs Maybe (Exp SrcSpanInfo)
mat [Exp SrcSpanInfo]
es -> do
let ([SrcSpan]
oPts, [SrcSpan]
pts) = Int -> [SrcSpan] -> ([SrcSpan], [SrcSpan])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max ([ModulePragma SrcSpanInfo] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ModulePragma SrcSpanInfo]
oss Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
2) (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l)
[SrcSpan] -> [ModulePragma SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
layoutList [SrcSpan]
oPts [ModulePragma SrcSpanInfo]
oss
(ModuleHead SrcSpanInfo -> EP ())
-> Maybe (ModuleHead SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP ModuleHead SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (ModuleHead SrcSpanInfo)
mmh
let ([SrcSpan]
dPts, [SrcSpan]
pPts) = Int -> [SrcSpan] -> ([SrcSpan], [SrcSpan])
forall a. Int -> [a] -> ([a], [a])
splitAt ([SrcSpan] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SrcSpan]
pts Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
5) [SrcSpan]
pts
case [SrcSpan]
pPts of
[SrcSpan
a,SrcSpan
b,SrcSpan
c,SrcSpan
d,SrcSpan
e] -> do
[(Pos, EP ())] -> [(Pos, EP ())] -> EP ()
printStreams (((SrcSpan, String) -> (Pos, EP ()))
-> [(SrcSpan, String)] -> [(Pos, EP ())]
forall a b. (a -> b) -> [a] -> [b]
map (\(SrcSpan
p,String
s) -> (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
p, String -> EP ()
printString String
s)) ([(SrcSpan, String)] -> [(Pos, EP ())])
-> [(SrcSpan, String)] -> [(Pos, EP ())]
forall a b. (a -> b) -> a -> b
$ [SrcSpan] -> [(SrcSpan, String)]
lList [SrcSpan]
dPts)
((ImportDecl SrcSpanInfo -> (Pos, EP ()))
-> [ImportDecl SrcSpanInfo] -> [(Pos, EP ())]
forall a b. (a -> b) -> [a] -> [b]
map (\ImportDecl SrcSpanInfo
i -> (SrcSpanInfo -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos (SrcSpanInfo -> Pos) -> SrcSpanInfo -> Pos
forall a b. (a -> b) -> a -> b
$ ImportDecl SrcSpanInfo -> SrcSpanInfo
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann ImportDecl SrcSpanInfo
i, ImportDecl SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC ImportDecl SrcSpanInfo
i)) [ImportDecl SrcSpanInfo]
ids [(Pos, EP ())] -> [(Pos, EP ())] -> [(Pos, EP ())]
forall a. [a] -> [a] -> [a]
++ (Decl SrcSpanInfo -> (Pos, EP ()))
-> [Decl SrcSpanInfo] -> [(Pos, EP ())]
forall a b. (a -> b) -> [a] -> [b]
map (\Decl SrcSpanInfo
d' -> (SrcSpanInfo -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos (SrcSpanInfo -> Pos) -> SrcSpanInfo -> Pos
forall a b. (a -> b) -> a -> b
$ Decl SrcSpanInfo -> SrcSpanInfo
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann Decl SrcSpanInfo
d', Decl SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Decl SrcSpanInfo
d')) ([Decl SrcSpanInfo] -> [Decl SrcSpanInfo]
sepFunBinds [Decl SrcSpanInfo]
decls))
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"<"
XName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC XName SrcSpanInfo
xn
(XAttr SrcSpanInfo -> EP ()) -> [XAttr SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ XAttr SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [XAttr SrcSpanInfo]
attrs
(Exp SrcSpanInfo -> EP ()) -> Maybe (Exp SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (Exp SrcSpanInfo)
mat
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
">"
(Exp SrcSpanInfo -> EP ()) -> [Exp SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [Exp SrcSpanInfo]
es
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
c) String
"</"
Pos -> EP ()
printWhitespace (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
d)
XName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP XName SrcSpanInfo
xn
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
e) String
">"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Module: XmlHybrid is given wrong number of srcInfoPoints"
instance ExactP ModuleHead where
exactP :: ModuleHead SrcSpanInfo -> EP ()
exactP (ModuleHead SrcSpanInfo
l ModuleName SrcSpanInfo
mn Maybe (WarningText SrcSpanInfo)
mwt Maybe (ExportSpecList SrcSpanInfo)
mess) =
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
a,SrcSpan
b] -> do
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"module"
ModuleName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC ModuleName SrcSpanInfo
mn
(WarningText SrcSpanInfo -> EP ())
-> Maybe (WarningText SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP WarningText SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (WarningText SrcSpanInfo)
mwt
(ExportSpecList SrcSpanInfo -> EP ())
-> Maybe (ExportSpecList SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP ExportSpecList SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (ExportSpecList SrcSpanInfo)
mess
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"where"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: ModuleHead is given wrong number of srcInfoPoints"
instance ExactP ModulePragma where
exactP :: ModulePragma SrcSpanInfo -> EP ()
exactP ModulePragma SrcSpanInfo
op = case ModulePragma SrcSpanInfo
op of
LanguagePragma SrcSpanInfo
l [Name SrcSpanInfo]
ns ->
let pts :: [SrcSpan]
pts = SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l
k :: Int
k = [Name SrcSpanInfo] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Name SrcSpanInfo]
ns Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
m :: Int
m = [SrcSpan] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SrcSpan]
pts Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2
in [(SrcSpan, String)] -> [Name SrcSpanInfo] -> EP ()
forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved ([SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SrcSpan]
pts (String
"{-# LANGUAGE"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
k String
"," [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
m String
"" [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"#-}"])) [Name SrcSpanInfo]
ns
OptionsPragma SrcSpanInfo
l Maybe Tool
mt String
str ->
let k :: Int
k = [SrcSpan] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l)
addSpace :: ShowS
addSpace xs :: String
xs@(Char
'\n':String
_) = String
xs
addSpace String
xs = Char
' 'Char -> ShowS
forall a. a -> [a] -> [a]
:String
xs
opstr :: String
opstr = String
"{-# OPTIONS" String -> ShowS
forall a. [a] -> [a] -> [a]
++ case Maybe Tool
mt of { Just Tool
t -> String
"_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Tool -> String
forall a. Show a => a -> String
show Tool
t ; Maybe Tool
_ -> String
"" } String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
addSpace String
str
in SrcSpanInfo -> [String] -> EP ()
printPoints SrcSpanInfo
l ([String] -> EP ()) -> [String] -> EP ()
forall a b. (a -> b) -> a -> b
$ String
opstr String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Int -> String -> [String]
forall a. Int -> a -> [a]
replicate (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2) String
"" [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"#-}"]
AnnModulePragma SrcSpanInfo
l Annotation SrcSpanInfo
ann' ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
_,SrcSpan
b] -> do
String -> EP ()
printString String
"{-# ANN"
Annotation SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Annotation SrcSpanInfo
ann'
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"#-}"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: ModulePragma: AnnPragma is given wrong number of srcInfoPoints"
instance ExactP WarningText where
exactP :: WarningText SrcSpanInfo -> EP ()
exactP (DeprText SrcSpanInfo
l String
str) = SrcSpanInfo -> [String] -> EP ()
printPoints SrcSpanInfo
l [String
"{-# DEPRECATED", String
str, String
"#-}"]
exactP (WarnText SrcSpanInfo
l String
str) = SrcSpanInfo -> [String] -> EP ()
printPoints SrcSpanInfo
l [String
"{-# WARNING", String
str, String
"#-}"]
instance ExactP Assoc where
exactP :: Assoc SrcSpanInfo -> EP ()
exactP Assoc SrcSpanInfo
a = case Assoc SrcSpanInfo
a of
AssocNone SrcSpanInfo
_ -> String -> EP ()
printString String
"infix"
AssocLeft SrcSpanInfo
_ -> String -> EP ()
printString String
"infixl"
AssocRight SrcSpanInfo
_ -> String -> EP ()
printString String
"infixr"
instance ExactP DataOrNew where
exactP :: DataOrNew SrcSpanInfo -> EP ()
exactP (DataType SrcSpanInfo
_) = String -> EP ()
printString String
"data"
exactP (NewType SrcSpanInfo
_) = String -> EP ()
printString String
"newtype"
instance ExactP TypeEqn where
exactP :: TypeEqn SrcSpanInfo -> EP ()
exactP (TypeEqn SrcSpanInfo
l Type SrcSpanInfo
t1 Type SrcSpanInfo
t2) =
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
a] -> do
Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t1
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"="
Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t2
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: TypeEqn is given wrong number of srcInfoPoints"
instance ExactP InjectivityInfo where
exactP :: InjectivityInfo SrcSpanInfo -> EP ()
exactP (InjectivityInfo SrcSpanInfo
l Name SrcSpanInfo
to [Name SrcSpanInfo]
from) =
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
SrcSpan
a:SrcSpan
b:[SrcSpan]
_ -> do
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"|"
Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Name SrcSpanInfo
to
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"->"
(Name SrcSpanInfo -> EP ()) -> [Name SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [Name SrcSpanInfo]
from
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: InjectivityInfo given wrong number of srcInfoPoints"
instance ExactP ResultSig where
exactP :: ResultSig SrcSpanInfo -> EP ()
exactP (KindSig SrcSpanInfo
l Type SrcSpanInfo
k) =
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
SrcSpan
a:[SrcSpan]
_ -> do
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"::"
Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
k
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: ResultSig given wrong number of srcInfoPoints"
exactP (TyVarSig SrcSpanInfo
l TyVarBind SrcSpanInfo
tv) =
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
SrcSpan
a:[SrcSpan]
_ -> do
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"="
TyVarBind SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC TyVarBind SrcSpanInfo
tv
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: ResultSig given wrong number of srcInfoPoints"
instance ExactP Decl where
exactP :: Decl SrcSpanInfo -> EP ()
exactP Decl SrcSpanInfo
decl = case Decl SrcSpanInfo
decl of
TypeDecl SrcSpanInfo
l DeclHead SrcSpanInfo
dh Type SrcSpanInfo
t ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
a,SrcSpan
b] -> do
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"type"
DeclHead SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC DeclHead SrcSpanInfo
dh
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"="
Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: TypeDecl is given wrong number of srcInfoPoints"
TypeFamDecl SrcSpanInfo
l DeclHead SrcSpanInfo
dh Maybe (ResultSig SrcSpanInfo)
mk Maybe (InjectivityInfo SrcSpanInfo)
mi ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
SrcSpan
a:SrcSpan
b:[SrcSpan]
_ -> do
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"type"
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"family"
DeclHead SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC DeclHead SrcSpanInfo
dh
(ResultSig SrcSpanInfo -> EP ())
-> Maybe (ResultSig SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP ResultSig SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (ResultSig SrcSpanInfo)
mk
(InjectivityInfo SrcSpanInfo -> EP ())
-> Maybe (InjectivityInfo SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP InjectivityInfo SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (InjectivityInfo SrcSpanInfo)
mi
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: TypeFamDecl is given wrong number of srcInfoPoints"
ClosedTypeFamDecl SrcSpanInfo
l DeclHead SrcSpanInfo
dh Maybe (ResultSig SrcSpanInfo)
mk Maybe (InjectivityInfo SrcSpanInfo)
mi [TypeEqn SrcSpanInfo]
eqns ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
SrcSpan
a:SrcSpan
b:SrcSpan
c:[SrcSpan]
_ -> do
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"type"
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"family"
DeclHead SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC DeclHead SrcSpanInfo
dh
(ResultSig SrcSpanInfo -> EP ())
-> Maybe (ResultSig SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP ResultSig SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (ResultSig SrcSpanInfo)
mk
(InjectivityInfo SrcSpanInfo -> EP ())
-> Maybe (InjectivityInfo SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP InjectivityInfo SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (InjectivityInfo SrcSpanInfo)
mi
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
c) String
"where"
(TypeEqn SrcSpanInfo -> EP ()) -> [TypeEqn SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ TypeEqn SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP [TypeEqn SrcSpanInfo]
eqns
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: ClosedTypeFamDecl is given wrong number of srcInfoPoints"
DataDecl SrcSpanInfo
l DataOrNew SrcSpanInfo
dn Maybe (Context SrcSpanInfo)
mctxt DeclHead SrcSpanInfo
dh [QualConDecl SrcSpanInfo]
constrs [Deriving SrcSpanInfo]
mder -> do
DataOrNew SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP DataOrNew SrcSpanInfo
dn
(Context SrcSpanInfo -> EP ())
-> Maybe (Context SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Context SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (Context SrcSpanInfo)
mctxt
DeclHead SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC DeclHead SrcSpanInfo
dh
[(SrcSpan, String)] -> [QualConDecl SrcSpanInfo] -> EP ()
forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved ([SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) (String
"="String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
forall a. a -> [a]
repeat String
"|")) [QualConDecl SrcSpanInfo]
constrs
(Deriving SrcSpanInfo -> EP ()) -> [Deriving SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Deriving SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [Deriving SrcSpanInfo]
mder
GDataDecl SrcSpanInfo
l DataOrNew SrcSpanInfo
dn Maybe (Context SrcSpanInfo)
mctxt DeclHead SrcSpanInfo
dh Maybe (Type SrcSpanInfo)
mk [GadtDecl SrcSpanInfo]
gds [Deriving SrcSpanInfo]
mder -> do
let pts :: [SrcSpan]
pts = SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l
DataOrNew SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP DataOrNew SrcSpanInfo
dn
(Context SrcSpanInfo -> EP ())
-> Maybe (Context SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Context SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (Context SrcSpanInfo)
mctxt
DeclHead SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC DeclHead SrcSpanInfo
dh
[SrcSpan]
pts1 <- case Maybe (Type SrcSpanInfo)
mk of
Maybe (Type SrcSpanInfo)
Nothing -> [SrcSpan] -> EP [SrcSpan]
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts
Just Type SrcSpanInfo
kd -> case [SrcSpan]
pts of
SrcSpan
p:[SrcSpan]
pts' -> do
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
p) String
"::"
Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
kd
[SrcSpan] -> EP [SrcSpan]
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts'
[SrcSpan]
_ -> String -> EP [SrcSpan]
forall a. String -> EP a
errorEP String
"ExactP: Decl: GDataDecl is given too few srcInfoPoints"
case [SrcSpan]
pts1 of
SrcSpan
x:[SrcSpan]
pts' -> do
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
x) String
"where"
[SrcSpan] -> [GadtDecl SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
layoutList [SrcSpan]
pts' [GadtDecl SrcSpanInfo]
gds
(Deriving SrcSpanInfo -> EP ()) -> [Deriving SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Deriving SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [Deriving SrcSpanInfo]
mder
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: GDataDecl is given too few srcInfoPoints"
DataFamDecl SrcSpanInfo
l Maybe (Context SrcSpanInfo)
mctxt DeclHead SrcSpanInfo
dh Maybe (ResultSig SrcSpanInfo)
mk -> do
String -> EP ()
printString String
"data"
(Context SrcSpanInfo -> EP ())
-> Maybe (Context SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Context SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (Context SrcSpanInfo)
mctxt
DeclHead SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC DeclHead SrcSpanInfo
dh
(ResultSig SrcSpanInfo -> EP ())
-> Maybe (ResultSig SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP (\ResultSig SrcSpanInfo
kd -> Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos ([SrcSpan] -> SrcSpan
forall a. [a] -> a
head (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l))) String
"::" EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ResultSig SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC ResultSig SrcSpanInfo
kd) Maybe (ResultSig SrcSpanInfo)
mk
TypeInsDecl SrcSpanInfo
l Type SrcSpanInfo
t1 Type SrcSpanInfo
t2 ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
_,SrcSpan
b,SrcSpan
c] -> do
String -> EP ()
printString String
"type"
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"instance"
Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t1
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
c) String
"="
Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t2
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: TypeInsDecl is given wrong number of srcInfoPoints"
DataInsDecl SrcSpanInfo
l DataOrNew SrcSpanInfo
dn Type SrcSpanInfo
t [QualConDecl SrcSpanInfo]
constrs [Deriving SrcSpanInfo]
mder ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
SrcSpan
p:[SrcSpan]
pts -> do
DataOrNew SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP DataOrNew SrcSpanInfo
dn
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
p) String
"instance"
Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t
[(SrcSpan, String)] -> [QualConDecl SrcSpanInfo] -> EP ()
forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved ([SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SrcSpan]
pts (String
"="String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
forall a. a -> [a]
repeat String
"|")) [QualConDecl SrcSpanInfo]
constrs
(Deriving SrcSpanInfo -> EP ()) -> [Deriving SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Deriving SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [Deriving SrcSpanInfo]
mder
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: DataInsDecl is given too few srcInfoPoints"
GDataInsDecl SrcSpanInfo
l DataOrNew SrcSpanInfo
dn Type SrcSpanInfo
t Maybe (Type SrcSpanInfo)
mk [GadtDecl SrcSpanInfo]
gds [Deriving SrcSpanInfo]
mder ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
SrcSpan
p:[SrcSpan]
pts -> do
DataOrNew SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP DataOrNew SrcSpanInfo
dn
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
p) String
"instance"
Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t
[SrcSpan]
pts1 <- case Maybe (Type SrcSpanInfo)
mk of
Maybe (Type SrcSpanInfo)
Nothing -> [SrcSpan] -> EP [SrcSpan]
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts
Just Type SrcSpanInfo
kd -> case [SrcSpan]
pts of
SrcSpan
p':[SrcSpan]
pts' -> do
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
p') String
"::"
Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
kd
[SrcSpan] -> EP [SrcSpan]
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts'
[SrcSpan]
_ -> String -> EP [SrcSpan]
forall a. String -> EP a
errorEP String
"ExactP: Decl: GDataInsDecl is given too few srcInfoPoints"
case [SrcSpan]
pts1 of
SrcSpan
x:[SrcSpan]
pts' -> do
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
x) String
"where"
[SrcSpan] -> [GadtDecl SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
layoutList [SrcSpan]
pts' [GadtDecl SrcSpanInfo]
gds
(Deriving SrcSpanInfo -> EP ()) -> [Deriving SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Deriving SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [Deriving SrcSpanInfo]
mder
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: GDataInsDecl is given too few srcInfoPoints"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: GDataInsDecl is given too few srcInfoPoints"
ClassDecl SrcSpanInfo
l Maybe (Context SrcSpanInfo)
mctxt DeclHead SrcSpanInfo
dh [FunDep SrcSpanInfo]
fds Maybe [ClassDecl SrcSpanInfo]
mcds ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
SrcSpan
_:[SrcSpan]
pts -> do
String -> EP ()
printString String
"class"
(Context SrcSpanInfo -> EP ())
-> Maybe (Context SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Context SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (Context SrcSpanInfo)
mctxt
DeclHead SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC DeclHead SrcSpanInfo
dh
[SrcSpan]
_ <- case [FunDep SrcSpanInfo]
fds of
[] -> [SrcSpan] -> EP [SrcSpan]
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts
[FunDep SrcSpanInfo]
_ -> do
let ([SrcSpan]
pts1, [SrcSpan]
pts2) = Int -> [SrcSpan] -> ([SrcSpan], [SrcSpan])
forall a. Int -> [a] -> ([a], [a])
splitAt ([FunDep SrcSpanInfo] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FunDep SrcSpanInfo]
fds) [SrcSpan]
pts
[(SrcSpan, String)] -> [FunDep SrcSpanInfo] -> EP ()
forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved ([SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SrcSpan]
pts1 (String
"|"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:String -> [String]
forall a. a -> [a]
repeat String
",")) [FunDep SrcSpanInfo]
fds
[SrcSpan] -> EP [SrcSpan]
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts2
([ClassDecl SrcSpanInfo] -> EP ())
-> Maybe [ClassDecl SrcSpanInfo] -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP (\[ClassDecl SrcSpanInfo]
cds ->
case [SrcSpan]
pts of
SrcSpan
p:[SrcSpan]
pts' -> do
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
p) String
"where"
[SrcSpan] -> [ClassDecl SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
layoutList [SrcSpan]
pts' ([ClassDecl SrcSpanInfo] -> EP ())
-> [ClassDecl SrcSpanInfo] -> EP ()
forall a b. (a -> b) -> a -> b
$ [ClassDecl SrcSpanInfo] -> [ClassDecl SrcSpanInfo]
sepClassFunBinds [ClassDecl SrcSpanInfo]
cds
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: ClassDecl is given too few srcInfoPoints"
) Maybe [ClassDecl SrcSpanInfo]
mcds
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: ClassDecl is given too few srcInfoPoints"
InstDecl SrcSpanInfo
l Maybe (Overlap SrcSpanInfo)
movlp InstRule SrcSpanInfo
ih Maybe [InstDecl SrcSpanInfo]
mids ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
SrcSpan
_:[SrcSpan]
pts -> do
String -> EP ()
printString String
"instance"
(Overlap SrcSpanInfo -> EP ())
-> Maybe (Overlap SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Overlap SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (Overlap SrcSpanInfo)
movlp
InstRule SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC InstRule SrcSpanInfo
ih
([InstDecl SrcSpanInfo] -> EP ())
-> Maybe [InstDecl SrcSpanInfo] -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP (\[InstDecl SrcSpanInfo]
ids -> do
let (SrcSpan
p:[SrcSpan]
pts') = [SrcSpan]
pts
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
p) String
"where"
[SrcSpan] -> [InstDecl SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
layoutList [SrcSpan]
pts' ([InstDecl SrcSpanInfo] -> EP ())
-> [InstDecl SrcSpanInfo] -> EP ()
forall a b. (a -> b) -> a -> b
$ [InstDecl SrcSpanInfo] -> [InstDecl SrcSpanInfo]
sepInstFunBinds [InstDecl SrcSpanInfo]
ids
) Maybe [InstDecl SrcSpanInfo]
mids
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: InstDecl is given too few srcInfoPoints"
DerivDecl SrcSpanInfo
l Maybe (DerivStrategy SrcSpanInfo)
mds Maybe (Overlap SrcSpanInfo)
movlp InstRule SrcSpanInfo
ih ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
_,SrcSpan
b] -> do
String -> EP ()
printString String
"deriving"
(DerivStrategy SrcSpanInfo -> EP ())
-> Maybe (DerivStrategy SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP DerivStrategy SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (DerivStrategy SrcSpanInfo)
mds
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"instance"
(Overlap SrcSpanInfo -> EP ())
-> Maybe (Overlap SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Overlap SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (Overlap SrcSpanInfo)
movlp
InstRule SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC InstRule SrcSpanInfo
ih
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: DerivDecl is given wrong number of srcInfoPoints"
InfixDecl SrcSpanInfo
l Assoc SrcSpanInfo
assoc Maybe Int
mprec [Op SrcSpanInfo]
ops -> do
let pts :: [SrcSpan]
pts = SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l
Assoc SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Assoc SrcSpanInfo
assoc
[SrcSpan]
pts1 <- case Maybe Int
mprec of
Maybe Int
Nothing -> [SrcSpan] -> EP [SrcSpan]
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts
Just Int
prec ->
case [SrcSpan]
pts of
SrcSpan
p:[SrcSpan]
pts' -> do
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
p) (Int -> String
forall a. Show a => a -> String
show Int
prec)
[SrcSpan] -> EP [SrcSpan]
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts'
[SrcSpan]
_ -> String -> EP [SrcSpan]
forall a. String -> EP a
errorEP String
"ExactP: Decl: InfixDecl is given too few srcInfoPoints"
[(SrcSpan, String)] -> [Op SrcSpanInfo] -> EP ()
forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved' ([SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SrcSpan]
pts1 (String -> [String]
forall a. a -> [a]
repeat String
",")) [Op SrcSpanInfo]
ops
DefaultDecl SrcSpanInfo
l [Type SrcSpanInfo]
ts ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
SrcSpan
_:[SrcSpan]
pts -> do
String -> EP ()
printString String
"default"
[(SrcSpan, String)] -> [Type SrcSpanInfo] -> EP ()
forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved ([SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([SrcSpan] -> [SrcSpan]
forall a. [a] -> [a]
init [SrcSpan]
pts) (String
"("String -> [String] -> [String]
forall a. a -> [a] -> [a]
:String -> [String]
forall a. a -> [a]
repeat String
",")) [Type SrcSpanInfo]
ts
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos ([SrcSpan] -> SrcSpan
forall a. [a] -> a
last [SrcSpan]
pts)) String
")"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: DefaultDecl is given too few srcInfoPoints"
SpliceDecl SrcSpanInfo
_ Exp SrcSpanInfo
spl -> Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Exp SrcSpanInfo
spl
TSpliceDecl SrcSpanInfo
_ Exp SrcSpanInfo
spl -> Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Exp SrcSpanInfo
spl
TypeSig SrcSpanInfo
l [Name SrcSpanInfo]
ns Type SrcSpanInfo
t -> do
let pts :: [SrcSpan]
pts = SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l
[(SrcSpan, String)] -> [Name SrcSpanInfo] -> EP ()
forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved' ([SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SrcSpan]
pts (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate ([SrcSpan] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SrcSpan]
pts Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) String
"," [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"::"])) [Name SrcSpanInfo]
ns
Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t
PatSynSig SrcSpanInfo
l [Name SrcSpanInfo]
ns Maybe [TyVarBind SrcSpanInfo]
dh Maybe (Context SrcSpanInfo)
c1 Maybe [TyVarBind SrcSpanInfo]
_ Maybe (Context SrcSpanInfo)
c2 Type SrcSpanInfo
t -> do
let (SrcSpan
pat:[SrcSpan]
pts) = SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
pat) String
"pattern"
[(SrcSpan, String)] -> [Name SrcSpanInfo] -> EP ()
forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved' ([SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SrcSpan]
pts (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate ([Name SrcSpanInfo] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Name SrcSpanInfo]
ns Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) String
"," [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"::"])) [Name SrcSpanInfo]
ns
case Maybe [TyVarBind SrcSpanInfo]
dh of
Maybe [TyVarBind SrcSpanInfo]
Nothing -> () -> EP ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just [TyVarBind SrcSpanInfo]
tvs ->
case Int -> [SrcSpan] -> [SrcSpan]
forall a. Int -> [a] -> [a]
drop ([Name SrcSpanInfo] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Name SrcSpanInfo]
ns) [SrcSpan]
pts of
(SrcSpan
a:SrcSpan
b:[SrcSpan]
_) -> do
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"forall"
(TyVarBind SrcSpanInfo -> EP ())
-> [TyVarBind SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ TyVarBind SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [TyVarBind SrcSpanInfo]
tvs
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"."
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP (String
"ExactP: Decl: PatSynSig: Forall: is given too few srcInfoPoints" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [SrcSpan] -> String
forall a. Show a => a -> String
show [SrcSpan]
pts String -> ShowS
forall a. [a] -> [a] -> [a]
++ [SrcSpan] -> String
forall a. Show a => a -> String
show (Int -> [SrcSpan] -> [SrcSpan]
forall a. Int -> [a] -> [a]
drop ([Name SrcSpanInfo] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Name SrcSpanInfo]
ns Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [SrcSpan]
pts))
(Context SrcSpanInfo -> EP ())
-> Maybe (Context SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Context SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (Context SrcSpanInfo)
c1
(Context SrcSpanInfo -> EP ())
-> Maybe (Context SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Context SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (Context SrcSpanInfo)
c2
Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t
FunBind SrcSpanInfo
_ [Match SrcSpanInfo]
ms -> (Match SrcSpanInfo -> EP ()) -> [Match SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Match SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [Match SrcSpanInfo]
ms
PatBind SrcSpanInfo
l Pat SrcSpanInfo
p Rhs SrcSpanInfo
rhs Maybe (Binds SrcSpanInfo)
mbs -> do
let pts :: [SrcSpan]
pts = SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l
Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Pat SrcSpanInfo
p
Rhs SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Rhs SrcSpanInfo
rhs
(Binds SrcSpanInfo -> EP ()) -> Maybe (Binds SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP (\Binds SrcSpanInfo
bs -> Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos ([SrcSpan] -> SrcSpan
forall a. [a] -> a
head [SrcSpan]
pts)) String
"where" EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Binds SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Binds SrcSpanInfo
bs) Maybe (Binds SrcSpanInfo)
mbs
PatSyn SrcSpanInfo
l Pat SrcSpanInfo
lhs Pat SrcSpanInfo
rhs PatternSynDirection SrcSpanInfo
dir ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
pat,SrcSpan
sepPos] -> do
let sep :: String
sep = case PatternSynDirection SrcSpanInfo
dir of
PatternSynDirection SrcSpanInfo
ImplicitBidirectional -> String
"="
ExplicitBidirectional SrcSpanInfo
_ [Decl SrcSpanInfo]
_ -> String
"<-"
PatternSynDirection SrcSpanInfo
Unidirectional -> String
"<-"
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
pat) String
"pattern"
Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Pat SrcSpanInfo
lhs
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
sepPos) String
sep
Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Pat SrcSpanInfo
rhs
case PatternSynDirection SrcSpanInfo
dir of
ExplicitBidirectional SrcSpanInfo
bl [Decl SrcSpanInfo]
ds -> do
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
bl of
(SrcSpan
w:[SrcSpan]
pts) -> do
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
w) String
"where"
[SrcSpan] -> [Decl SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
layoutList [SrcSpan]
pts [Decl SrcSpanInfo]
ds
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: PaySyn: ExplicitBidirectional is given too few srcInfoPoints"
PatternSynDirection SrcSpanInfo
_ -> () -> EP ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: PatSyn is given too few srcInfoPoints"
ForImp SrcSpanInfo
l CallConv SrcSpanInfo
cc Maybe (Safety SrcSpanInfo)
msf Maybe String
mstr Name SrcSpanInfo
n Type SrcSpanInfo
t ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
SrcSpan
_:SrcSpan
b:[SrcSpan]
pts -> do
String -> EP ()
printString String
"foreign"
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"import"
CallConv SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC CallConv SrcSpanInfo
cc
(Safety SrcSpanInfo -> EP ())
-> Maybe (Safety SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Safety SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (Safety SrcSpanInfo)
msf
[SrcSpan]
pts1 <- case Maybe String
mstr of
Maybe String
Nothing -> [SrcSpan] -> EP [SrcSpan]
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts
Just String
str -> case [SrcSpan]
pts of
SrcSpan
x:[SrcSpan]
pts' -> do
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
x) (ShowS
forall a. Show a => a -> String
show String
str)
[SrcSpan] -> EP [SrcSpan]
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts'
[SrcSpan]
_ -> String -> EP [SrcSpan]
forall a. String -> EP a
errorEP String
"ExactP: Decl: ForImp is given too few srcInfoPoints"
case [SrcSpan]
pts1 of
SrcSpan
y:[SrcSpan]
_ -> do
Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Name SrcSpanInfo
n
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
y) String
"::"
Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: ForImp is given too few srcInfoPoints"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: ForImp is given too few srcInfoPoints"
ForExp SrcSpanInfo
l CallConv SrcSpanInfo
cc Maybe String
mstr Name SrcSpanInfo
n Type SrcSpanInfo
t ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
SrcSpan
_:SrcSpan
b:[SrcSpan]
pts -> do
String -> EP ()
printString String
"foreign"
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"export"
CallConv SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC CallConv SrcSpanInfo
cc
[SrcSpan]
pts1 <- case Maybe String
mstr of
Maybe String
Nothing -> [SrcSpan] -> EP [SrcSpan]
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts
Just String
str -> case [SrcSpan]
pts of
SrcSpan
x:[SrcSpan]
pts' -> do
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
x) (ShowS
forall a. Show a => a -> String
show String
str)
[SrcSpan] -> EP [SrcSpan]
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts'
[SrcSpan]
_ -> String -> EP [SrcSpan]
forall a. String -> EP a
errorEP String
"ExactP: Decl: ForExp is given too few srcInfoPoints"
case [SrcSpan]
pts1 of
SrcSpan
y:[SrcSpan]
_ -> do
Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Name SrcSpanInfo
n
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
y) String
"::"
Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: ForExp is given too few srcInfoPoints"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: ForExp is given too few srcInfoPoints"
RulePragmaDecl SrcSpanInfo
l [Rule SrcSpanInfo]
rs ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
_,SrcSpan
b] -> do
String -> EP ()
printString String
"{-# RULES"
(Rule SrcSpanInfo -> EP ()) -> [Rule SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Rule SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [Rule SrcSpanInfo]
rs
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"#-}"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: RulePragmaDecl is given too few srcInfoPoints"
DeprPragmaDecl SrcSpanInfo
l [([Name SrcSpanInfo], String)]
nstrs ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
SrcSpan
_:[SrcSpan]
pts -> do
String -> EP ()
printString String
"{-# DEPRECATED"
[Pos] -> [([Name SrcSpanInfo], String)] -> EP ()
printWarndeprs ((SrcSpan -> Pos) -> [SrcSpan] -> [Pos]
forall a b. (a -> b) -> [a] -> [b]
map SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos ([SrcSpan] -> [SrcSpan]
forall a. [a] -> [a]
init [SrcSpan]
pts)) [([Name SrcSpanInfo], String)]
nstrs
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos ([SrcSpan] -> SrcSpan
forall a. [a] -> a
last [SrcSpan]
pts)) String
"#-}"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: DeprPragmaDecl is given too few srcInfoPoints"
WarnPragmaDecl SrcSpanInfo
l [([Name SrcSpanInfo], String)]
nstrs ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
SrcSpan
_:[SrcSpan]
pts -> do
String -> EP ()
printString String
"{-# WARNING"
[Pos] -> [([Name SrcSpanInfo], String)] -> EP ()
printWarndeprs ((SrcSpan -> Pos) -> [SrcSpan] -> [Pos]
forall a b. (a -> b) -> [a] -> [b]
map SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos ([SrcSpan] -> [SrcSpan]
forall a. [a] -> [a]
init [SrcSpan]
pts)) [([Name SrcSpanInfo], String)]
nstrs
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos ([SrcSpan] -> SrcSpan
forall a. [a] -> a
last [SrcSpan]
pts)) String
"#-}"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: WarnPragmaDecl is given too few srcInfoPoints"
InlineSig SrcSpanInfo
l Bool
inl Maybe (Activation SrcSpanInfo)
mact QName SrcSpanInfo
qn ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
_,SrcSpan
b] -> do
String -> EP ()
printString (String -> EP ()) -> String -> EP ()
forall a b. (a -> b) -> a -> b
$ if Bool
inl then String
"{-# INLINE" else String
"{-# NOINLINE"
(Activation SrcSpanInfo -> EP ())
-> Maybe (Activation SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Activation SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (Activation SrcSpanInfo)
mact
QName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC QName SrcSpanInfo
qn
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"#-}"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: InlineSig is given wrong number of srcInfoPoints"
InlineConlikeSig SrcSpanInfo
l Maybe (Activation SrcSpanInfo)
mact QName SrcSpanInfo
qn ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
_,SrcSpan
b] -> do
String -> EP ()
printString String
"{-# INLINE CONLIKE"
(Activation SrcSpanInfo -> EP ())
-> Maybe (Activation SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Activation SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (Activation SrcSpanInfo)
mact
QName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC QName SrcSpanInfo
qn
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"#-}"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: InlineConlikeSig is given wrong number of srcInfoPoints"
SpecSig SrcSpanInfo
l Maybe (Activation SrcSpanInfo)
mact QName SrcSpanInfo
qn [Type SrcSpanInfo]
ts ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
SrcSpan
_:[SrcSpan]
pts -> do
String -> EP ()
printString String
"{-# SPECIALISE"
(Activation SrcSpanInfo -> EP ())
-> Maybe (Activation SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Activation SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (Activation SrcSpanInfo)
mact
QName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC QName SrcSpanInfo
qn
[(SrcSpan, String)] -> [Type SrcSpanInfo] -> EP ()
forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved ([SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SrcSpan]
pts (String
"::" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Int -> String -> [String]
forall a. Int -> a -> [a]
replicate ([SrcSpan] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SrcSpan]
pts Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) String
"," [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"#-}"])) [Type SrcSpanInfo]
ts
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: SpecSig is given too few srcInfoPoints"
SpecInlineSig SrcSpanInfo
l Bool
b Maybe (Activation SrcSpanInfo)
mact QName SrcSpanInfo
qn [Type SrcSpanInfo]
ts ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
SrcSpan
_:[SrcSpan]
pts -> do
String -> EP ()
printString (String -> EP ()) -> String -> EP ()
forall a b. (a -> b) -> a -> b
$ String
"{-# SPECIALISE " String -> ShowS
forall a. [a] -> [a] -> [a]
++ if Bool
b then String
"INLINE" else String
"NOINLINE"
(Activation SrcSpanInfo -> EP ())
-> Maybe (Activation SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Activation SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (Activation SrcSpanInfo)
mact
QName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC QName SrcSpanInfo
qn
[(SrcSpan, String)] -> [Type SrcSpanInfo] -> EP ()
forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved ([SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SrcSpan]
pts (String
"::" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Int -> String -> [String]
forall a. Int -> a -> [a]
replicate ([SrcSpan] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SrcSpan]
pts Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) String
"," [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"#-}"])) [Type SrcSpanInfo]
ts
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: SpecInlineSig is given too few srcInfoPoints"
InstSig SrcSpanInfo
l InstRule SrcSpanInfo
ih ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
_,SrcSpan
b,SrcSpan
c] -> do
String -> EP ()
printString String
"{-# SPECIALISE"
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"instance"
InstRule SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC InstRule SrcSpanInfo
ih
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
c) String
"#-}"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: InstSig is given wrong number of srcInfoPoints"
AnnPragma SrcSpanInfo
l Annotation SrcSpanInfo
ann' ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
_,SrcSpan
b] -> do
String -> EP ()
printString String
"{-# ANN"
Annotation SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Annotation SrcSpanInfo
ann'
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"#-}"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: AnnPragma is given wrong number of srcInfoPoints"
MinimalPragma SrcSpanInfo
l Maybe (BooleanFormula SrcSpanInfo)
b ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
_,SrcSpan
b'] -> do
String -> EP ()
printString String
"{-# MINIMAL"
(BooleanFormula SrcSpanInfo -> EP ())
-> Maybe (BooleanFormula SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP BooleanFormula SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (BooleanFormula SrcSpanInfo)
b
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b') String
"#-}"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: MinimalPragma is given wrong number of srcInfoPoints"
RoleAnnotDecl SrcSpanInfo
l QName SrcSpanInfo
ty [Role SrcSpanInfo]
roles ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
(SrcSpan
t:SrcSpan
r:[SrcSpan]
_) -> do
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
t) String
"type"
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
r) String
"role"
QName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC QName SrcSpanInfo
ty
(Role SrcSpanInfo -> EP ()) -> [Role SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Role SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [Role SrcSpanInfo]
roles
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: RoleAnnotDecl is given wrong number of srcInfoPoints"
CompletePragma SrcSpanInfo
l [Name SrcSpanInfo]
cls Maybe (QName SrcSpanInfo)
opt_ts ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
(SrcSpan
t:[SrcSpan]
rs) -> do
let ([SrcSpan]
cls_s, [SrcSpan]
rs') = Int -> [SrcSpan] -> ([SrcSpan], [SrcSpan])
forall a. Int -> [a] -> ([a], [a])
splitAt ([Name SrcSpanInfo] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Name SrcSpanInfo]
cls Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [SrcSpan]
rs
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
t)String
"{-# COMPLETE"
[(SrcSpan, String)] -> [Name SrcSpanInfo] -> EP ()
forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved' ([SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SrcSpan]
cls_s (String -> [String]
forall a. a -> [a]
repeat String
",")) [Name SrcSpanInfo]
cls
case ([SrcSpan]
rs', Maybe (QName SrcSpanInfo)
opt_ts) of
((SrcSpan
opt_dcolon: SrcSpan
end:[SrcSpan]
_), Just QName SrcSpanInfo
tc) -> do
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
opt_dcolon) String
"::"
QName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC QName SrcSpanInfo
tc
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
end) String
"#-}"
([SrcSpan
end], Maybe (QName SrcSpanInfo)
Nothing) -> Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
end) String
"#-}"
([SrcSpan], Maybe (QName SrcSpanInfo))
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: CompletePragma is given wrong number of srcInfoPoints"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: CompletePragma is given wrong number of srcInfoPoints"
instance ExactP Role where
exactP :: Role SrcSpanInfo -> EP ()
exactP Role SrcSpanInfo
r =
case Role SrcSpanInfo
r of
RoleWildcard SrcSpanInfo
l -> Pos -> String -> EP ()
printStringAt (SrcSpanInfo -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpanInfo
l) String
"_"
Representational SrcSpanInfo
l -> Pos -> String -> EP ()
printStringAt (SrcSpanInfo -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpanInfo
l) String
"representational"
Phantom SrcSpanInfo
l -> Pos -> String -> EP ()
printStringAt (SrcSpanInfo -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpanInfo
l) String
"phantom"
Nominal SrcSpanInfo
l -> Pos -> String -> EP ()
printStringAt (SrcSpanInfo -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpanInfo
l) String
"nominal"
instance ExactP Annotation where
exactP :: Annotation SrcSpanInfo -> EP ()
exactP Annotation SrcSpanInfo
ann' = case Annotation SrcSpanInfo
ann' of
Ann SrcSpanInfo
_ Name SrcSpanInfo
n Exp SrcSpanInfo
e -> do
Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Name SrcSpanInfo
n
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
TypeAnn SrcSpanInfo
_ Name SrcSpanInfo
n Exp SrcSpanInfo
e -> do
String -> EP ()
printString String
"type"
Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Name SrcSpanInfo
n
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
ModuleAnn SrcSpanInfo
_ Exp SrcSpanInfo
e -> do
String -> EP ()
printString String
"module"
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
instance ExactP BooleanFormula where
exactP :: BooleanFormula SrcSpanInfo -> EP ()
exactP BooleanFormula SrcSpanInfo
b' = case BooleanFormula SrcSpanInfo
b' of
VarFormula SrcSpanInfo
_ Name SrcSpanInfo
n -> Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Name SrcSpanInfo
n
AndFormula SrcSpanInfo
l [BooleanFormula SrcSpanInfo]
bs ->
let pts :: [SrcSpan]
pts = SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l
in [(Pos, EP ())] -> [(Pos, EP ())] -> EP ()
printStreams ([Pos] -> [EP ()] -> [(Pos, EP ())]
forall a b. [a] -> [b] -> [(a, b)]
zip ((SrcSpan -> Pos) -> [SrcSpan] -> [Pos]
forall a b. (a -> b) -> [a] -> [b]
map SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos [SrcSpan]
pts) (EP () -> [EP ()]
forall a. a -> [a]
repeat (EP () -> [EP ()]) -> EP () -> [EP ()]
forall a b. (a -> b) -> a -> b
$ String -> EP ()
printString String
",")) ((BooleanFormula SrcSpanInfo -> (Pos, EP ()))
-> [BooleanFormula SrcSpanInfo] -> [(Pos, EP ())]
forall a b. (a -> b) -> [a] -> [b]
map (SrcSpanInfo -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos (SrcSpanInfo -> Pos)
-> (BooleanFormula SrcSpanInfo -> SrcSpanInfo)
-> BooleanFormula SrcSpanInfo
-> Pos
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BooleanFormula SrcSpanInfo -> SrcSpanInfo
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann (BooleanFormula SrcSpanInfo -> Pos)
-> (BooleanFormula SrcSpanInfo -> EP ())
-> BooleanFormula SrcSpanInfo
-> (Pos, EP ())
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& BooleanFormula SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC) [BooleanFormula SrcSpanInfo]
bs)
OrFormula SrcSpanInfo
l [BooleanFormula SrcSpanInfo]
bs ->
let pts :: [SrcSpan]
pts = SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l
in [(Pos, EP ())] -> [(Pos, EP ())] -> EP ()
printStreams ([Pos] -> [EP ()] -> [(Pos, EP ())]
forall a b. [a] -> [b] -> [(a, b)]
zip ((SrcSpan -> Pos) -> [SrcSpan] -> [Pos]
forall a b. (a -> b) -> [a] -> [b]
map SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos [SrcSpan]
pts) (EP () -> [EP ()]
forall a. a -> [a]
repeat (EP () -> [EP ()]) -> EP () -> [EP ()]
forall a b. (a -> b) -> a -> b
$ String -> EP ()
printString String
"|")) ((BooleanFormula SrcSpanInfo -> (Pos, EP ()))
-> [BooleanFormula SrcSpanInfo] -> [(Pos, EP ())]
forall a b. (a -> b) -> [a] -> [b]
map (SrcSpanInfo -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos (SrcSpanInfo -> Pos)
-> (BooleanFormula SrcSpanInfo -> SrcSpanInfo)
-> BooleanFormula SrcSpanInfo
-> Pos
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BooleanFormula SrcSpanInfo -> SrcSpanInfo
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann (BooleanFormula SrcSpanInfo -> Pos)
-> (BooleanFormula SrcSpanInfo -> EP ())
-> BooleanFormula SrcSpanInfo
-> (Pos, EP ())
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& BooleanFormula SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC) [BooleanFormula SrcSpanInfo]
bs)
ParenFormula SrcSpanInfo
l BooleanFormula SrcSpanInfo
b ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
a'',SrcSpan
b''] -> Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a'') String
"(" EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BooleanFormula SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC BooleanFormula SrcSpanInfo
b EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b'') String
")"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: BooleanFormula: ParenFormula is given wrong number of srcInfoPoints"
printWarndeprs :: [Pos] -> [([Name SrcSpanInfo], String)] -> EP ()
printWarndeprs :: [Pos] -> [([Name SrcSpanInfo], String)] -> EP ()
printWarndeprs [Pos]
_ [] = () -> EP ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
printWarndeprs [Pos]
ps' (([Name SrcSpanInfo]
ns',String
str'):[([Name SrcSpanInfo], String)]
nsts') = [Pos]
-> [Name SrcSpanInfo]
-> String
-> [([Name SrcSpanInfo], String)]
-> EP ()
printWd [Pos]
ps' [Name SrcSpanInfo]
ns' String
str' [([Name SrcSpanInfo], String)]
nsts'
where printWd :: [Pos] -> [Name SrcSpanInfo] -> String -> [([Name SrcSpanInfo], String)] -> EP ()
printWd :: [Pos]
-> [Name SrcSpanInfo]
-> String
-> [([Name SrcSpanInfo], String)]
-> EP ()
printWd (Pos
p:[Pos]
ps) [] String
str [([Name SrcSpanInfo], String)]
nsts = Pos -> String -> EP ()
printStringAt Pos
p (ShowS
forall a. Show a => a -> String
show String
str) EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Pos] -> [([Name SrcSpanInfo], String)] -> EP ()
printWarndeprs [Pos]
ps [([Name SrcSpanInfo], String)]
nsts
printWd [Pos]
ps [Name SrcSpanInfo
n] String
str [([Name SrcSpanInfo], String)]
nsts = Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Name SrcSpanInfo
n EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Pos]
-> [Name SrcSpanInfo]
-> String
-> [([Name SrcSpanInfo], String)]
-> EP ()
printWd [Pos]
ps [] String
str [([Name SrcSpanInfo], String)]
nsts
printWd (Pos
p:[Pos]
ps) (Name SrcSpanInfo
n:[Name SrcSpanInfo]
ns) String
str [([Name SrcSpanInfo], String)]
nsts = Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Name SrcSpanInfo
n EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pos -> String -> EP ()
printStringAt Pos
p String
"," EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Pos]
-> [Name SrcSpanInfo]
-> String
-> [([Name SrcSpanInfo], String)]
-> EP ()
printWd [Pos]
ps [Name SrcSpanInfo]
ns String
str [([Name SrcSpanInfo], String)]
nsts
printWd [Pos]
_ [Name SrcSpanInfo]
_ String
_ [([Name SrcSpanInfo], String)]
_ = String -> EP ()
forall a. String -> a
internalError String
"printWd"
sepFunBinds :: [Decl SrcSpanInfo] -> [Decl SrcSpanInfo]
sepFunBinds :: [Decl SrcSpanInfo] -> [Decl SrcSpanInfo]
sepFunBinds [] = []
sepFunBinds (FunBind SrcSpanInfo
_ [Match SrcSpanInfo]
ms:[Decl SrcSpanInfo]
ds) = (Match SrcSpanInfo -> Decl SrcSpanInfo)
-> [Match SrcSpanInfo] -> [Decl SrcSpanInfo]
forall a b. (a -> b) -> [a] -> [b]
map (\Match SrcSpanInfo
m -> SrcSpanInfo -> [Match SrcSpanInfo] -> Decl SrcSpanInfo
forall l. l -> [Match l] -> Decl l
FunBind (Match SrcSpanInfo -> SrcSpanInfo
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann Match SrcSpanInfo
m) [Match SrcSpanInfo
m]) [Match SrcSpanInfo]
ms [Decl SrcSpanInfo] -> [Decl SrcSpanInfo] -> [Decl SrcSpanInfo]
forall a. [a] -> [a] -> [a]
++ [Decl SrcSpanInfo] -> [Decl SrcSpanInfo]
sepFunBinds [Decl SrcSpanInfo]
ds
sepFunBinds (Decl SrcSpanInfo
d:[Decl SrcSpanInfo]
ds) = Decl SrcSpanInfo
d Decl SrcSpanInfo -> [Decl SrcSpanInfo] -> [Decl SrcSpanInfo]
forall a. a -> [a] -> [a]
: [Decl SrcSpanInfo] -> [Decl SrcSpanInfo]
sepFunBinds [Decl SrcSpanInfo]
ds
sepClassFunBinds :: [ClassDecl SrcSpanInfo] -> [ClassDecl SrcSpanInfo]
sepClassFunBinds :: [ClassDecl SrcSpanInfo] -> [ClassDecl SrcSpanInfo]
sepClassFunBinds [] = []
sepClassFunBinds (ClsDecl SrcSpanInfo
_ (FunBind SrcSpanInfo
_ [Match SrcSpanInfo]
ms):[ClassDecl SrcSpanInfo]
ds) = (Match SrcSpanInfo -> ClassDecl SrcSpanInfo)
-> [Match SrcSpanInfo] -> [ClassDecl SrcSpanInfo]
forall a b. (a -> b) -> [a] -> [b]
map (\Match SrcSpanInfo
m -> SrcSpanInfo -> Decl SrcSpanInfo -> ClassDecl SrcSpanInfo
forall l. l -> Decl l -> ClassDecl l
ClsDecl (Match SrcSpanInfo -> SrcSpanInfo
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann Match SrcSpanInfo
m) (Decl SrcSpanInfo -> ClassDecl SrcSpanInfo)
-> Decl SrcSpanInfo -> ClassDecl SrcSpanInfo
forall a b. (a -> b) -> a -> b
$ SrcSpanInfo -> [Match SrcSpanInfo] -> Decl SrcSpanInfo
forall l. l -> [Match l] -> Decl l
FunBind (Match SrcSpanInfo -> SrcSpanInfo
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann Match SrcSpanInfo
m) [Match SrcSpanInfo
m]) [Match SrcSpanInfo]
ms [ClassDecl SrcSpanInfo]
-> [ClassDecl SrcSpanInfo] -> [ClassDecl SrcSpanInfo]
forall a. [a] -> [a] -> [a]
++ [ClassDecl SrcSpanInfo] -> [ClassDecl SrcSpanInfo]
sepClassFunBinds [ClassDecl SrcSpanInfo]
ds
sepClassFunBinds (ClassDecl SrcSpanInfo
d:[ClassDecl SrcSpanInfo]
ds) = ClassDecl SrcSpanInfo
d ClassDecl SrcSpanInfo
-> [ClassDecl SrcSpanInfo] -> [ClassDecl SrcSpanInfo]
forall a. a -> [a] -> [a]
: [ClassDecl SrcSpanInfo] -> [ClassDecl SrcSpanInfo]
sepClassFunBinds [ClassDecl SrcSpanInfo]
ds
sepInstFunBinds :: [InstDecl SrcSpanInfo] -> [InstDecl SrcSpanInfo]
sepInstFunBinds :: [InstDecl SrcSpanInfo] -> [InstDecl SrcSpanInfo]
sepInstFunBinds [] = []
sepInstFunBinds (InsDecl SrcSpanInfo
_ (FunBind SrcSpanInfo
_ [Match SrcSpanInfo]
ms):[InstDecl SrcSpanInfo]
ds) = (Match SrcSpanInfo -> InstDecl SrcSpanInfo)
-> [Match SrcSpanInfo] -> [InstDecl SrcSpanInfo]
forall a b. (a -> b) -> [a] -> [b]
map (\Match SrcSpanInfo
m -> SrcSpanInfo -> Decl SrcSpanInfo -> InstDecl SrcSpanInfo
forall l. l -> Decl l -> InstDecl l
InsDecl (Match SrcSpanInfo -> SrcSpanInfo
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann Match SrcSpanInfo
m) (Decl SrcSpanInfo -> InstDecl SrcSpanInfo)
-> Decl SrcSpanInfo -> InstDecl SrcSpanInfo
forall a b. (a -> b) -> a -> b
$ SrcSpanInfo -> [Match SrcSpanInfo] -> Decl SrcSpanInfo
forall l. l -> [Match l] -> Decl l
FunBind (Match SrcSpanInfo -> SrcSpanInfo
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann Match SrcSpanInfo
m) [Match SrcSpanInfo
m]) [Match SrcSpanInfo]
ms [InstDecl SrcSpanInfo]
-> [InstDecl SrcSpanInfo] -> [InstDecl SrcSpanInfo]
forall a. [a] -> [a] -> [a]
++ [InstDecl SrcSpanInfo] -> [InstDecl SrcSpanInfo]
sepInstFunBinds [InstDecl SrcSpanInfo]
ds
sepInstFunBinds (InstDecl SrcSpanInfo
d:[InstDecl SrcSpanInfo]
ds) = InstDecl SrcSpanInfo
d InstDecl SrcSpanInfo
-> [InstDecl SrcSpanInfo] -> [InstDecl SrcSpanInfo]
forall a. a -> [a] -> [a]
: [InstDecl SrcSpanInfo] -> [InstDecl SrcSpanInfo]
sepInstFunBinds [InstDecl SrcSpanInfo]
ds
instance ExactP DeclHead where
exactP :: DeclHead SrcSpanInfo -> EP ()
exactP DeclHead SrcSpanInfo
dh' = case DeclHead SrcSpanInfo
dh' of
DHead SrcSpanInfo
_ Name SrcSpanInfo
n -> Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Name SrcSpanInfo
n
DHInfix SrcSpanInfo
_ TyVarBind SrcSpanInfo
tva Name SrcSpanInfo
n -> TyVarBind SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP TyVarBind SrcSpanInfo
tva EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Name SrcSpanInfo -> EP ()
epInfixName Name SrcSpanInfo
n
DHParen SrcSpanInfo
l DeclHead SrcSpanInfo
dh ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
_,SrcSpan
b] -> String -> EP ()
printString String
"(" EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DeclHead SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC DeclHead SrcSpanInfo
dh EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
")"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: DeclHead: DeclParen is given wrong number of srcInfoPoints"
DHApp SrcSpanInfo
_ DeclHead SrcSpanInfo
dh TyVarBind SrcSpanInfo
t -> DeclHead SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP DeclHead SrcSpanInfo
dh EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TyVarBind SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC TyVarBind SrcSpanInfo
t
instance ExactP InstRule where
exactP :: InstRule SrcSpanInfo -> EP ()
exactP InstRule SrcSpanInfo
ih' = case InstRule SrcSpanInfo
ih' of
IRule SrcSpanInfo
l Maybe [TyVarBind SrcSpanInfo]
mtvs Maybe (Context SrcSpanInfo)
mctxt InstHead SrcSpanInfo
qn -> do
let pts :: [SrcSpan]
pts = SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l
[SrcSpan]
_ <- case Maybe [TyVarBind SrcSpanInfo]
mtvs of
Maybe [TyVarBind SrcSpanInfo]
Nothing -> [SrcSpan] -> EP [SrcSpan]
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts
Just [TyVarBind SrcSpanInfo]
tvs ->
case [SrcSpan]
pts of
[SrcSpan
a,SrcSpan
b] -> do
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"forall"
(TyVarBind SrcSpanInfo -> EP ())
-> [TyVarBind SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ TyVarBind SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [TyVarBind SrcSpanInfo]
tvs
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"."
[SrcSpan] -> EP [SrcSpan]
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts
[SrcSpan]
_ -> String -> EP [SrcSpan]
forall a. String -> EP a
errorEP String
"ExactP: InstRule: IRule is given too few srcInfoPoints"
(Context SrcSpanInfo -> EP ())
-> Maybe (Context SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Context SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (Context SrcSpanInfo)
mctxt
InstHead SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC InstHead SrcSpanInfo
qn
IParen SrcSpanInfo
l InstRule SrcSpanInfo
ih ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
a,SrcSpan
b] -> Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"(" EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> InstRule SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC InstRule SrcSpanInfo
ih EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
")"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: InstRule: IParen is given wrong number of srcInfoPoints"
instance ExactP InstHead where
exactP :: InstHead SrcSpanInfo -> EP ()
exactP InstHead SrcSpanInfo
doih' = case InstHead SrcSpanInfo
doih' of
IHCon SrcSpanInfo
_ QName SrcSpanInfo
qn -> QName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC QName SrcSpanInfo
qn
IHInfix SrcSpanInfo
_ Type SrcSpanInfo
ta QName SrcSpanInfo
qn -> Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
ta EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> QName SrcSpanInfo -> EP ()
epInfixQName QName SrcSpanInfo
qn
IHParen SrcSpanInfo
l InstHead SrcSpanInfo
doih ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
a,SrcSpan
b] -> Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"(" EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> InstHead SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC InstHead SrcSpanInfo
doih EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
")"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: OrInstHead: IHParen is given wrong number of srcInfoPoints"
IHApp SrcSpanInfo
_ InstHead SrcSpanInfo
doih Type SrcSpanInfo
t -> InstHead SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC InstHead SrcSpanInfo
doih EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t
instance ExactP TyVarBind where
exactP :: TyVarBind SrcSpanInfo -> EP ()
exactP (KindedVar SrcSpanInfo
l Name SrcSpanInfo
n Type SrcSpanInfo
k) =
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
_,SrcSpan
b,SrcSpan
c] -> do
String -> EP ()
printString String
"("
Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Name SrcSpanInfo
n
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"::"
Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
k
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
c) String
")"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: TyVarBind: KindedVar is given wrong number of srcInfoPoints"
exactP (UnkindedVar SrcSpanInfo
l Name SrcSpanInfo
n) =
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
a,SrcSpan
_,SrcSpan
c] -> do
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"("
Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Name SrcSpanInfo
n
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
c) String
")"
[] -> Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Name SrcSpanInfo
n
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: TyVarBind: UnkindedVar is given wrong number of srcInfoPoints"
instance ExactP Type where
exactP :: Type SrcSpanInfo -> EP ()
exactP Type SrcSpanInfo
t' = case Type SrcSpanInfo
t' of
TyForall SrcSpanInfo
l Maybe [TyVarBind SrcSpanInfo]
mtvs Maybe (Context SrcSpanInfo)
mctxt Type SrcSpanInfo
t -> do
let pts :: [SrcSpan]
pts = SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l
[SrcSpan]
_ <- case Maybe [TyVarBind SrcSpanInfo]
mtvs of
Maybe [TyVarBind SrcSpanInfo]
Nothing -> [SrcSpan] -> EP [SrcSpan]
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts
Just [TyVarBind SrcSpanInfo]
tvs ->
case [SrcSpan]
pts of
SrcSpan
_:SrcSpan
b:[SrcSpan]
pts' -> do
String -> EP ()
printString String
"forall"
(TyVarBind SrcSpanInfo -> EP ())
-> [TyVarBind SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ TyVarBind SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [TyVarBind SrcSpanInfo]
tvs
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"."
[SrcSpan] -> EP [SrcSpan]
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts'
[SrcSpan]
_ -> String -> EP [SrcSpan]
forall a. String -> EP a
errorEP String
"ExactP: Type: TyForall is given too few srcInfoPoints"
(Context SrcSpanInfo -> EP ())
-> Maybe (Context SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Context SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (Context SrcSpanInfo)
mctxt
Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t
TyStar SrcSpanInfo
_ -> String -> EP ()
printString String
"*"
TyFun SrcSpanInfo
l Type SrcSpanInfo
t1 Type SrcSpanInfo
t2 ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
a] -> do
Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Type SrcSpanInfo
t1
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"->"
Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t2
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Type: TyFun is given wrong number of srcInfoPoints"
TyTuple SrcSpanInfo
l Boxed
bx [Type SrcSpanInfo]
ts ->
case Boxed
bx of
Boxed
Boxed -> [SrcSpan] -> [Type SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
parenList (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) [Type SrcSpanInfo]
ts
Boxed
Unboxed -> [SrcSpan] -> [Type SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
parenHashList (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) [Type SrcSpanInfo]
ts
TyUnboxedSum SrcSpanInfo
l [Type SrcSpanInfo]
es ->
[SrcSpan] -> [Type SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
unboxedSumTypeList (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) [Type SrcSpanInfo]
es
TyList SrcSpanInfo
l Type SrcSpanInfo
t ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
_,SrcSpan
b] -> do
String -> EP ()
printString String
"["
Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"]"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Type: TyList is given wrong number of srcInfoPoints"
TyParArray SrcSpanInfo
l Type SrcSpanInfo
t ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
_,SrcSpan
b] -> do
String -> EP ()
printString String
"[:"
Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
":]"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Type: TyParArray is given wrong number of srcInfoPoints"
TyApp SrcSpanInfo
_ Type SrcSpanInfo
t1 Type SrcSpanInfo
t2 -> Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Type SrcSpanInfo
t1 EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t2
TyVar SrcSpanInfo
_ Name SrcSpanInfo
n -> Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Name SrcSpanInfo
n
TyCon SrcSpanInfo
_ QName SrcSpanInfo
qn -> QName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP QName SrcSpanInfo
qn
TyParen SrcSpanInfo
l Type SrcSpanInfo
t ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
_,SrcSpan
b] -> do
String -> EP ()
printString String
"("
Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
")"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Type: TyParen is given wrong number of srcInfoPoints"
TyInfix SrcSpanInfo
_ Type SrcSpanInfo
t1 MaybePromotedName SrcSpanInfo
qn Type SrcSpanInfo
t2 -> Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Type SrcSpanInfo
t1 EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MaybePromotedName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP MaybePromotedName SrcSpanInfo
qn EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t2
TyKind SrcSpanInfo
l Type SrcSpanInfo
t Type SrcSpanInfo
kd ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
_,SrcSpan
b,SrcSpan
c] -> do
String -> EP ()
printString String
"("
Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"::"
Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
kd
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
c) String
")"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Type: TyKind is given wrong number of srcInfoPoints"
TyPromoted SrcSpanInfo
_ Promoted SrcSpanInfo
p -> Promoted SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Promoted SrcSpanInfo
p
TyEquals SrcSpanInfo
l Type SrcSpanInfo
t0 Type SrcSpanInfo
t1 -> case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
SrcSpan
a:[SrcSpan]
_ -> Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t0 EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"~" EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t1
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Type: TyEquals is given wrong number of srcInfoPoints"
TySplice SrcSpanInfo
_ Splice SrcSpanInfo
sp -> Splice SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Splice SrcSpanInfo
sp
TyBang SrcSpanInfo
_ BangType SrcSpanInfo
b Unpackedness SrcSpanInfo
u Type SrcSpanInfo
t -> Unpackedness SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Unpackedness SrcSpanInfo
u EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BangType SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC BangType SrcSpanInfo
b EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t
TyWildCard SrcSpanInfo
_ Maybe (Name SrcSpanInfo)
mn -> String -> EP ()
printString String
"_" EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Name SrcSpanInfo -> EP ()) -> Maybe (Name SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (Name SrcSpanInfo)
mn
TyQuasiQuote SrcSpanInfo
_ String
name String
qt -> do
let qtLines :: [String]
qtLines = String -> [String]
lines String
qt
String -> EP ()
printString (String -> EP ()) -> String -> EP ()
forall a b. (a -> b) -> a -> b
$ String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"|"
[EP ()] -> EP ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ (EP () -> [EP ()] -> [EP ()]
forall a. a -> [a] -> [a]
intersperse EP ()
newLine ([EP ()] -> [EP ()]) -> [EP ()] -> [EP ()]
forall a b. (a -> b) -> a -> b
$ (String -> EP ()) -> [String] -> [EP ()]
forall a b. (a -> b) -> [a] -> [b]
map String -> EP ()
printString [String]
qtLines)
String -> EP ()
printString String
"|]"
instance ExactP MaybePromotedName where
exactP :: MaybePromotedName SrcSpanInfo -> EP ()
exactP (PromotedName SrcSpanInfo
l QName SrcSpanInfo
qn) = case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
a] -> Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"'" EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> QName SrcSpanInfo -> EP ()
epInfixQName QName SrcSpanInfo
qn
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: MaybePromotedName: PromotedName given wrong number of args"
exactP (UnpromotedName SrcSpanInfo
_ QName SrcSpanInfo
qn) = QName SrcSpanInfo -> EP ()
epInfixQName QName SrcSpanInfo
qn
instance ExactP Promoted where
exactP :: Promoted SrcSpanInfo -> EP ()
exactP (PromotedInteger SrcSpanInfo
_ Integer
_ String
rw) = String -> EP ()
printString String
rw
exactP (PromotedString SrcSpanInfo
_ String
_ String
rw) = String -> EP ()
printString (Char
'\"'Char -> ShowS
forall a. a -> [a] -> [a]
:String
rw String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\"")
exactP (PromotedCon SrcSpanInfo
l Bool
True QName SrcSpanInfo
qn) = case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
a] -> Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"'" EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> QName SrcSpanInfo -> EP ()
epQName QName SrcSpanInfo
qn
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Promoted: PromotedCon is given wrong number of srcInfoPoints"
exactP (PromotedCon SrcSpanInfo
_ Bool
False QName SrcSpanInfo
qn) = QName SrcSpanInfo -> EP ()
epQName QName SrcSpanInfo
qn
exactP (PromotedList SrcSpanInfo
l Bool
b [Type SrcSpanInfo]
pl) =
let o :: String
o | Bool
b = String
"'[" | Bool
otherwise = String
"["
e :: String
e = String
"]"
pts :: [SrcSpan]
pts = SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l
in [(SrcSpan, String)] -> [Type SrcSpanInfo] -> EP ()
forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved ([SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SrcSpan]
pts (String
oString -> [String] -> [String]
forall a. a -> [a] -> [a]
: Int -> String -> [String]
forall a. Int -> a -> [a]
replicate ([SrcSpan] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SrcSpan]
pts Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) String
"," [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
e])) [Type SrcSpanInfo]
pl
exactP (PromotedTuple SrcSpanInfo
l [Type SrcSpanInfo]
pl) =
let o :: String
o = String
"'("
e :: String
e = String
")"
pts :: [SrcSpan]
pts = SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l
in [(SrcSpan, String)] -> [Type SrcSpanInfo] -> EP ()
forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved ([SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SrcSpan]
pts (String
oString -> [String] -> [String]
forall a. a -> [a] -> [a]
: Int -> String -> [String]
forall a. Int -> a -> [a]
replicate ([SrcSpan] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SrcSpan]
pts Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) String
"," [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
e])) [Type SrcSpanInfo]
pl
exactP (PromotedUnit SrcSpanInfo
l) = case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
_,SrcSpan
b] -> do
String -> EP ()
printString String
"("
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
")"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Promoted: PromotedUnit is given wrong number of srcInfoPoints"
instance ExactP Context where
exactP :: Context SrcSpanInfo -> EP ()
exactP Context SrcSpanInfo
ctxt = do
Context SrcSpanInfo -> EP ()
printContext Context SrcSpanInfo
ctxt
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos (SrcSpan -> Pos)
-> (Context SrcSpanInfo -> SrcSpan) -> Context SrcSpanInfo -> Pos
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SrcSpan] -> SrcSpan
forall a. [a] -> a
last ([SrcSpan] -> SrcSpan)
-> (Context SrcSpanInfo -> [SrcSpan])
-> Context SrcSpanInfo
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpanInfo -> [SrcSpan]
srcInfoPoints (SrcSpanInfo -> [SrcSpan])
-> (Context SrcSpanInfo -> SrcSpanInfo)
-> Context SrcSpanInfo
-> [SrcSpan]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context SrcSpanInfo -> SrcSpanInfo
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann (Context SrcSpanInfo -> Pos) -> Context SrcSpanInfo -> Pos
forall a b. (a -> b) -> a -> b
$ Context SrcSpanInfo
ctxt) String
"=>"
printContext :: Context SrcSpanInfo -> EP ()
printContext :: Context SrcSpanInfo -> EP ()
printContext Context SrcSpanInfo
ctxt = do
let l :: SrcSpanInfo
l = Context SrcSpanInfo -> SrcSpanInfo
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann Context SrcSpanInfo
ctxt
pts :: [SrcSpan]
pts = [SrcSpan] -> [SrcSpan]
forall a. [a] -> [a]
init ([SrcSpan] -> [SrcSpan]) -> [SrcSpan] -> [SrcSpan]
forall a b. (a -> b) -> a -> b
$ SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l
case Context SrcSpanInfo
ctxt of
CxSingle SrcSpanInfo
_ Asst SrcSpanInfo
asst -> Asst SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Asst SrcSpanInfo
asst
CxEmpty SrcSpanInfo
_ ->
case [SrcSpan]
pts of
[SrcSpan
a,SrcSpan
b] -> do
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"("
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
")"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Context: CxEmpty is given wrong number of srcInfoPoints"
CxTuple SrcSpanInfo
_ [Asst SrcSpanInfo]
assts -> [SrcSpan] -> [Asst SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
parenList [SrcSpan]
pts [Asst SrcSpanInfo]
assts
instance ExactP Asst where
exactP :: Asst SrcSpanInfo -> EP ()
exactP Asst SrcSpanInfo
asst = case Asst SrcSpanInfo
asst of
TypeA SrcSpanInfo
_ Type SrcSpanInfo
t -> Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Type SrcSpanInfo
t
IParam SrcSpanInfo
l IPName SrcSpanInfo
ipn Type SrcSpanInfo
t ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
a] -> do
IPName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP IPName SrcSpanInfo
ipn
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"::"
Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Asst: IParam is given wrong number of srcInfoPoints"
ParenA SrcSpanInfo
l Asst SrcSpanInfo
asst' ->
case Int -> [SrcSpan] -> [SrcSpan]
forall a. Int -> [a] -> [a]
take Int
2 ([SrcSpan] -> [SrcSpan]) -> [SrcSpan] -> [SrcSpan]
forall a b. (a -> b) -> a -> b
$ SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
a,SrcSpan
b] -> do
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"("
Asst SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Asst SrcSpanInfo
asst'
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
")"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Asst: ParenA is given wrong number of srcInfoPoints"
instance ExactP Deriving where
exactP :: Deriving SrcSpanInfo -> EP ()
exactP (Deriving SrcSpanInfo
l Maybe (DerivStrategy SrcSpanInfo)
mds [InstRule SrcSpanInfo]
ihs) =
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
SrcSpan
_:[SrcSpan]
pts -> do
String -> EP ()
printString String
"deriving"
(DerivStrategy SrcSpanInfo -> EP ())
-> Maybe (DerivStrategy SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP DerivStrategy SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (DerivStrategy SrcSpanInfo)
mds
case [SrcSpan]
pts of
[] -> InstRule SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC (InstRule SrcSpanInfo -> EP ()) -> InstRule SrcSpanInfo -> EP ()
forall a b. (a -> b) -> a -> b
$ [InstRule SrcSpanInfo] -> InstRule SrcSpanInfo
forall a. [a] -> a
head [InstRule SrcSpanInfo]
ihs
[SrcSpan]
_ -> [SrcSpan] -> [InstRule SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
parenList [SrcSpan]
pts [InstRule SrcSpanInfo]
ihs
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Deriving is given too few srcInfoPoints"
instance ExactP DerivStrategy where
exactP :: DerivStrategy SrcSpanInfo -> EP ()
exactP (DerivStock SrcSpanInfo
_) =
String -> EP ()
printString String
"stock"
exactP (DerivAnyclass SrcSpanInfo
_) =
String -> EP ()
printString String
"anyclass"
exactP (DerivNewtype SrcSpanInfo
_) =
String -> EP ()
printString String
"newtype"
exactP (DerivVia SrcSpanInfo
_ Type SrcSpanInfo
ty) = do
String -> EP ()
printString String
"via"
Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Type SrcSpanInfo
ty
instance ExactP ClassDecl where
exactP :: ClassDecl SrcSpanInfo -> EP ()
exactP ClassDecl SrcSpanInfo
cdecl = case ClassDecl SrcSpanInfo
cdecl of
ClsDecl SrcSpanInfo
_ Decl SrcSpanInfo
d -> Decl SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Decl SrcSpanInfo
d
ClsDataFam SrcSpanInfo
l Maybe (Context SrcSpanInfo)
mctxt DeclHead SrcSpanInfo
dh Maybe (ResultSig SrcSpanInfo)
mk ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
SrcSpan
_:[SrcSpan]
pts -> do
String -> EP ()
printString String
"data"
(Context SrcSpanInfo -> EP ())
-> Maybe (Context SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Context SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (Context SrcSpanInfo)
mctxt
DeclHead SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC DeclHead SrcSpanInfo
dh
(ResultSig SrcSpanInfo -> EP ())
-> Maybe (ResultSig SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP (\ResultSig SrcSpanInfo
kd -> Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos ([SrcSpan] -> SrcSpan
forall a. [a] -> a
head [SrcSpan]
pts)) String
"::" EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ResultSig SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC ResultSig SrcSpanInfo
kd) Maybe (ResultSig SrcSpanInfo)
mk
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: ClassDecl: ClsDataFam is given too few srcInfoPoints"
ClsTyFam SrcSpanInfo
l DeclHead SrcSpanInfo
dh Maybe (ResultSig SrcSpanInfo)
mk Maybe (InjectivityInfo SrcSpanInfo)
mi ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
SrcSpan
_:[SrcSpan]
_ -> do
String -> EP ()
printString String
"type"
DeclHead SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC DeclHead SrcSpanInfo
dh
(ResultSig SrcSpanInfo -> EP ())
-> Maybe (ResultSig SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP ResultSig SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (ResultSig SrcSpanInfo)
mk
(InjectivityInfo SrcSpanInfo -> EP ())
-> Maybe (InjectivityInfo SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP InjectivityInfo SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (InjectivityInfo SrcSpanInfo)
mi
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: ClassDecl: ClsTyFam is given too few srcInfoPoints"
ClsTyDef SrcSpanInfo
l TypeEqn SrcSpanInfo
t1 ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
SrcSpan
_:SrcSpan
b:[SrcSpan]
_ -> do
String -> EP ()
printString String
"type"
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"instance"
TypeEqn SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC TypeEqn SrcSpanInfo
t1
SrcSpan
_:[SrcSpan]
_ -> do
String -> EP ()
printString String
"type"
TypeEqn SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC TypeEqn SrcSpanInfo
t1
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: ClassDecl: ClsTyDef is given too few srcInfoPoints"
ClsDefSig SrcSpanInfo
l Name SrcSpanInfo
n Type SrcSpanInfo
t ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
SrcSpan
_:SrcSpan
b:[SrcSpan]
_ -> do
String -> EP ()
printString String
"default"
Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Name SrcSpanInfo
n
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"::"
Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: ClassDecl: ClsDefSig is given too few srcInfoPoints"
instance ExactP InstDecl where
exactP :: InstDecl SrcSpanInfo -> EP ()
exactP InstDecl SrcSpanInfo
idecl = case InstDecl SrcSpanInfo
idecl of
InsDecl SrcSpanInfo
_ Decl SrcSpanInfo
d -> Decl SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Decl SrcSpanInfo
d
InsType SrcSpanInfo
l Type SrcSpanInfo
t1 Type SrcSpanInfo
t2 ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
_,SrcSpan
b] -> do
String -> EP ()
printString String
"type"
Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t1
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"="
Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t2
[SrcSpan]
_ -> String -> EP ()
forall a. String -> a
internalError String
"InstDecl -> InsType"
InsData SrcSpanInfo
l DataOrNew SrcSpanInfo
dn Type SrcSpanInfo
t [QualConDecl SrcSpanInfo]
constrs [Deriving SrcSpanInfo]
mder -> do
DataOrNew SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP DataOrNew SrcSpanInfo
dn
Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t
[(SrcSpan, String)] -> [QualConDecl SrcSpanInfo] -> EP ()
forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved ([SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) (String
"="String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
forall a. a -> [a]
repeat String
"|")) [QualConDecl SrcSpanInfo]
constrs
(Deriving SrcSpanInfo -> EP ()) -> [Deriving SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Deriving SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [Deriving SrcSpanInfo]
mder
InsGData SrcSpanInfo
l DataOrNew SrcSpanInfo
dn Type SrcSpanInfo
t Maybe (Type SrcSpanInfo)
mk [GadtDecl SrcSpanInfo]
gds [Deriving SrcSpanInfo]
mder -> do
let pts :: [SrcSpan]
pts = SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l
DataOrNew SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP DataOrNew SrcSpanInfo
dn
Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t
[SrcSpan]
pts1 <- case Maybe (Type SrcSpanInfo)
mk of
Maybe (Type SrcSpanInfo)
Nothing -> [SrcSpan] -> EP [SrcSpan]
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts
Just Type SrcSpanInfo
kd -> case [SrcSpan]
pts of
SrcSpan
p:[SrcSpan]
pts' -> do
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
p) String
"::"
Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
kd
[SrcSpan] -> EP [SrcSpan]
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts'
[SrcSpan]
_ -> String -> EP [SrcSpan]
forall a. String -> EP a
errorEP String
"ExactP: InstDecl: InsGData is given too few srcInfoPoints"
case [SrcSpan]
pts1 of
SrcSpan
x:[SrcSpan]
_ -> do
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
x) String
"where"
(GadtDecl SrcSpanInfo -> EP ()) -> [GadtDecl SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ GadtDecl SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [GadtDecl SrcSpanInfo]
gds
(Deriving SrcSpanInfo -> EP ()) -> [Deriving SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Deriving SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [Deriving SrcSpanInfo]
mder
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: InstDecl: InsGData is given too few srcInfoPoints"
instance ExactP FunDep where
exactP :: FunDep SrcSpanInfo -> EP ()
exactP (FunDep SrcSpanInfo
l [Name SrcSpanInfo]
nxs [Name SrcSpanInfo]
nys) =
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
a] -> do
(Name SrcSpanInfo -> EP ()) -> [Name SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [Name SrcSpanInfo]
nxs
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"->"
(Name SrcSpanInfo -> EP ()) -> [Name SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [Name SrcSpanInfo]
nys
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: FunDep is given wrong number of srcInfoPoints"
instance ExactP QualConDecl where
exactP :: QualConDecl SrcSpanInfo -> EP ()
exactP (QualConDecl SrcSpanInfo
l Maybe [TyVarBind SrcSpanInfo]
mtvs Maybe (Context SrcSpanInfo)
mctxt ConDecl SrcSpanInfo
cd) = do
let pts :: [SrcSpan]
pts = SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l
[SrcSpan]
_ <- case Maybe [TyVarBind SrcSpanInfo]
mtvs of
Maybe [TyVarBind SrcSpanInfo]
Nothing -> [SrcSpan] -> EP [SrcSpan]
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts
Just [TyVarBind SrcSpanInfo]
tvs ->
case [SrcSpan]
pts of
SrcSpan
_:SrcSpan
b:[SrcSpan]
pts' -> do
String -> EP ()
printString String
"forall"
(TyVarBind SrcSpanInfo -> EP ())
-> [TyVarBind SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ TyVarBind SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [TyVarBind SrcSpanInfo]
tvs
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"."
[SrcSpan] -> EP [SrcSpan]
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts'
[SrcSpan]
_ -> String -> EP [SrcSpan]
forall a. String -> EP a
errorEP String
"ExactP: QualConDecl is given wrong number of srcInfoPoints"
(Context SrcSpanInfo -> EP ())
-> Maybe (Context SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Context SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (Context SrcSpanInfo)
mctxt
ConDecl SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC ConDecl SrcSpanInfo
cd
instance ExactP ConDecl where
exactP :: ConDecl SrcSpanInfo -> EP ()
exactP ConDecl SrcSpanInfo
cd = case ConDecl SrcSpanInfo
cd of
ConDecl SrcSpanInfo
_ Name SrcSpanInfo
n [Type SrcSpanInfo]
bts -> Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Name SrcSpanInfo
n EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Type SrcSpanInfo -> EP ()) -> [Type SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [Type SrcSpanInfo]
bts
InfixConDecl SrcSpanInfo
_ Type SrcSpanInfo
bta Name SrcSpanInfo
n Type SrcSpanInfo
btb -> Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Type SrcSpanInfo
bta EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Name SrcSpanInfo -> EP ()
epInfixName Name SrcSpanInfo
n EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Type SrcSpanInfo
btb
RecDecl SrcSpanInfo
l Name SrcSpanInfo
n [FieldDecl SrcSpanInfo]
fds -> Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Name SrcSpanInfo
n EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [SrcSpan] -> [FieldDecl SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
curlyList (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) [FieldDecl SrcSpanInfo]
fds
instance ExactP GadtDecl where
exactP :: GadtDecl SrcSpanInfo -> EP ()
exactP (GadtDecl SrcSpanInfo
l Name SrcSpanInfo
n Maybe [TyVarBind SrcSpanInfo]
_mtvs Maybe (Context SrcSpanInfo)
mctxt Maybe [FieldDecl SrcSpanInfo]
ns' Type SrcSpanInfo
t) =
case Maybe [FieldDecl SrcSpanInfo]
ns' of
Maybe [FieldDecl SrcSpanInfo]
Nothing ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
a] -> do
Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Name SrcSpanInfo
n
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"::"
Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: GadtDecl is given wrong number of srcInfoPoints"
Just [FieldDecl SrcSpanInfo]
ts ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
(SrcSpan
a:SrcSpan
b:SrcSpan
c:SrcSpan
d:[SrcSpan]
rest) -> do
Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Name SrcSpanInfo
n
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"::"
(Context SrcSpanInfo -> EP ())
-> Maybe (Context SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Context SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (Context SrcSpanInfo)
mctxt
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"{"
[(SrcSpan, String)] -> [FieldDecl SrcSpanInfo] -> EP ()
forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved' ([SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SrcSpan]
rest (String -> [String]
forall a. a -> [a]
repeat String
",")) [FieldDecl SrcSpanInfo]
ts
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
c) String
"}"
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
d) String
"->"
Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: GadtDecl is given wrong number of srcInfoPoints"
instance ExactP BangType where
exactP :: BangType SrcSpanInfo -> EP ()
exactP BangType SrcSpanInfo
bt = case BangType SrcSpanInfo
bt of
BangedTy SrcSpanInfo
l -> Pos -> String -> EP ()
printStringAt (SrcSpanInfo -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpanInfo
l) String
"!"
LazyTy SrcSpanInfo
l -> Pos -> String -> EP ()
printStringAt (SrcSpanInfo -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpanInfo
l) String
"~"
BangType SrcSpanInfo
_ -> () -> EP ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
instance ExactP Unpackedness where
exactP :: Unpackedness SrcSpanInfo -> EP ()
exactP Unpackedness SrcSpanInfo
bt = case Unpackedness SrcSpanInfo
bt of
Unpack SrcSpanInfo
l ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
a,SrcSpan
b] -> do
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"{-# UNPACK"
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"#-}"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Unpackedness: Unpack is given wrong number of srcInfoPoints"
NoUnpack SrcSpanInfo
l ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
a,SrcSpan
b] -> do
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"{-# NOUNPACK"
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"#-}"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Unpackedness: NoUnpack is given wrong number of srcInfoPoints"
NoUnpackPragma {} -> () -> EP ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
instance ExactP Splice where
exactP :: Splice SrcSpanInfo -> EP ()
exactP (IdSplice SrcSpanInfo
_ String
str) = String -> EP ()
printString (String -> EP ()) -> String -> EP ()
forall a b. (a -> b) -> a -> b
$ Char
'$'Char -> ShowS
forall a. a -> [a] -> [a]
:String
str
exactP (TIdSplice SrcSpanInfo
_ String
str) = String -> EP ()
printString (String -> EP ()) -> String -> EP ()
forall a b. (a -> b) -> a -> b
$ String
"$$" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
str
exactP (ParenSplice SrcSpanInfo
l Exp SrcSpanInfo
e) = String -> String -> SrcSpanInfo -> Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *).
ExactP ast =>
String -> String -> SrcSpanInfo -> ast SrcSpanInfo -> EP ()
printParen String
"ParenSplice" String
"$(" SrcSpanInfo
l Exp SrcSpanInfo
e
exactP (TParenSplice SrcSpanInfo
l Exp SrcSpanInfo
e) = String -> String -> SrcSpanInfo -> Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *).
ExactP ast =>
String -> String -> SrcSpanInfo -> ast SrcSpanInfo -> EP ()
printParen String
"TParenSplice" String
"$$(" SrcSpanInfo
l Exp SrcSpanInfo
e
printParen :: ExactP ast => String -> String -> SrcSpanInfo -> ast SrcSpanInfo -> EP ()
printParen :: String -> String -> SrcSpanInfo -> ast SrcSpanInfo -> EP ()
printParen String
con String
paren SrcSpanInfo
l ast SrcSpanInfo
e =
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
_,SrcSpan
b] -> do
String -> EP ()
printString String
paren
ast SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC ast SrcSpanInfo
e
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
")"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP (String -> EP ()) -> String -> EP ()
forall a b. (a -> b) -> a -> b
$ String
"ExactP: Splice: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
con String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is given wrong number of srcInfoPoints"
instance ExactP Exp where
exactP :: Exp SrcSpanInfo -> EP ()
exactP Exp SrcSpanInfo
exp = case Exp SrcSpanInfo
exp of
Var SrcSpanInfo
_ QName SrcSpanInfo
qn -> QName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP QName SrcSpanInfo
qn
OverloadedLabel SrcSpanInfo
_ String
qn -> String -> EP ()
printString (Char
'#'Char -> ShowS
forall a. a -> [a] -> [a]
:String
qn)
IPVar SrcSpanInfo
_ IPName SrcSpanInfo
ipn -> IPName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP IPName SrcSpanInfo
ipn
Con SrcSpanInfo
_ QName SrcSpanInfo
qn -> QName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP QName SrcSpanInfo
qn
Lit SrcSpanInfo
_ Literal SrcSpanInfo
lit -> Literal SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Literal SrcSpanInfo
lit
InfixApp SrcSpanInfo
_ Exp SrcSpanInfo
e1 QOp SrcSpanInfo
op Exp SrcSpanInfo
e2 -> Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Exp SrcSpanInfo
e1 EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> QOp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC QOp SrcSpanInfo
op EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e2
App SrcSpanInfo
_ Exp SrcSpanInfo
e1 Exp SrcSpanInfo
e2 -> Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Exp SrcSpanInfo
e1 EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e2
NegApp SrcSpanInfo
_ Exp SrcSpanInfo
e -> String -> EP ()
printString String
"-" EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
Lambda SrcSpanInfo
l [Pat SrcSpanInfo]
ps Exp SrcSpanInfo
e ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
_,SrcSpan
b] -> do
String -> EP ()
printString String
"\\"
(Pat SrcSpanInfo -> EP ()) -> [Pat SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [Pat SrcSpanInfo]
ps
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"->"
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: Lambda is given wrong number of srcInfoPoints"
Let SrcSpanInfo
l Binds SrcSpanInfo
bs Exp SrcSpanInfo
e ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
_,SrcSpan
b] -> do
String -> EP ()
printString String
"let"
Binds SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Binds SrcSpanInfo
bs
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"in"
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: Let is given wrong number of srcInfoPoints"
If SrcSpanInfo
l Exp SrcSpanInfo
ec Exp SrcSpanInfo
et Exp SrcSpanInfo
ee ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
(SrcSpan
_:SrcSpan
b:SrcSpan
c:[SrcSpan]
rest) -> do
let (Maybe SrcSpan
mpSemi1,SrcSpan
pThen,[SrcSpan]
rest2) =
if Pos -> Int
forall a b. (a, b) -> b
snd (SrcSpan -> Pos
spanSize SrcSpan
b) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4
then (Maybe SrcSpan
forall a. Maybe a
Nothing, SrcSpan
b, SrcSpan
cSrcSpan -> [SrcSpan] -> [SrcSpan]
forall a. a -> [a] -> [a]
:[SrcSpan]
rest)
else (SrcSpan -> Maybe SrcSpan
forall a. a -> Maybe a
Just SrcSpan
b, SrcSpan
c, [SrcSpan]
rest)
case [SrcSpan]
rest2 of
(SrcSpan
c':[SrcSpan]
rest3) -> do
let (Maybe SrcSpan
mpSemi2,[SrcSpan]
rest4) = if Pos -> Int
forall a b. (a, b) -> b
snd (SrcSpan -> Pos
spanSize SrcSpan
c') Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4
then (Maybe SrcSpan
forall a. Maybe a
Nothing, [SrcSpan]
rest2)
else (SrcSpan -> Maybe SrcSpan
forall a. a -> Maybe a
Just SrcSpan
c', [SrcSpan]
rest3)
case [SrcSpan]
rest4 of
[SrcSpan
pElse] -> do
String -> EP ()
printString String
"if"
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
ec
(SrcSpan -> EP ()) -> Maybe SrcSpan -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP SrcSpan -> EP ()
printSemi Maybe SrcSpan
mpSemi1
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
pThen) String
"then"
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
et
(SrcSpan -> EP ()) -> Maybe SrcSpan -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP SrcSpan -> EP ()
printSemi Maybe SrcSpan
mpSemi2
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
pElse) String
"else"
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
ee
[] -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: If is given too few srcInfoPoints"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: If is given too many srcInfoPoints"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: If is given too few srcInfoPoints"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: If is given too few srcInfoPoints"
MultiIf SrcSpanInfo
l [GuardedRhs SrcSpanInfo]
alts ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
SrcSpan
_:[SrcSpan]
pts -> do
String -> EP ()
printString String
"if"
[SrcSpan] -> [GuardedAlt SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
layoutList [SrcSpan]
pts ((GuardedRhs SrcSpanInfo -> GuardedAlt SrcSpanInfo)
-> [GuardedRhs SrcSpanInfo] -> [GuardedAlt SrcSpanInfo]
forall a b. (a -> b) -> [a] -> [b]
map GuardedRhs SrcSpanInfo -> GuardedAlt SrcSpanInfo
forall l. GuardedRhs l -> GuardedAlt l
GuardedAlt [GuardedRhs SrcSpanInfo]
alts)
[SrcSpan]
_ -> String -> EP ()
forall a. String -> a
internalError String
"Exp -> MultiIf"
Case SrcSpanInfo
l Exp SrcSpanInfo
e [Alt SrcSpanInfo]
alts ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
SrcSpan
_:SrcSpan
b:[SrcSpan]
pts -> do
String -> EP ()
printString String
"case"
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"of"
[SrcSpan] -> [Alt SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
layoutList [SrcSpan]
pts [Alt SrcSpanInfo]
alts
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: Case is given too few srcInfoPoints"
Do SrcSpanInfo
l [Stmt SrcSpanInfo]
stmts ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
SrcSpan
_:[SrcSpan]
pts -> do
String -> EP ()
printString String
"do"
[SrcSpan] -> [Stmt SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
layoutList [SrcSpan]
pts [Stmt SrcSpanInfo]
stmts
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: Do is given too few srcInfoPoints"
MDo SrcSpanInfo
l [Stmt SrcSpanInfo]
stmts ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
SrcSpan
_:[SrcSpan]
pts -> do
String -> EP ()
printString String
"mdo"
[SrcSpan] -> [Stmt SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
layoutList [SrcSpan]
pts [Stmt SrcSpanInfo]
stmts
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: Mdo is given wrong number of srcInfoPoints"
Tuple SrcSpanInfo
l Boxed
bx [Exp SrcSpanInfo]
es ->
case Boxed
bx of
Boxed
Boxed -> [SrcSpan] -> [Exp SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
parenList (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) [Exp SrcSpanInfo]
es
Boxed
Unboxed -> [SrcSpan] -> [Exp SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
parenHashList (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) [Exp SrcSpanInfo]
es
UnboxedSum SrcSpanInfo
l Int
b Int
a Exp SrcSpanInfo
es -> do
SrcSpanInfo -> Int -> Int -> Exp SrcSpanInfo -> EP ()
forall (e :: * -> *).
ExactP e =>
SrcSpanInfo -> Int -> Int -> e SrcSpanInfo -> EP ()
unboxedSumEP SrcSpanInfo
l Int
b Int
a Exp SrcSpanInfo
es
TupleSection SrcSpanInfo
l Boxed
bx [Maybe (Exp SrcSpanInfo)]
mexps -> do
let pts :: [SrcSpan]
pts = SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l
(String
o, String
e) = case Boxed
bx of Boxed
Boxed -> (String
"(", String
")"); Boxed
Unboxed -> (String
"(#", String
"#)")
[(Pos, EP ())] -> EP ()
printSeq ([(Pos, EP ())] -> EP ()) -> [(Pos, EP ())] -> EP ()
forall a b. (a -> b) -> a -> b
$ [(Pos, EP ())] -> [(Pos, EP ())] -> [(Pos, EP ())]
forall a. [a] -> [a] -> [a]
interleave ([Pos] -> [EP ()] -> [(Pos, EP ())]
forall a b. [a] -> [b] -> [(a, b)]
zip ((SrcSpan -> Pos) -> [SrcSpan] -> [Pos]
forall a b. (a -> b) -> [a] -> [b]
map SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos ([SrcSpan] -> [Pos]) -> [SrcSpan] -> [Pos]
forall a b. (a -> b) -> a -> b
$ [SrcSpan] -> [SrcSpan]
forall a. [a] -> [a]
init [SrcSpan]
pts) ((String -> EP ()) -> [String] -> [EP ()]
forall a b. (a -> b) -> [a] -> [b]
map String -> EP ()
printString (String
oString -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
forall a. a -> [a]
repeat String
",")) [(Pos, EP ())] -> [(Pos, EP ())] -> [(Pos, EP ())]
forall a. [a] -> [a] -> [a]
++ [(SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos (SrcSpan -> Pos) -> SrcSpan -> Pos
forall a b. (a -> b) -> a -> b
$ [SrcSpan] -> SrcSpan
forall a. [a] -> a
last [SrcSpan]
pts, String -> EP ()
printString String
e)])
((Maybe (Exp SrcSpanInfo) -> (Pos, EP ()))
-> [Maybe (Exp SrcSpanInfo)] -> [(Pos, EP ())]
forall a b. (a -> b) -> [a] -> [b]
map (Pos -> (Exp SrcSpanInfo -> Pos) -> Maybe (Exp SrcSpanInfo) -> Pos
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int
0,Int
0) (SrcSpanInfo -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos (SrcSpanInfo -> Pos)
-> (Exp SrcSpanInfo -> SrcSpanInfo) -> Exp SrcSpanInfo -> Pos
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp SrcSpanInfo -> SrcSpanInfo
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann) (Maybe (Exp SrcSpanInfo) -> Pos)
-> (Maybe (Exp SrcSpanInfo) -> EP ())
-> Maybe (Exp SrcSpanInfo)
-> (Pos, EP ())
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (Exp SrcSpanInfo -> EP ()) -> Maybe (Exp SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC) [Maybe (Exp SrcSpanInfo)]
mexps)
List SrcSpanInfo
l [Exp SrcSpanInfo]
es -> [SrcSpan] -> [Exp SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
squareList (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) [Exp SrcSpanInfo]
es
ParArray SrcSpanInfo
l [Exp SrcSpanInfo]
es -> [SrcSpan] -> [Exp SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
squareColonList (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) [Exp SrcSpanInfo]
es
Paren SrcSpanInfo
l Exp SrcSpanInfo
p -> [SrcSpan] -> [Exp SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
parenList (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) [Exp SrcSpanInfo
p]
LeftSection SrcSpanInfo
l Exp SrcSpanInfo
e QOp SrcSpanInfo
qop ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
_,SrcSpan
b] -> do
String -> EP ()
printString String
"("
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
QOp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC QOp SrcSpanInfo
qop
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
")"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: LeftSection is given wrong number of srcInfoPoints"
RightSection SrcSpanInfo
l QOp SrcSpanInfo
qop Exp SrcSpanInfo
e ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
_,SrcSpan
b] -> do
String -> EP ()
printString String
"("
QOp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC QOp SrcSpanInfo
qop
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
")"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: RightSection is given wrong number of srcInfoPoints"
RecConstr SrcSpanInfo
l QName SrcSpanInfo
qn [FieldUpdate SrcSpanInfo]
fups -> do
let pts :: [SrcSpan]
pts = SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l
QName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP QName SrcSpanInfo
qn
[SrcSpan] -> [FieldUpdate SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
curlyList [SrcSpan]
pts [FieldUpdate SrcSpanInfo]
fups
RecUpdate SrcSpanInfo
l Exp SrcSpanInfo
e [FieldUpdate SrcSpanInfo]
fups -> do
let pts :: [SrcSpan]
pts = SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Exp SrcSpanInfo
e
[SrcSpan] -> [FieldUpdate SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
curlyList [SrcSpan]
pts [FieldUpdate SrcSpanInfo]
fups
EnumFrom SrcSpanInfo
l Exp SrcSpanInfo
e ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
_,SrcSpan
b,SrcSpan
c] -> do
String -> EP ()
printString String
"["
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
".."
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
c) String
"]"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: EnumFrom is given wrong number of srcInfoPoints"
EnumFromTo SrcSpanInfo
l Exp SrcSpanInfo
e1 Exp SrcSpanInfo
e2 ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
_,SrcSpan
b,SrcSpan
c] -> do
String -> EP ()
printString String
"["
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e1
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
".."
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e2
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
c) String
"]"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: EnumFromTo is given wrong number of srcInfoPoints"
EnumFromThen SrcSpanInfo
l Exp SrcSpanInfo
e1 Exp SrcSpanInfo
e2 ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
_,SrcSpan
b,SrcSpan
c,SrcSpan
d] -> do
String -> EP ()
printString String
"["
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e1
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
","
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e2
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
c) String
".."
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
d) String
"]"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: EnumFromThen is given wrong number of srcInfoPoints"
EnumFromThenTo SrcSpanInfo
l Exp SrcSpanInfo
e1 Exp SrcSpanInfo
e2 Exp SrcSpanInfo
e3 ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
_,SrcSpan
b,SrcSpan
c,SrcSpan
d] -> do
String -> EP ()
printString String
"["
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e1
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
","
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e2
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
c) String
".."
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e3
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
d) String
"]"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: EnumFromToThen is given wrong number of srcInfoPoints"
ParArrayFromTo SrcSpanInfo
l Exp SrcSpanInfo
e1 Exp SrcSpanInfo
e2 ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
_,SrcSpan
b,SrcSpan
c] -> do
String -> EP ()
printString String
"[:"
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e1
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
".."
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e2
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
c) String
":]"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: ParArrayFromTo is given wrong number of srcInfoPoints"
ParArrayFromThenTo SrcSpanInfo
l Exp SrcSpanInfo
e1 Exp SrcSpanInfo
e2 Exp SrcSpanInfo
e3 ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
_,SrcSpan
b,SrcSpan
c,SrcSpan
d] -> do
String -> EP ()
printString String
"[:"
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e1
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
","
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e2
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
c) String
".."
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e3
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
d) String
":]"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: ParArrayFromToThen is given wrong number of srcInfoPoints"
ListComp SrcSpanInfo
l Exp SrcSpanInfo
e [QualStmt SrcSpanInfo]
qss ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
SrcSpan
_:[SrcSpan]
pts -> do
String -> EP ()
printString String
"["
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
(String, String, String)
-> [SrcSpan] -> [QualStmt SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
(String, String, String) -> [SrcSpan] -> [ast SrcSpanInfo] -> EP ()
bracketList (String
"|",String
",",String
"]") [SrcSpan]
pts [QualStmt SrcSpanInfo]
qss
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: ListComp is given too few srcInfoPoints"
ParComp SrcSpanInfo
l Exp SrcSpanInfo
e [[QualStmt SrcSpanInfo]]
qsss ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
SrcSpan
_:[SrcSpan]
pts -> do
let ([String]
strs, [QualStmt SrcSpanInfo]
qss) = [(String, QualStmt SrcSpanInfo)]
-> ([String], [QualStmt SrcSpanInfo])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(String, QualStmt SrcSpanInfo)]
-> ([String], [QualStmt SrcSpanInfo]))
-> [(String, QualStmt SrcSpanInfo)]
-> ([String], [QualStmt SrcSpanInfo])
forall a b. (a -> b) -> a -> b
$ [[QualStmt SrcSpanInfo]] -> [(String, QualStmt SrcSpanInfo)]
forall b. [[b]] -> [(String, b)]
pairUp [[QualStmt SrcSpanInfo]]
qsss
String -> EP ()
printString String
"["
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
[(SrcSpan, String)] -> [QualStmt SrcSpanInfo] -> EP ()
forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved ([SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SrcSpan]
pts ([String]
strs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"]"])) [QualStmt SrcSpanInfo]
qss
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: ParComp is given wrong number of srcInfoPoints"
where pairUp :: [[b]] -> [(String, b)]
pairUp [] = []
pairUp ((b
a:[b]
as):[[b]]
xs) = (String
"|", b
a) (String, b) -> [(String, b)] -> [(String, b)]
forall a. a -> [a] -> [a]
: [String] -> [b] -> [(String, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip (String -> [String]
forall a. a -> [a]
repeat String
",") [b]
as [(String, b)] -> [(String, b)] -> [(String, b)]
forall a. [a] -> [a] -> [a]
++ [[b]] -> [(String, b)]
pairUp [[b]]
xs
pairUp [[b]]
_ = String -> [(String, b)]
forall a. String -> a
internalError String
"Exp -> ParComp -> pairUp"
ParArrayComp SrcSpanInfo
l Exp SrcSpanInfo
e [[QualStmt SrcSpanInfo]]
qsss ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
SrcSpan
_:[SrcSpan]
pts -> do
let ([String]
strs, [QualStmt SrcSpanInfo]
qss) = [(String, QualStmt SrcSpanInfo)]
-> ([String], [QualStmt SrcSpanInfo])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(String, QualStmt SrcSpanInfo)]
-> ([String], [QualStmt SrcSpanInfo]))
-> [(String, QualStmt SrcSpanInfo)]
-> ([String], [QualStmt SrcSpanInfo])
forall a b. (a -> b) -> a -> b
$ [[QualStmt SrcSpanInfo]] -> [(String, QualStmt SrcSpanInfo)]
forall b. [[b]] -> [(String, b)]
pairUp [[QualStmt SrcSpanInfo]]
qsss
String -> EP ()
printString String
"[:"
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
[(SrcSpan, String)] -> [QualStmt SrcSpanInfo] -> EP ()
forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved ([SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SrcSpan]
pts ([String]
strs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
":]"])) [QualStmt SrcSpanInfo]
qss
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: ParArrayComp is given wrong number of srcInfoPoints"
where pairUp :: [[b]] -> [(String, b)]
pairUp [] = []
pairUp ((b
a:[b]
as):[[b]]
xs) = (String
"|", b
a) (String, b) -> [(String, b)] -> [(String, b)]
forall a. a -> [a] -> [a]
: [String] -> [b] -> [(String, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip (String -> [String]
forall a. a -> [a]
repeat String
"|") [b]
as [(String, b)] -> [(String, b)] -> [(String, b)]
forall a. [a] -> [a] -> [a]
++ [[b]] -> [(String, b)]
pairUp [[b]]
xs
pairUp [[b]]
_ = String -> [(String, b)]
forall a. String -> a
internalError String
"Exp -> ParArrayComp -> pairUp"
ExpTypeSig SrcSpanInfo
l Exp SrcSpanInfo
e Type SrcSpanInfo
t ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
a] -> do
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Exp SrcSpanInfo
e
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"::"
Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: ExpTypeSig is given wrong number of srcInfoPoints"
VarQuote SrcSpanInfo
_ QName SrcSpanInfo
qn -> do
String -> EP ()
printString String
"'"
QName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC QName SrcSpanInfo
qn
TypQuote SrcSpanInfo
_ QName SrcSpanInfo
qn -> do
String -> EP ()
printString String
"''"
QName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC QName SrcSpanInfo
qn
BracketExp SrcSpanInfo
_ Bracket SrcSpanInfo
br -> Bracket SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Bracket SrcSpanInfo
br
SpliceExp SrcSpanInfo
_ Splice SrcSpanInfo
sp -> Splice SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Splice SrcSpanInfo
sp
QuasiQuote SrcSpanInfo
_ String
name String
qt -> do
let qtLines :: [String]
qtLines = String -> [String]
lines String
qt
String -> EP ()
printString (String -> EP ()) -> String -> EP ()
forall a b. (a -> b) -> a -> b
$ String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"|"
[EP ()] -> EP ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ (EP () -> [EP ()] -> [EP ()]
forall a. a -> [a] -> [a]
intersperse EP ()
newLine ([EP ()] -> [EP ()]) -> [EP ()] -> [EP ()]
forall a b. (a -> b) -> a -> b
$ (String -> EP ()) -> [String] -> [EP ()]
forall a b. (a -> b) -> [a] -> [b]
map String -> EP ()
printString [String]
qtLines)
String -> EP ()
printString String
"|]"
XTag SrcSpanInfo
l XName SrcSpanInfo
xn [XAttr SrcSpanInfo]
attrs Maybe (Exp SrcSpanInfo)
mat [Exp SrcSpanInfo]
es ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
_,SrcSpan
b,SrcSpan
c,SrcSpan
d,SrcSpan
e] -> do
String -> EP ()
printString String
"<"
XName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC XName SrcSpanInfo
xn
(XAttr SrcSpanInfo -> EP ()) -> [XAttr SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ XAttr SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [XAttr SrcSpanInfo]
attrs
(Exp SrcSpanInfo -> EP ()) -> Maybe (Exp SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (Exp SrcSpanInfo)
mat
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
">"
(Exp SrcSpanInfo -> EP ()) -> [Exp SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [Exp SrcSpanInfo]
es
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
c) String
"</"
Pos -> EP ()
printWhitespace (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
d)
XName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP XName SrcSpanInfo
xn
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
e) String
">"
[SrcSpan
_,SrcSpan
b,SrcSpan
semi,SrcSpan
c,SrcSpan
d,SrcSpan
e] -> do
String -> EP ()
printString String
"<"
XName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC XName SrcSpanInfo
xn
(XAttr SrcSpanInfo -> EP ()) -> [XAttr SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ XAttr SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [XAttr SrcSpanInfo]
attrs
(Exp SrcSpanInfo -> EP ()) -> Maybe (Exp SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (Exp SrcSpanInfo)
mat
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
">"
(Exp SrcSpanInfo -> EP ()) -> [Exp SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [Exp SrcSpanInfo]
es
SrcSpan -> EP ()
printSemi SrcSpan
semi
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
c) String
"</"
Pos -> EP ()
printWhitespace (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
d)
XName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP XName SrcSpanInfo
xn
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
e) String
">"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: XTag is given wrong number of srcInfoPoints"
XETag SrcSpanInfo
l XName SrcSpanInfo
xn [XAttr SrcSpanInfo]
attrs Maybe (Exp SrcSpanInfo)
mat ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
_,SrcSpan
b] -> do
String -> EP ()
printString String
"<"
XName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC XName SrcSpanInfo
xn
(XAttr SrcSpanInfo -> EP ()) -> [XAttr SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ XAttr SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [XAttr SrcSpanInfo]
attrs
(Exp SrcSpanInfo -> EP ()) -> Maybe (Exp SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (Exp SrcSpanInfo)
mat
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"/>"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: XETag is given wrong number of srcInfoPoints"
XPcdata SrcSpanInfo
_ String
str -> do
let strLines :: [String]
strLines = String -> [String]
lines String
str
[EP ()] -> EP ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ (EP () -> [EP ()] -> [EP ()]
forall a. a -> [a] -> [a]
intersperse EP ()
newLine ([EP ()] -> [EP ()]) -> [EP ()] -> [EP ()]
forall a b. (a -> b) -> a -> b
$ (String -> EP ()) -> [String] -> [EP ()]
forall a b. (a -> b) -> [a] -> [b]
map String -> EP ()
printString [String]
strLines)
XExpTag SrcSpanInfo
l Exp SrcSpanInfo
e ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
_,SrcSpan
b] -> do
String -> EP ()
printString String
"<%"
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"%>"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: XExpTag is given wrong number of srcInfoPoints"
XChildTag SrcSpanInfo
l [Exp SrcSpanInfo]
es ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
_,SrcSpan
b,SrcSpan
c] -> do
String -> EP ()
printString String
"<%>"
(Exp SrcSpanInfo -> EP ()) -> [Exp SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [Exp SrcSpanInfo]
es
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"</"
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
c) String
"%>"
[SrcSpan
_,SrcSpan
semi,SrcSpan
b,SrcSpan
c] -> do
String -> EP ()
printString String
"<%>"
(Exp SrcSpanInfo -> EP ()) -> [Exp SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [Exp SrcSpanInfo]
es
SrcSpan -> EP ()
printSemi SrcSpan
semi
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"</"
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
c) String
"%>"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: XChildTag is given wrong number of srcInfoPoints"
CorePragma SrcSpanInfo
l String
str Exp SrcSpanInfo
e ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
_,SrcSpan
b] -> do
String -> EP ()
printString (String -> EP ()) -> String -> EP ()
forall a b. (a -> b) -> a -> b
$ String
"{-# CORE " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
str
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"#-}"
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: CorePragma is given wrong number of srcInfoPoints"
SCCPragma SrcSpanInfo
l String
str Exp SrcSpanInfo
e ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
_,SrcSpan
b] -> do
String -> EP ()
printString (String -> EP ()) -> String -> EP ()
forall a b. (a -> b) -> a -> b
$ String
"{-# SCC " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
str
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"#-}"
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: SCCPragma is given wrong number of srcInfoPoints"
GenPragma SrcSpanInfo
l String
str (Int
i1,Int
i2) (Int
i3,Int
i4) Exp SrcSpanInfo
e -> do
[(SrcSpan, String)] -> EP ()
forall loc. SrcInfo loc => [(loc, String)] -> EP ()
printStrs ([(SrcSpan, String)] -> EP ()) -> [(SrcSpan, String)] -> EP ()
forall a b. (a -> b) -> a -> b
$ [SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) [String
"{-# GENERATED", ShowS
forall a. Show a => a -> String
show String
str, Int -> String
forall a. Show a => a -> String
show Int
i1, String
":", Int -> String
forall a. Show a => a -> String
show Int
i2, String
"-", Int -> String
forall a. Show a => a -> String
show Int
i3, String
":", Int -> String
forall a. Show a => a -> String
show Int
i4, String
"#-}"]
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
Proc SrcSpanInfo
l Pat SrcSpanInfo
p Exp SrcSpanInfo
e ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
_,SrcSpan
b] -> do
String -> EP ()
printString String
"proc"
Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Pat SrcSpanInfo
p
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"->"
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: Proc is given wrong number of srcInfoPoints"
LeftArrApp SrcSpanInfo
l Exp SrcSpanInfo
e1 Exp SrcSpanInfo
e2 ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
a] -> do
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Exp SrcSpanInfo
e1
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"-<"
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e2
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: LeftArrApp is given wrong number of srcInfoPoints"
RightArrApp SrcSpanInfo
l Exp SrcSpanInfo
e1 Exp SrcSpanInfo
e2 ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
a] -> do
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Exp SrcSpanInfo
e1
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
">-"
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e2
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: RightArrApp is given wrong number of srcInfoPoints"
LeftArrHighApp SrcSpanInfo
l Exp SrcSpanInfo
e1 Exp SrcSpanInfo
e2 ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
a] -> do
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Exp SrcSpanInfo
e1
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"-<<"
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e2
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: LeftArrHighApp is given wrong number of srcInfoPoints"
RightArrHighApp SrcSpanInfo
l Exp SrcSpanInfo
e1 Exp SrcSpanInfo
e2 ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
a] -> do
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Exp SrcSpanInfo
e1
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
">>-"
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e2
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: RightArrHighApp is given wrong number of srcInfoPoints"
ArrOp SrcSpanInfo
l Exp SrcSpanInfo
e -> case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
a, SrcSpan
b] -> do
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"(|"
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"|)"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: ArrOp is given wrong number of srcInfoPoints"
LCase SrcSpanInfo
l [Alt SrcSpanInfo]
alts ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
SrcSpan
_:SrcSpan
b:[SrcSpan]
pts -> do
String -> EP ()
printString String
"\\"
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"case"
[SrcSpan] -> [Alt SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
layoutList [SrcSpan]
pts [Alt SrcSpanInfo]
alts
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: LCase is given wrong number of srcInfoPoints"
TypeApp SrcSpanInfo
_ Type SrcSpanInfo
ty -> String -> EP ()
printString String
"@" EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Type SrcSpanInfo
ty
unboxedSumEP :: ExactP e => SrcSpanInfo -> Int -> Int -> e SrcSpanInfo -> EP ()
unboxedSumEP :: SrcSpanInfo -> Int -> Int -> e SrcSpanInfo -> EP ()
unboxedSumEP SrcSpanInfo
l Int
b Int
_a e SrcSpanInfo
es = do
let (SrcSpan
opt:[SrcSpan]
pts) = SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l
(String
o, String
e) = (String
"(#", String
"#)")
bars :: [(Pos, EP ())]
bars = [Pos] -> [EP ()] -> [(Pos, EP ())]
forall a b. [a] -> [b] -> [(a, b)]
zip ((SrcSpan -> Pos) -> [SrcSpan] -> [Pos]
forall a b. (a -> b) -> [a] -> [b]
map SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos ([SrcSpan] -> [SrcSpan]
forall a. [a] -> [a]
init [SrcSpan]
pts)) ((String -> EP ()) -> [String] -> [EP ()]
forall a b. (a -> b) -> [a] -> [b]
map String -> EP ()
printString (String -> [String]
forall a. a -> [a]
repeat String
"|"))
open :: (Pos, EP ())
open = (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
opt, String -> EP ()
printString String
o)
close :: (Pos, EP ())
close = (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos ([SrcSpan] -> SrcSpan
forall a. [a] -> a
last [SrcSpan]
pts), String -> EP ()
printString String
e)
fs :: [(Pos, EP ())]
fs = Int -> [(Pos, EP ())] -> [(Pos, EP ())]
forall a. Int -> [a] -> [a]
take Int
b [(Pos, EP ())]
bars
as :: [(Pos, EP ())]
as = Int -> [(Pos, EP ())] -> [(Pos, EP ())]
forall a. Int -> [a] -> [a]
drop Int
b [(Pos, EP ())]
bars
[(Pos, EP ())] -> EP ()
printSeq ([(Pos, EP ())] -> EP ()) -> [(Pos, EP ())] -> EP ()
forall a b. (a -> b) -> a -> b
$ (Pos, EP ())
open (Pos, EP ()) -> [(Pos, EP ())] -> [(Pos, EP ())]
forall a. a -> [a] -> [a]
: [(Pos, EP ())]
fs [(Pos, EP ())] -> [(Pos, EP ())] -> [(Pos, EP ())]
forall a. [a] -> [a] -> [a]
++ [((Int
0, Int
0), e SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC e SrcSpanInfo
es)] [(Pos, EP ())] -> [(Pos, EP ())] -> [(Pos, EP ())]
forall a. [a] -> [a] -> [a]
++ [(Pos, EP ())]
as [(Pos, EP ())] -> [(Pos, EP ())] -> [(Pos, EP ())]
forall a. [a] -> [a] -> [a]
++ [(Pos, EP ())
close]
instance ExactP FieldUpdate where
exactP :: FieldUpdate SrcSpanInfo -> EP ()
exactP FieldUpdate SrcSpanInfo
fup = case FieldUpdate SrcSpanInfo
fup of
FieldUpdate SrcSpanInfo
l QName SrcSpanInfo
qn Exp SrcSpanInfo
e ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
a] -> do
QName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP QName SrcSpanInfo
qn
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"="
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: FieldUpdate is given wrong number of srcInfoPoints"
FieldPun SrcSpanInfo
_ QName SrcSpanInfo
n -> QName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP QName SrcSpanInfo
n
FieldWildcard SrcSpanInfo
_ -> String -> EP ()
printString String
".."
instance ExactP Stmt where
exactP :: Stmt SrcSpanInfo -> EP ()
exactP Stmt SrcSpanInfo
stmt = case Stmt SrcSpanInfo
stmt of
Generator SrcSpanInfo
l Pat SrcSpanInfo
p Exp SrcSpanInfo
e ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
a] -> do
Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Pat SrcSpanInfo
p
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"<-"
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Stmt: Generator is given wrong number of srcInfoPoints"
Qualifier SrcSpanInfo
_ Exp SrcSpanInfo
e -> Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Exp SrcSpanInfo
e
LetStmt SrcSpanInfo
_ Binds SrcSpanInfo
bds -> do
String -> EP ()
printString String
"let"
Binds SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Binds SrcSpanInfo
bds
RecStmt SrcSpanInfo
l [Stmt SrcSpanInfo]
ss ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
SrcSpan
_:[SrcSpan]
pts -> do
String -> EP ()
printString String
"rec"
[SrcSpan] -> [Stmt SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
layoutList [SrcSpan]
pts [Stmt SrcSpanInfo]
ss
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Stmt: RecStmt is given too few srcInfoPoints"
instance ExactP QualStmt where
exactP :: QualStmt SrcSpanInfo -> EP ()
exactP QualStmt SrcSpanInfo
qstmt = case QualStmt SrcSpanInfo
qstmt of
QualStmt SrcSpanInfo
_ Stmt SrcSpanInfo
stmt -> Stmt SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Stmt SrcSpanInfo
stmt
ThenTrans SrcSpanInfo
_ Exp SrcSpanInfo
e -> String -> EP ()
printString String
"then" EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
ThenBy SrcSpanInfo
l Exp SrcSpanInfo
e1 Exp SrcSpanInfo
e2 ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
_,SrcSpan
b] -> do
String -> EP ()
printString String
"then"
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e1
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"by"
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e2
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: QualStmt: ThenBy is given wrong number of srcInfoPoints"
GroupBy SrcSpanInfo
l Exp SrcSpanInfo
e -> do
[(SrcSpan, String)] -> EP ()
forall loc. SrcInfo loc => [(loc, String)] -> EP ()
printStrs ([(SrcSpan, String)] -> EP ()) -> [(SrcSpan, String)] -> EP ()
forall a b. (a -> b) -> a -> b
$ [SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) [String
"then",String
"group",String
"by"]
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
GroupUsing SrcSpanInfo
l Exp SrcSpanInfo
e -> do
[(SrcSpan, String)] -> EP ()
forall loc. SrcInfo loc => [(loc, String)] -> EP ()
printStrs ([(SrcSpan, String)] -> EP ()) -> [(SrcSpan, String)] -> EP ()
forall a b. (a -> b) -> a -> b
$ [SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) [String
"then",String
"group",String
"using"]
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
GroupByUsing SrcSpanInfo
l Exp SrcSpanInfo
e1 Exp SrcSpanInfo
e2 -> do
let pts :: [SrcSpan]
pts = SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l
[(SrcSpan, String)] -> EP ()
forall loc. SrcInfo loc => [(loc, String)] -> EP ()
printStrs ([(SrcSpan, String)] -> EP ()) -> [(SrcSpan, String)] -> EP ()
forall a b. (a -> b) -> a -> b
$ [SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([SrcSpan] -> [SrcSpan]
forall a. [a] -> [a]
init [SrcSpan]
pts) [String
"then",String
"group",String
"by"]
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e1
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos ([SrcSpan] -> SrcSpan
forall a. [a] -> a
last [SrcSpan]
pts)) String
"using"
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e2
instance ExactP Bracket where
exactP :: Bracket SrcSpanInfo -> EP ()
exactP Bracket SrcSpanInfo
br = case Bracket SrcSpanInfo
br of
ExpBracket SrcSpanInfo
l Exp SrcSpanInfo
e -> String
-> String -> String -> SrcSpanInfo -> Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *).
ExactP ast =>
String
-> String -> String -> SrcSpanInfo -> ast SrcSpanInfo -> EP ()
printBracket String
"ExpBracket" String
"[|" String
"|]" SrcSpanInfo
l Exp SrcSpanInfo
e
TExpBracket SrcSpanInfo
l Exp SrcSpanInfo
e -> String
-> String -> String -> SrcSpanInfo -> Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *).
ExactP ast =>
String
-> String -> String -> SrcSpanInfo -> ast SrcSpanInfo -> EP ()
printBracket String
"TExpBracket" String
"[||" String
"||]" SrcSpanInfo
l Exp SrcSpanInfo
e
PatBracket SrcSpanInfo
l Pat SrcSpanInfo
p -> String
-> String -> String -> SrcSpanInfo -> Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *).
ExactP ast =>
String
-> String -> String -> SrcSpanInfo -> ast SrcSpanInfo -> EP ()
printBracket String
"PatBracket" String
"[p|" String
"|]" SrcSpanInfo
l Pat SrcSpanInfo
p
TypeBracket SrcSpanInfo
l Type SrcSpanInfo
t -> String
-> String -> String -> SrcSpanInfo -> Type SrcSpanInfo -> EP ()
forall (ast :: * -> *).
ExactP ast =>
String
-> String -> String -> SrcSpanInfo -> ast SrcSpanInfo -> EP ()
printBracket String
"TypeBracket" String
"[t|" String
"|]" SrcSpanInfo
l Type SrcSpanInfo
t
DeclBracket SrcSpanInfo
l [Decl SrcSpanInfo]
ds ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
pts :: [SrcSpan]
pts@(SrcSpan
_:[SrcSpan]
_) -> do
String -> EP ()
printString String
"[d|"
[SrcSpan] -> [Decl SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
layoutList ([SrcSpan] -> [SrcSpan]
forall a. [a] -> [a]
init [SrcSpan]
pts) ([Decl SrcSpanInfo] -> [Decl SrcSpanInfo]
sepFunBinds [Decl SrcSpanInfo]
ds)
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos ([SrcSpan] -> SrcSpan
forall a. [a] -> a
last [SrcSpan]
pts)) String
"|]"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Bracket: DeclBracket is given too few srcInfoPoints"
printBracket :: ExactP ast => String -> String -> String -> SrcSpanInfo -> ast SrcSpanInfo -> EP ()
printBracket :: String
-> String -> String -> SrcSpanInfo -> ast SrcSpanInfo -> EP ()
printBracket String
con String
oBracket String
cBracket SrcSpanInfo
l ast SrcSpanInfo
c =
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
_,SrcSpan
b] -> do
String -> EP ()
printString String
oBracket
ast SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC ast SrcSpanInfo
c
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
cBracket
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP (String -> EP ()) -> String -> EP ()
forall a b. (a -> b) -> a -> b
$ String
"ExactP: Bracket: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
con String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is given wrong number of srcInfoPoints"
instance ExactP XAttr where
exactP :: XAttr SrcSpanInfo -> EP ()
exactP (XAttr SrcSpanInfo
l XName SrcSpanInfo
xn Exp SrcSpanInfo
e) =
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
a] -> do
XName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP XName SrcSpanInfo
xn
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"="
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: XAttr is given wrong number of srcInfoPoints"
instance ExactP Alt where
exactP :: Alt SrcSpanInfo -> EP ()
exactP (Alt SrcSpanInfo
l Pat SrcSpanInfo
p Rhs SrcSpanInfo
galts Maybe (Binds SrcSpanInfo)
mbs) = do
Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Pat SrcSpanInfo
p
GuardedAlts SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC (Rhs SrcSpanInfo -> GuardedAlts SrcSpanInfo
forall l. Rhs l -> GuardedAlts l
GuardedAlts Rhs SrcSpanInfo
galts)
(Binds SrcSpanInfo -> EP ()) -> Maybe (Binds SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP (\Binds SrcSpanInfo
bs -> Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos ([SrcSpan] -> SrcSpan
forall a. [a] -> a
head (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l))) String
"where" EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Binds SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Binds SrcSpanInfo
bs) Maybe (Binds SrcSpanInfo)
mbs
instance ExactP Match where
exactP :: Match SrcSpanInfo -> EP ()
exactP (Match SrcSpanInfo
l Name SrcSpanInfo
n [Pat SrcSpanInfo]
ps Rhs SrcSpanInfo
rhs Maybe (Binds SrcSpanInfo)
mbinds) = do
let pts :: [SrcSpan]
pts = SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l
len :: Int
len = [SrcSpan] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SrcSpan]
pts
pars :: Int
pars = Int
len Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
([SrcSpan]
oPars,[SrcSpan]
cParsWh) = Int -> [SrcSpan] -> ([SrcSpan], [SrcSpan])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
pars [SrcSpan]
pts
([SrcSpan]
cPars,[SrcSpan]
_) = Int -> [SrcSpan] -> ([SrcSpan], [SrcSpan])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
pars [SrcSpan]
cParsWh
[(SrcSpan, String)] -> EP ()
forall loc. SrcInfo loc => [(loc, String)] -> EP ()
printStrs ([SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SrcSpan]
oPars (String -> [String]
forall a. a -> [a]
repeat String
"("))
Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Name SrcSpanInfo
n
[(Pos, EP ())] -> [(Pos, EP ())] -> EP ()
printStreams ([Pos] -> [EP ()] -> [(Pos, EP ())]
forall a b. [a] -> [b] -> [(a, b)]
zip ((SrcSpan -> Pos) -> [SrcSpan] -> [Pos]
forall a b. (a -> b) -> [a] -> [b]
map SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos [SrcSpan]
cPars) (EP () -> [EP ()]
forall a. a -> [a]
repeat (EP () -> [EP ()]) -> EP () -> [EP ()]
forall a b. (a -> b) -> a -> b
$ String -> EP ()
printString String
")")) ((Pat SrcSpanInfo -> (Pos, EP ()))
-> [Pat SrcSpanInfo] -> [(Pos, EP ())]
forall a b. (a -> b) -> [a] -> [b]
map (SrcSpanInfo -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos (SrcSpanInfo -> Pos)
-> (Pat SrcSpanInfo -> SrcSpanInfo) -> Pat SrcSpanInfo -> Pos
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pat SrcSpanInfo -> SrcSpanInfo
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann (Pat SrcSpanInfo -> Pos)
-> (Pat SrcSpanInfo -> EP ()) -> Pat SrcSpanInfo -> (Pos, EP ())
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC) [Pat SrcSpanInfo]
ps)
Rhs SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Rhs SrcSpanInfo
rhs
(Binds SrcSpanInfo -> EP ()) -> Maybe (Binds SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP (\Binds SrcSpanInfo
bds -> Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos ([SrcSpan] -> SrcSpan
forall a. [a] -> a
head [SrcSpan]
pts)) String
"where" EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Binds SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Binds SrcSpanInfo
bds) Maybe (Binds SrcSpanInfo)
mbinds
exactP (InfixMatch SrcSpanInfo
l Pat SrcSpanInfo
a Name SrcSpanInfo
n [Pat SrcSpanInfo]
bs Rhs SrcSpanInfo
rhs Maybe (Binds SrcSpanInfo)
mbinds) = do
let pts :: [SrcSpan]
pts = SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l
len :: Int
len = [SrcSpan] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SrcSpan]
pts
pars :: Int
pars = Int
len Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
([SrcSpan]
oPars,[SrcSpan]
cParsWh) = Int -> [SrcSpan] -> ([SrcSpan], [SrcSpan])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
pars [SrcSpan]
pts
([SrcSpan]
cPars,[SrcSpan]
whPt) = Int -> [SrcSpan] -> ([SrcSpan], [SrcSpan])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
pars [SrcSpan]
cParsWh
[(SrcSpan, String)] -> EP ()
forall loc. SrcInfo loc => [(loc, String)] -> EP ()
printStrs ([SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SrcSpan]
oPars (String -> [String]
forall a. a -> [a]
repeat String
"("))
Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Pat SrcSpanInfo
a
Name SrcSpanInfo -> EP ()
epInfixName Name SrcSpanInfo
n
[(SrcSpan, String)] -> [Pat SrcSpanInfo] -> EP ()
forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved' ([SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SrcSpan]
cPars (String -> [String]
forall a. a -> [a]
repeat String
")")) [Pat SrcSpanInfo]
bs
Rhs SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Rhs SrcSpanInfo
rhs
(Binds SrcSpanInfo -> EP ()) -> Maybe (Binds SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP (\Binds SrcSpanInfo
bds -> Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos ([SrcSpan] -> SrcSpan
forall a. [a] -> a
head [SrcSpan]
whPt)) String
"where" EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Binds SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Binds SrcSpanInfo
bds) Maybe (Binds SrcSpanInfo)
mbinds
instance ExactP Rhs where
exactP :: Rhs SrcSpanInfo -> EP ()
exactP (UnGuardedRhs SrcSpanInfo
_ Exp SrcSpanInfo
e) = String -> EP ()
printString String
"=" EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
exactP (GuardedRhss SrcSpanInfo
_ [GuardedRhs SrcSpanInfo]
grhss) = (GuardedRhs SrcSpanInfo -> EP ())
-> [GuardedRhs SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ GuardedRhs SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [GuardedRhs SrcSpanInfo]
grhss
instance ExactP GuardedRhs where
exactP :: GuardedRhs SrcSpanInfo -> EP ()
exactP (GuardedRhs SrcSpanInfo
l [Stmt SrcSpanInfo]
ss Exp SrcSpanInfo
e) =
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
SrcSpan
_:[SrcSpan]
pts -> do
String -> EP ()
printString String
"|"
[(SrcSpan, String)] -> [Stmt SrcSpanInfo] -> EP ()
forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved' ([SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([SrcSpan] -> [SrcSpan]
forall a. [a] -> [a]
init [SrcSpan]
pts) (String -> [String]
forall a. a -> [a]
repeat String
",") [(SrcSpan, String)] -> [(SrcSpan, String)] -> [(SrcSpan, String)]
forall a. [a] -> [a] -> [a]
++ [([SrcSpan] -> SrcSpan
forall a. [a] -> a
last [SrcSpan]
pts, String
"=")]) [Stmt SrcSpanInfo]
ss
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: GuardedRhs is given wrong number of srcInfoPoints"
newtype GuardedAlts l = GuardedAlts (Rhs l)
deriving (a -> GuardedAlts b -> GuardedAlts a
(a -> b) -> GuardedAlts a -> GuardedAlts b
(forall a b. (a -> b) -> GuardedAlts a -> GuardedAlts b)
-> (forall a b. a -> GuardedAlts b -> GuardedAlts a)
-> Functor GuardedAlts
forall a b. a -> GuardedAlts b -> GuardedAlts a
forall a b. (a -> b) -> GuardedAlts a -> GuardedAlts b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> GuardedAlts b -> GuardedAlts a
$c<$ :: forall a b. a -> GuardedAlts b -> GuardedAlts a
fmap :: (a -> b) -> GuardedAlts a -> GuardedAlts b
$cfmap :: forall a b. (a -> b) -> GuardedAlts a -> GuardedAlts b
Functor, Int -> GuardedAlts l -> ShowS
[GuardedAlts l] -> ShowS
GuardedAlts l -> String
(Int -> GuardedAlts l -> ShowS)
-> (GuardedAlts l -> String)
-> ([GuardedAlts l] -> ShowS)
-> Show (GuardedAlts l)
forall l. Show l => Int -> GuardedAlts l -> ShowS
forall l. Show l => [GuardedAlts l] -> ShowS
forall l. Show l => GuardedAlts l -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GuardedAlts l] -> ShowS
$cshowList :: forall l. Show l => [GuardedAlts l] -> ShowS
show :: GuardedAlts l -> String
$cshow :: forall l. Show l => GuardedAlts l -> String
showsPrec :: Int -> GuardedAlts l -> ShowS
$cshowsPrec :: forall l. Show l => Int -> GuardedAlts l -> ShowS
Show)
instance Annotated GuardedAlts where
amap :: (l -> l) -> GuardedAlts l -> GuardedAlts l
amap l -> l
f (GuardedAlts Rhs l
v) = Rhs l -> GuardedAlts l
forall l. Rhs l -> GuardedAlts l
GuardedAlts ((l -> l) -> Rhs l -> Rhs l
forall (ast :: * -> *) l.
Annotated ast =>
(l -> l) -> ast l -> ast l
amap l -> l
f Rhs l
v)
ann :: GuardedAlts l -> l
ann (GuardedAlts Rhs l
v) = Rhs l -> l
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann Rhs l
v
newtype GuardedAlt l = GuardedAlt (GuardedRhs l)
deriving (a -> GuardedAlt b -> GuardedAlt a
(a -> b) -> GuardedAlt a -> GuardedAlt b
(forall a b. (a -> b) -> GuardedAlt a -> GuardedAlt b)
-> (forall a b. a -> GuardedAlt b -> GuardedAlt a)
-> Functor GuardedAlt
forall a b. a -> GuardedAlt b -> GuardedAlt a
forall a b. (a -> b) -> GuardedAlt a -> GuardedAlt b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> GuardedAlt b -> GuardedAlt a
$c<$ :: forall a b. a -> GuardedAlt b -> GuardedAlt a
fmap :: (a -> b) -> GuardedAlt a -> GuardedAlt b
$cfmap :: forall a b. (a -> b) -> GuardedAlt a -> GuardedAlt b
Functor, Int -> GuardedAlt l -> ShowS
[GuardedAlt l] -> ShowS
GuardedAlt l -> String
(Int -> GuardedAlt l -> ShowS)
-> (GuardedAlt l -> String)
-> ([GuardedAlt l] -> ShowS)
-> Show (GuardedAlt l)
forall l. Show l => Int -> GuardedAlt l -> ShowS
forall l. Show l => [GuardedAlt l] -> ShowS
forall l. Show l => GuardedAlt l -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GuardedAlt l] -> ShowS
$cshowList :: forall l. Show l => [GuardedAlt l] -> ShowS
show :: GuardedAlt l -> String
$cshow :: forall l. Show l => GuardedAlt l -> String
showsPrec :: Int -> GuardedAlt l -> ShowS
$cshowsPrec :: forall l. Show l => Int -> GuardedAlt l -> ShowS
Show)
instance Annotated GuardedAlt where
amap :: (l -> l) -> GuardedAlt l -> GuardedAlt l
amap l -> l
f (GuardedAlt GuardedRhs l
v) = GuardedRhs l -> GuardedAlt l
forall l. GuardedRhs l -> GuardedAlt l
GuardedAlt ((l -> l) -> GuardedRhs l -> GuardedRhs l
forall (ast :: * -> *) l.
Annotated ast =>
(l -> l) -> ast l -> ast l
amap l -> l
f GuardedRhs l
v)
ann :: GuardedAlt l -> l
ann (GuardedAlt GuardedRhs l
v) = GuardedRhs l -> l
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann GuardedRhs l
v
instance ExactP GuardedAlts where
exactP :: GuardedAlts SrcSpanInfo -> EP ()
exactP (GuardedAlts (UnGuardedRhs SrcSpanInfo
_ Exp SrcSpanInfo
e)) = String -> EP ()
printString String
"->" EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
exactP (GuardedAlts (GuardedRhss SrcSpanInfo
_ [GuardedRhs SrcSpanInfo]
grhss)) = (GuardedRhs SrcSpanInfo -> EP ())
-> [GuardedRhs SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (GuardedAlt SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC (GuardedAlt SrcSpanInfo -> EP ())
-> (GuardedRhs SrcSpanInfo -> GuardedAlt SrcSpanInfo)
-> GuardedRhs SrcSpanInfo
-> EP ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GuardedRhs SrcSpanInfo -> GuardedAlt SrcSpanInfo
forall l. GuardedRhs l -> GuardedAlt l
GuardedAlt) [GuardedRhs SrcSpanInfo]
grhss
instance ExactP GuardedAlt where
exactP :: GuardedAlt SrcSpanInfo -> EP ()
exactP (GuardedAlt (GuardedRhs SrcSpanInfo
l [Stmt SrcSpanInfo]
ss Exp SrcSpanInfo
e)) =
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
SrcSpan
_:[SrcSpan]
pts -> do
String -> EP ()
printString String
"|"
[(SrcSpan, String)] -> [Stmt SrcSpanInfo] -> EP ()
forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved' ([SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([SrcSpan] -> [SrcSpan]
forall a. [a] -> [a]
init [SrcSpan]
pts) (String -> [String]
forall a. a -> [a]
repeat String
",") [(SrcSpan, String)] -> [(SrcSpan, String)] -> [(SrcSpan, String)]
forall a. [a] -> [a] -> [a]
++ [([SrcSpan] -> SrcSpan
forall a. [a] -> a
last [SrcSpan]
pts, String
"->")]) [Stmt SrcSpanInfo]
ss
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: GuardedAlt is given wrong number of srcInfoPoints"
instance ExactP Pat where
exactP :: Pat SrcSpanInfo -> EP ()
exactP Pat SrcSpanInfo
pat = case Pat SrcSpanInfo
pat of
PVar SrcSpanInfo
l Name SrcSpanInfo
n -> Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC ((SrcSpanInfo -> SrcSpanInfo)
-> Name SrcSpanInfo -> Name SrcSpanInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SrcSpanInfo -> SrcSpanInfo -> SrcSpanInfo
forall a b. a -> b -> a
const SrcSpanInfo
l) Name SrcSpanInfo
n)
PLit SrcSpanInfo
_ Sign SrcSpanInfo
sg Literal SrcSpanInfo
lit -> Sign SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Sign SrcSpanInfo
sg EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Literal SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Literal SrcSpanInfo
lit
PNPlusK SrcSpanInfo
l Name SrcSpanInfo
n Integer
k ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
a,SrcSpan
b] -> do
Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Name SrcSpanInfo
n
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"+"
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) (Integer -> String
forall a. Show a => a -> String
show Integer
k)
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Pat: PNPlusK is given wrong number of srcInfoPoints"
PInfixApp SrcSpanInfo
_ Pat SrcSpanInfo
pa QName SrcSpanInfo
qn Pat SrcSpanInfo
pb -> Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Pat SrcSpanInfo
pa EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> QName SrcSpanInfo -> EP ()
epInfixQName QName SrcSpanInfo
qn EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Pat SrcSpanInfo
pb
PApp SrcSpanInfo
_ QName SrcSpanInfo
qn [Pat SrcSpanInfo]
ps -> QName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP QName SrcSpanInfo
qn EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Pat SrcSpanInfo -> EP ()) -> [Pat SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [Pat SrcSpanInfo]
ps
PTuple SrcSpanInfo
l Boxed
bx [Pat SrcSpanInfo]
ps ->
case Boxed
bx of
Boxed
Boxed -> [SrcSpan] -> [Pat SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
parenList (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) [Pat SrcSpanInfo]
ps
Boxed
Unboxed -> [SrcSpan] -> [Pat SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
parenHashList (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) [Pat SrcSpanInfo]
ps
PUnboxedSum SrcSpanInfo
l Int
before Int
after Pat SrcSpanInfo
e ->
SrcSpanInfo -> Int -> Int -> Pat SrcSpanInfo -> EP ()
forall (e :: * -> *).
ExactP e =>
SrcSpanInfo -> Int -> Int -> e SrcSpanInfo -> EP ()
unboxedSumEP SrcSpanInfo
l Int
before Int
after Pat SrcSpanInfo
e
PList SrcSpanInfo
l [Pat SrcSpanInfo]
ps -> [SrcSpan] -> [Pat SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
squareList (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) [Pat SrcSpanInfo]
ps
PParen SrcSpanInfo
l Pat SrcSpanInfo
p -> [SrcSpan] -> [Pat SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
parenList (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) [Pat SrcSpanInfo
p]
PRec SrcSpanInfo
l QName SrcSpanInfo
qn [PatField SrcSpanInfo]
pfs -> QName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP QName SrcSpanInfo
qn EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [SrcSpan] -> [PatField SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
curlyList (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) [PatField SrcSpanInfo]
pfs
PAsPat SrcSpanInfo
l Name SrcSpanInfo
n Pat SrcSpanInfo
p ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
a] -> do
Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Name SrcSpanInfo
n
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"@"
Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Pat SrcSpanInfo
p
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Pat: PAsPat is given wrong number of srcInfoPoints"
PWildCard SrcSpanInfo
_ -> String -> EP ()
printString String
"_"
PIrrPat SrcSpanInfo
_ Pat SrcSpanInfo
p -> String -> EP ()
printString String
"~" EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Pat SrcSpanInfo
p
PatTypeSig SrcSpanInfo
l Pat SrcSpanInfo
p Type SrcSpanInfo
t ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
a] -> do
Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Pat SrcSpanInfo
p
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"::"
Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Pat: PatTypeSig is given wrong number of srcInfoPoints"
PViewPat SrcSpanInfo
l Exp SrcSpanInfo
e Pat SrcSpanInfo
p ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
a] -> do
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Exp SrcSpanInfo
e
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"->"
Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Pat SrcSpanInfo
p
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Pat: PViewPat is given wrong number of srcInfoPoints"
PRPat SrcSpanInfo
l [RPat SrcSpanInfo]
rps -> [SrcSpan] -> [RPat SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
squareList (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) [RPat SrcSpanInfo]
rps
PXTag SrcSpanInfo
l XName SrcSpanInfo
xn [PXAttr SrcSpanInfo]
attrs Maybe (Pat SrcSpanInfo)
mat [Pat SrcSpanInfo]
ps ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
_,SrcSpan
b,SrcSpan
c,SrcSpan
d,SrcSpan
e] -> do
String -> EP ()
printString String
"<"
XName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC XName SrcSpanInfo
xn
(PXAttr SrcSpanInfo -> EP ()) -> [PXAttr SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ PXAttr SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [PXAttr SrcSpanInfo]
attrs
(Pat SrcSpanInfo -> EP ()) -> Maybe (Pat SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (Pat SrcSpanInfo)
mat
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
">"
(Pat SrcSpanInfo -> EP ()) -> [Pat SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [Pat SrcSpanInfo]
ps
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
c) String
"</"
Pos -> EP ()
printWhitespace (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
d)
XName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP XName SrcSpanInfo
xn
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
e) String
">"
[SrcSpan
_,SrcSpan
b,SrcSpan
semi,SrcSpan
c,SrcSpan
d,SrcSpan
e] -> do
String -> EP ()
printString String
"<"
XName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC XName SrcSpanInfo
xn
(PXAttr SrcSpanInfo -> EP ()) -> [PXAttr SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ PXAttr SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [PXAttr SrcSpanInfo]
attrs
(Pat SrcSpanInfo -> EP ()) -> Maybe (Pat SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (Pat SrcSpanInfo)
mat
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
">"
(Pat SrcSpanInfo -> EP ()) -> [Pat SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [Pat SrcSpanInfo]
ps
SrcSpan -> EP ()
printSemi SrcSpan
semi
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
c) String
"</"
Pos -> EP ()
printWhitespace (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
d)
XName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP XName SrcSpanInfo
xn
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
e) String
">"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Pat: PXTag is given wrong number of srcInfoPoints"
PXETag SrcSpanInfo
l XName SrcSpanInfo
xn [PXAttr SrcSpanInfo]
attrs Maybe (Pat SrcSpanInfo)
mat ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
_,SrcSpan
b] -> do
String -> EP ()
printString String
"<"
XName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC XName SrcSpanInfo
xn
(PXAttr SrcSpanInfo -> EP ()) -> [PXAttr SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ PXAttr SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [PXAttr SrcSpanInfo]
attrs
(Pat SrcSpanInfo -> EP ()) -> Maybe (Pat SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (Pat SrcSpanInfo)
mat
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"/>"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Pat: PXETag is given wrong number of srcInfoPoints"
PXPcdata SrcSpanInfo
_ String
str -> String -> EP ()
printString String
str
PXPatTag SrcSpanInfo
l Pat SrcSpanInfo
p ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
_,SrcSpan
_] -> do
String -> EP ()
printString String
"<%"
Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Pat SrcSpanInfo
p
String -> EP ()
printString String
"%>"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Pat: PXPatTag is given wrong number of srcInfoPoints"
PXRPats SrcSpanInfo
l [RPat SrcSpanInfo]
rps -> (String, String, String)
-> [SrcSpan] -> [RPat SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
(String, String, String) -> [SrcSpan] -> [ast SrcSpanInfo] -> EP ()
bracketList (String
"<[",String
",",String
"]>") (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) [RPat SrcSpanInfo]
rps
PSplice SrcSpanInfo
_ Splice SrcSpanInfo
sp -> Splice SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Splice SrcSpanInfo
sp
PQuasiQuote SrcSpanInfo
_ String
name String
qt -> String -> EP ()
printString (String -> EP ()) -> String -> EP ()
forall a b. (a -> b) -> a -> b
$ String
"[$" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"|" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
qt String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"
PBangPat SrcSpanInfo
_ Pat SrcSpanInfo
p -> String -> EP ()
printString String
"!" EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Pat SrcSpanInfo
p
instance ExactP PatField where
exactP :: PatField SrcSpanInfo -> EP ()
exactP PatField SrcSpanInfo
pf = case PatField SrcSpanInfo
pf of
PFieldPat SrcSpanInfo
l QName SrcSpanInfo
qn Pat SrcSpanInfo
p ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
a] -> do
QName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP QName SrcSpanInfo
qn
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"="
Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Pat SrcSpanInfo
p
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: PatField: PFieldPat is given wrong number of srcInfoPoints"
PFieldPun SrcSpanInfo
_ QName SrcSpanInfo
n -> QName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP QName SrcSpanInfo
n
PFieldWildcard SrcSpanInfo
_ -> String -> EP ()
printString String
".."
instance ExactP RPat where
exactP :: RPat SrcSpanInfo -> EP ()
exactP RPat SrcSpanInfo
rpat = case RPat SrcSpanInfo
rpat of
RPOp SrcSpanInfo
_ RPat SrcSpanInfo
rp RPatOp SrcSpanInfo
op -> RPat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP RPat SrcSpanInfo
rp EP () -> EP () -> EP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RPatOp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC RPatOp SrcSpanInfo
op
RPEither SrcSpanInfo
l RPat SrcSpanInfo
r1 RPat SrcSpanInfo
r2 ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
a] -> do
RPat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP RPat SrcSpanInfo
r1
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"|"
RPat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC RPat SrcSpanInfo
r2
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: RPat: RPEither is given wrong number of srcInfoPoints"
RPSeq SrcSpanInfo
l [RPat SrcSpanInfo]
rps -> (String, String, String)
-> [SrcSpan] -> [RPat SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
(String, String, String) -> [SrcSpan] -> [ast SrcSpanInfo] -> EP ()
bracketList (String
"(|",String
",",String
"|)") (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) [RPat SrcSpanInfo]
rps
RPGuard SrcSpanInfo
l Pat SrcSpanInfo
p [Stmt SrcSpanInfo]
stmts ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
SrcSpan
_:[SrcSpan]
pts -> do
String -> EP ()
printString String
"(|"
Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Pat SrcSpanInfo
p
(String, String, String)
-> [SrcSpan] -> [Stmt SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
(String, String, String) -> [SrcSpan] -> [ast SrcSpanInfo] -> EP ()
bracketList (String
"|",String
",",String
"|)") [SrcSpan]
pts [Stmt SrcSpanInfo]
stmts
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: RPat: RPGuard is given wrong number of srcInfoPoints"
RPCAs SrcSpanInfo
l Name SrcSpanInfo
n RPat SrcSpanInfo
rp ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
a] -> do
Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Name SrcSpanInfo
n
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"@:"
RPat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC RPat SrcSpanInfo
rp
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: RPat: RPCAs is given wrong number of srcInfoPoints"
RPAs SrcSpanInfo
l Name SrcSpanInfo
n RPat SrcSpanInfo
rp ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
a] -> do
Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Name SrcSpanInfo
n
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"@"
RPat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC RPat SrcSpanInfo
rp
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: RPat: RPAs is given wrong number of srcInfoPoints"
RPParen SrcSpanInfo
l RPat SrcSpanInfo
rp -> [SrcSpan] -> [RPat SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
parenList (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) [RPat SrcSpanInfo
rp]
RPPat SrcSpanInfo
_ Pat SrcSpanInfo
p -> Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Pat SrcSpanInfo
p
instance ExactP RPatOp where
exactP :: RPatOp SrcSpanInfo -> EP ()
exactP RPatOp SrcSpanInfo
rop = String -> EP ()
printString (String -> EP ()) -> String -> EP ()
forall a b. (a -> b) -> a -> b
$ case RPatOp SrcSpanInfo
rop of
RPStar SrcSpanInfo
_ -> String
"*"
RPStarG SrcSpanInfo
_ -> String
"*!"
RPPlus SrcSpanInfo
_ -> String
"+"
RPPlusG SrcSpanInfo
_ -> String
"+!"
RPOpt SrcSpanInfo
_ -> String
"?"
RPOptG SrcSpanInfo
_ -> String
"?!"
instance ExactP PXAttr where
exactP :: PXAttr SrcSpanInfo -> EP ()
exactP (PXAttr SrcSpanInfo
l XName SrcSpanInfo
xn Pat SrcSpanInfo
p) =
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
a] -> do
XName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP XName SrcSpanInfo
xn
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"="
Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Pat SrcSpanInfo
p
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: PXAttr is given wrong number of srcInfoPoints"
instance ExactP XName where
exactP :: XName SrcSpanInfo -> EP ()
exactP XName SrcSpanInfo
xn = case XName SrcSpanInfo
xn of
XName SrcSpanInfo
_ String
name -> String -> EP ()
printString String
name
XDomName SrcSpanInfo
l String
dom String
name ->
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
_,SrcSpan
b,SrcSpan
c] -> do
String -> EP ()
printString String
dom
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
":"
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
c) String
name
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: XName: XDomName is given wrong number of srcInfoPoints"
instance ExactP Binds where
exactP :: Binds SrcSpanInfo -> EP ()
exactP (BDecls SrcSpanInfo
l [Decl SrcSpanInfo]
ds) = [SrcSpan] -> [Decl SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
layoutList (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) ([Decl SrcSpanInfo] -> [Decl SrcSpanInfo]
sepFunBinds [Decl SrcSpanInfo]
ds)
exactP (IPBinds SrcSpanInfo
l [IPBind SrcSpanInfo]
ips) = [SrcSpan] -> [IPBind SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
layoutList (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) [IPBind SrcSpanInfo]
ips
instance ExactP CallConv where
exactP :: CallConv SrcSpanInfo -> EP ()
exactP (StdCall SrcSpanInfo
_) = String -> EP ()
printString String
"stdcall"
exactP (CCall SrcSpanInfo
_) = String -> EP ()
printString String
"ccall"
exactP (CPlusPlus SrcSpanInfo
_) = String -> EP ()
printString String
"cplusplus"
exactP (DotNet SrcSpanInfo
_) = String -> EP ()
printString String
"dotnet"
exactP (Jvm SrcSpanInfo
_) = String -> EP ()
printString String
"jvm"
exactP (Js SrcSpanInfo
_) = String -> EP ()
printString String
"js"
exactP (JavaScript SrcSpanInfo
_) = String -> EP ()
printString String
"javascript"
exactP (CApi SrcSpanInfo
_) = String -> EP ()
printString String
"capi"
instance ExactP Safety where
exactP :: Safety SrcSpanInfo -> EP ()
exactP (PlayRisky SrcSpanInfo
_) = String -> EP ()
printString String
"unsafe"
exactP (PlaySafe SrcSpanInfo
_ Bool
b) = String -> EP ()
printString (String -> EP ()) -> String -> EP ()
forall a b. (a -> b) -> a -> b
$ if Bool
b then String
"threadsafe" else String
"safe"
exactP (PlayInterruptible SrcSpanInfo
_) = String -> EP ()
printString String
"interruptible"
instance ExactP Rule where
exactP :: Rule SrcSpanInfo -> EP ()
exactP (Rule SrcSpanInfo
l String
str Maybe (Activation SrcSpanInfo)
mact Maybe [RuleVar SrcSpanInfo]
mrvs Exp SrcSpanInfo
e1 Exp SrcSpanInfo
e2) =
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
SrcSpan
_:[SrcSpan]
pts -> do
String -> EP ()
printString (ShowS
forall a. Show a => a -> String
show String
str)
(Activation SrcSpanInfo -> EP ())
-> Maybe (Activation SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Activation SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Maybe (Activation SrcSpanInfo)
mact
[SrcSpan]
pts1 <- case Maybe [RuleVar SrcSpanInfo]
mrvs of
Maybe [RuleVar SrcSpanInfo]
Nothing -> [SrcSpan] -> EP [SrcSpan]
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts
Just [RuleVar SrcSpanInfo]
rvs ->
case [SrcSpan]
pts of
SrcSpan
a':SrcSpan
b:[SrcSpan]
pts' -> do
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a') String
"forall"
(RuleVar SrcSpanInfo -> EP ()) -> [RuleVar SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ RuleVar SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [RuleVar SrcSpanInfo]
rvs
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"."
[SrcSpan] -> EP [SrcSpan]
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts'
[SrcSpan]
_ -> String -> EP [SrcSpan]
forall a. String -> EP a
errorEP String
"ExactP: Rule is given too few srcInfoPoints"
case [SrcSpan]
pts1 of
[SrcSpan
x] -> do
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e1
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
x) String
"="
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e2
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Rule is given wrong number of srcInfoPoints"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Rule is given too few srcInfoPoints"
instance ExactP RuleVar where
exactP :: RuleVar SrcSpanInfo -> EP ()
exactP (TypedRuleVar SrcSpanInfo
l Name SrcSpanInfo
n Type SrcSpanInfo
t) =
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
_,SrcSpan
b,SrcSpan
c] -> do
String -> EP ()
printString String
"("
Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Name SrcSpanInfo
n
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"::"
Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
c) String
")"
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: RuleVar: TypedRuleVar is given wrong number of srcInfoPoints"
exactP (RuleVar SrcSpanInfo
_ Name SrcSpanInfo
n) = Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Name SrcSpanInfo
n
instance ExactP Overlap where
exactP :: Overlap SrcSpanInfo -> EP ()
exactP (NoOverlap SrcSpanInfo
_) =
String -> EP ()
printString String
"{-# NO_OVERLAP #-}"
exactP (Overlap SrcSpanInfo
_) =
String -> EP ()
printString String
"{-# OVERLAP #-}"
exactP (Overlaps SrcSpanInfo
_) =
String -> EP ()
printString String
"{-# OVERLAPS #-}"
exactP (Overlapping SrcSpanInfo
_) =
String -> EP ()
printString String
"{-# OVERLAPPING #-}"
exactP (Overlappable SrcSpanInfo
_) =
String -> EP ()
printString String
"{-# OVERLAPPABLE #-}"
exactP (Incoherent SrcSpanInfo
_) =
String -> EP ()
printString String
"{-# INCOHERENT #-}"
instance ExactP Activation where
exactP :: Activation SrcSpanInfo -> EP ()
exactP (ActiveFrom SrcSpanInfo
l Int
i) =
SrcSpanInfo -> [String] -> EP ()
printPoints SrcSpanInfo
l [String
"[", Int -> String
forall a. Show a => a -> String
show Int
i, String
"]"]
exactP (ActiveUntil SrcSpanInfo
l Int
i) =
SrcSpanInfo -> [String] -> EP ()
printPoints SrcSpanInfo
l [String
"[", String
"~", Int -> String
forall a. Show a => a -> String
show Int
i, String
"]"]
instance ExactP FieldDecl where
exactP :: FieldDecl SrcSpanInfo -> EP ()
exactP (FieldDecl SrcSpanInfo
l [Name SrcSpanInfo]
ns Type SrcSpanInfo
bt) = do
let pts :: [SrcSpan]
pts = SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l
[(SrcSpan, String)] -> [Name SrcSpanInfo] -> EP ()
forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved' ([SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([SrcSpan] -> [SrcSpan]
forall a. [a] -> [a]
init [SrcSpan]
pts) (String -> [String]
forall a. a -> [a]
repeat String
",") [(SrcSpan, String)] -> [(SrcSpan, String)] -> [(SrcSpan, String)]
forall a. [a] -> [a] -> [a]
++ [([SrcSpan] -> SrcSpan
forall a. [a] -> a
last [SrcSpan]
pts, String
"::")]) [Name SrcSpanInfo]
ns
Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
bt
instance ExactP IPBind where
exactP :: IPBind SrcSpanInfo -> EP ()
exactP (IPBind SrcSpanInfo
l IPName SrcSpanInfo
ipn Exp SrcSpanInfo
e) =
case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
[SrcSpan
a] -> do
IPName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP IPName SrcSpanInfo
ipn
Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"="
Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
[SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: IPBind is given wrong number of srcInfoPoints"
internalError :: String -> a
internalError :: String -> a
internalError String
loc' = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
[ String
"haskell-src-exts: ExactPrint: internal error (non-exhaustive pattern)"
, String
"Location: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
loc'
, String
"This is either caused by supplying incorrect location information or by"
, String
"a bug in haskell-src-exts. If this happens on an unmodified AST obtained"
, String
"by the haskell-src-exts Parser it is a bug, please it report it at"
, String
"https://github.com/haskell-suite/haskell-src-exts"]