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