{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE CPP #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Language.Haskell.Exts.Annotated.ExactPrint
-- Copyright   :  (c) Niklas Broberg 2009
-- License     :  BSD-style (see the file LICENSE.txt)
--
-- Maintainer  :  Niklas Broberg, d00nibro@chalmers.se
-- Stability   :  stable
-- Portability :  portable
--
-- Exact-printer for Haskell abstract syntax. The input is a (semi-concrete)
-- abstract syntax tree, annotated with exact source information to enable
-- printing the tree exactly as it was parsed.
--
-----------------------------------------------------------------------------
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)

------------------------------------------------------
-- The EP monad and basic combinators

type Pos = (Int,Int)

pos :: (SrcInfo loc) => loc -> Pos
pos :: forall loc. SrcInfo loc => loc -> Pos
pos loc
ss = (loc -> Int
forall si. SrcInfo si => si -> Int
startLine loc
ss, loc -> Int
forall si. SrcInfo si => si -> Int
startColumn loc
ss)

newtype EP x = EP (Pos -> [Comment] -> (x, Pos, [Comment], ShowS))

instance Functor EP where
  fmap :: forall a b. (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 :: forall a. a -> EP a
pure = a -> EP a
forall a. a -> EP a
forall (m :: * -> *) a. Monad m => a -> m a
return
  <*> :: forall a b. 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 :: forall a. a -> EP a
return a
x = (Pos -> [Comment] -> (a, Pos, [Comment], ShowS)) -> EP a
forall x. (Pos -> [Comment] -> (x, Pos, [Comment], ShowS)) -> EP x
EP ((Pos -> [Comment] -> (a, Pos, [Comment], ShowS)) -> EP a)
-> (Pos -> [Comment] -> (a, Pos, [Comment], ShowS)) -> EP a
forall a b. (a -> b) -> a -> b
$ \Pos
l [Comment]
cs -> (a
x, Pos
l, [Comment]
cs, ShowS
forall a. a -> a
id)

  EP Pos -> [Comment] -> (a, Pos, [Comment], ShowS)
m >>= :: forall a b. EP a -> (a -> EP b) -> EP b
>>= a -> EP b
k = (Pos -> [Comment] -> (b, Pos, [Comment], ShowS)) -> EP b
forall x. (Pos -> [Comment] -> (x, Pos, [Comment], ShowS)) -> EP x
EP ((Pos -> [Comment] -> (b, Pos, [Comment], ShowS)) -> EP b)
-> (Pos -> [Comment] -> (b, Pos, [Comment], ShowS)) -> EP b
forall a b. (a -> b) -> a -> b
$ \Pos
l0 [Comment]
c0 -> let
        (a
a, Pos
l1, [Comment]
c1, ShowS
s1) = Pos -> [Comment] -> (a, Pos, [Comment], ShowS)
m Pos
l0 [Comment]
c0
        EP Pos -> [Comment] -> (b, Pos, [Comment], ShowS)
f = a -> EP b
k a
a
        (b
b, Pos
l2, [Comment]
c2, ShowS
s2) = Pos -> [Comment] -> (b, Pos, [Comment], ShowS)
f Pos
l1 [Comment]
c1
    in (b
b, Pos
l2, [Comment]
c2, ShowS
s1 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s2)

instance Fail.MonadFail EP where
  fail :: forall a. String -> EP a
fail = String -> EP a
forall a. HasCallStack => String -> a
error

runEP :: EP () -> [Comment] -> String
runEP :: EP () -> [Comment] -> String
runEP (EP Pos -> [Comment] -> ((), Pos, [Comment], ShowS)
f) [Comment]
cs = let (()
_,Pos
_,[Comment]
_,ShowS
s) = Pos -> [Comment] -> ((), Pos, [Comment], ShowS)
f (Int
1,Int
1) [Comment]
cs in ShowS
s String
""

getPos :: EP Pos
getPos :: EP Pos
getPos = (Pos -> [Comment] -> (Pos, Pos, [Comment], ShowS)) -> EP Pos
forall x. (Pos -> [Comment] -> (x, Pos, [Comment], ShowS)) -> EP x
EP (\Pos
l [Comment]
cs -> (Pos
l,Pos
l,[Comment]
cs,ShowS
forall a. a -> a
id))

setPos :: Pos -> EP ()
setPos :: Pos -> EP ()
setPos Pos
l = (Pos -> [Comment] -> ((), Pos, [Comment], ShowS)) -> EP ()
forall x. (Pos -> [Comment] -> (x, Pos, [Comment], ShowS)) -> EP x
EP (\Pos
_ [Comment]
cs -> ((),Pos
l,[Comment]
cs,ShowS
forall a. a -> a
id))

printString :: String -> EP ()
printString :: String -> EP ()
printString String
str =
  (Pos -> [Comment] -> ((), Pos, [Comment], ShowS)) -> EP ()
forall x. (Pos -> [Comment] -> (x, Pos, [Comment], ShowS)) -> EP x
EP (\(Int
l,Int
c) [Comment]
cs -> let (Int
l', Int
c') = (Pos -> Char -> Pos) -> Pos -> String -> Pos
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Pos -> Char -> Pos
forall {a} {b}. (Num a, Num b) => (a, b) -> Char -> (a, b)
go (Int
l, Int
c) String
str
                       go :: (a, b) -> Char -> (a, b)
go (a
cl, b
_) Char
'\n' = (a
cl a -> a -> a
forall a. Num a => a -> a -> a
+ a
1, b
1)
                       go (a
cl, b
cc) Char
_    = (a
cl, b
cc b -> b -> b
forall a. Num a => a -> a -> a
+ b
1)
                   in ((), (Int
l', Int
c'), [Comment]
cs, String -> ShowS
showString String
str))


getComment :: EP (Maybe Comment)
getComment :: EP (Maybe Comment)
getComment = (Pos -> [Comment] -> (Maybe Comment, Pos, [Comment], ShowS))
-> EP (Maybe Comment)
forall x. (Pos -> [Comment] -> (x, Pos, [Comment], ShowS)) -> EP x
EP ((Pos -> [Comment] -> (Maybe Comment, Pos, [Comment], ShowS))
 -> EP (Maybe Comment))
-> (Pos -> [Comment] -> (Maybe Comment, Pos, [Comment], ShowS))
-> EP (Maybe Comment)
forall a b. (a -> b) -> a -> b
$ \Pos
l [Comment]
cs ->
    let x :: Maybe Comment
x = case [Comment]
cs of
             Comment
c:[Comment]
_ -> Comment -> Maybe Comment
forall a. a -> Maybe a
Just Comment
c
             [Comment]
_   -> Maybe Comment
forall a. Maybe a
Nothing
     in (Maybe Comment
x, Pos
l, [Comment]
cs, ShowS
forall a. a -> a
id)

dropComment :: EP ()
dropComment :: EP ()
dropComment = (Pos -> [Comment] -> ((), Pos, [Comment], ShowS)) -> EP ()
forall x. (Pos -> [Comment] -> (x, Pos, [Comment], ShowS)) -> EP x
EP ((Pos -> [Comment] -> ((), Pos, [Comment], ShowS)) -> EP ())
-> (Pos -> [Comment] -> ((), Pos, [Comment], ShowS)) -> EP ()
forall a b. (a -> b) -> a -> b
$ \Pos
l [Comment]
cs ->
    let cs' :: [Comment]
cs' = case [Comment]
cs of
               (Comment
_:[Comment]
cs1) -> [Comment]
cs1
               [Comment]
_       -> [Comment]
cs
     in ((), Pos
l, [Comment]
cs', ShowS
forall a. a -> a
id)

newLine :: EP ()
newLine :: EP ()
newLine = do
    (Int
l,Int
_) <- EP Pos
getPos
    String -> EP ()
printString String
"\n"
    Pos -> EP ()
setPos (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1,Int
1)

padUntil :: Pos -> EP ()
padUntil :: Pos -> EP ()
padUntil (Int
l,Int
c) = do
    (Int
l1,Int
c1) <- EP Pos
getPos
    case  {- trace (show ((l,c), (l1,c1))) -} () of
     ()
_ {-()-} | Int
l1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
l Bool -> Bool -> Bool
&& Int
c1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
c -> String -> EP ()
printString (String -> EP ()) -> String -> EP ()
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
c1) Char
' '
              | Int
l1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
l             -> EP ()
newLine EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pos -> EP ()
padUntil (Int
l,Int
c)
              | Bool
otherwise          -> () -> EP ()
forall a. a -> EP a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


mPrintComments :: Pos -> EP ()
mPrintComments :: Pos -> EP ()
mPrintComments Pos
p = do
    Maybe Comment
mc <- EP (Maybe Comment)
getComment
    case Maybe Comment
mc of
     Maybe Comment
Nothing -> () -> EP ()
forall a. a -> EP a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     Just (Comment Bool
multi SrcSpan
s String
str) ->
        Bool -> EP () -> EP ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
s Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
< Pos
p) (EP () -> EP ()) -> EP () -> EP ()
forall a b. (a -> b) -> a -> b
$ do
            EP ()
dropComment
            Pos -> EP ()
padUntil (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
s)
            Bool -> String -> EP ()
printComment Bool
multi String
str
            Pos -> EP ()
setPos (SrcSpan -> Int
srcSpanEndLine SrcSpan
s, SrcSpan -> Int
srcSpanEndColumn SrcSpan
s)
            Pos -> EP ()
mPrintComments Pos
p

printComment :: Bool -> String -> EP ()
printComment :: Bool -> String -> EP ()
printComment Bool
b String
str
    | Bool
b         = String -> EP ()
printString (String -> EP ()) -> String -> EP ()
forall a b. (a -> b) -> a -> b
$ String
"{-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
str String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"-}"
    | Bool
otherwise = String -> EP ()
printString (String -> EP ()) -> String -> EP ()
forall a b. (a -> b) -> a -> b
$ String
"--" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
str

printWhitespace :: Pos -> EP ()
printWhitespace :: Pos -> EP ()
printWhitespace Pos
p = Pos -> EP ()
mPrintComments Pos
p EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pos -> EP ()
padUntil Pos
p

printStringAt :: Pos -> String -> EP ()
printStringAt :: Pos -> String -> EP ()
printStringAt Pos
p String
str = Pos -> EP ()
printWhitespace Pos
p EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> EP ()
printString String
str

errorEP :: String -> EP a
errorEP :: forall a. String -> EP a
errorEP = String -> EP a
forall a. String -> EP a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail

------------------------------------------------------------------------------
-- Printing of source elements

-- | Print an AST exactly as specified by the annotations on the nodes in the tree.
exactPrint :: (ExactP ast) => ast SrcSpanInfo -> [Comment] -> String
exactPrint :: forall (ast :: * -> *).
ExactP ast =>
ast SrcSpanInfo -> [Comment] -> String
exactPrint ast SrcSpanInfo
ast = EP () -> [Comment] -> String
runEP (ast SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC ast SrcSpanInfo
ast)

exactPC :: (ExactP ast) => ast SrcSpanInfo -> EP ()
exactPC :: forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC ast SrcSpanInfo
ast = let p :: Pos
p = SrcSpanInfo -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos (ast SrcSpanInfo -> SrcSpanInfo
forall l. ast l -> l
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann ast SrcSpanInfo
ast) in Pos -> EP ()
mPrintComments Pos
p EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pos -> EP ()
padUntil Pos
p EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
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 a. a -> EP a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
printSeq ((Pos
p,EP ()
pr):[(Pos, EP ())]
xs) = Pos -> EP ()
printWhitespace Pos
p EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EP ()
pr EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
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 :: forall loc. SrcInfo loc => [(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 b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** String -> EP ()
printString)

printPoints :: SrcSpanInfo -> [String] -> EP ()
printPoints :: SrcSpanInfo -> [String] -> EP ()
printPoints SrcSpanInfo
l = [(SrcSpan, String)] -> EP ()
forall loc. SrcInfo loc => [(loc, String)] -> EP ()
printStrs ([(SrcSpan, String)] -> EP ())
-> ([String] -> [(SrcSpan, String)]) -> [String] -> EP ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l)

printInterleaved, printInterleaved' :: (ExactP ast, SrcInfo loc) => [(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved :: forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved [(loc, String)]
sistrs [ast SrcSpanInfo]
asts = [(Pos, EP ())] -> EP ()
printSeq ([(Pos, EP ())] -> EP ()) -> [(Pos, EP ())] -> EP ()
forall a b. (a -> b) -> a -> b
$
    [(Pos, EP ())] -> [(Pos, EP ())] -> [(Pos, EP ())]
forall a. [a] -> [a] -> [a]
interleave (((loc, String) -> (Pos, EP ()))
-> [(loc, String)] -> [(Pos, EP ())]
forall a b. (a -> b) -> [a] -> [b]
map (loc -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos (loc -> Pos) -> (String -> EP ()) -> (loc, String) -> (Pos, EP ())
forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
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 l. ast l -> l
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann (ast SrcSpanInfo -> Pos)
-> (ast SrcSpanInfo -> EP ()) -> ast SrcSpanInfo -> (Pos, EP ())
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
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' :: forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved' [(loc, String)]
sistrs (ast SrcSpanInfo
a:[ast SrcSpanInfo]
asts) = ast SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC ast SrcSpanInfo
a EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [(loc, String)] -> [ast SrcSpanInfo] -> EP ()
forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved [(loc, String)]
sistrs [ast SrcSpanInfo]
asts
printInterleaved' [(loc, String)]
_ [ast SrcSpanInfo]
_ = String -> EP ()
forall a. String -> a
internalError String
"printInterleaved'"

printStreams :: [(Pos, EP ())] -> [(Pos, EP ())] -> EP ()
printStreams :: [(Pos, EP ())] -> [(Pos, EP ())] -> EP ()
printStreams [] [(Pos, EP ())]
ys = [(Pos, EP ())] -> EP ()
printSeq [(Pos, EP ())]
ys
printStreams [(Pos, EP ())]
xs [] = [(Pos, EP ())] -> EP ()
printSeq [(Pos, EP ())]
xs
printStreams (x :: (Pos, EP ())
x@(Pos
p1,EP ()
ep1):[(Pos, EP ())]
xs) (y :: (Pos, EP ())
y@(Pos
p2,EP ()
ep2):[(Pos, EP ())]
ys)
    | Pos
p1 Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
<= Pos
p2 = Pos -> EP ()
printWhitespace Pos
p1 EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EP ()
ep1 EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
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 a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EP ()
ep2 EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
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 :: forall a. [a] -> [a] -> [a]
interleave [] [a]
ys = [a]
ys
interleave [a]
xs [] = [a]
xs
interleave (a
x:[a]
xs) (a
y:[a]
ys) = a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
interleave [a]
xs [a]
ys

maybeEP :: (a -> EP ()) -> Maybe a -> EP ()
maybeEP :: forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP = EP () -> (a -> EP ()) -> Maybe a -> EP ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> EP ()
forall a. a -> EP a
forall (m :: * -> *) a. Monad m => a -> m a
return ())

bracketList :: (ExactP ast) => (String, String, String) -> [SrcSpan] -> [ast SrcSpanInfo] -> EP ()
bracketList :: forall (ast :: * -> *).
ExactP ast =>
(String, String, String) -> [SrcSpan] -> [ast SrcSpanInfo] -> EP ()
bracketList (String
a,String
b,String
c) [SrcSpan]
poss [ast SrcSpanInfo]
asts = [(SrcSpan, String)] -> [ast SrcSpanInfo] -> EP ()
forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved ([SrcSpan] -> (String, String, String) -> [(SrcSpan, String)]
forall a b. [a] -> (b, b, b) -> [(a, b)]
pList [SrcSpan]
poss (String
a,String
b,String
c)) [ast SrcSpanInfo]
asts

pList :: [a] -> (b, b, b) -> [(a, b)]
pList :: forall a b. [a] -> (b, b, b) -> [(a, b)]
pList (a
p:[a]
ps) (b
a,b
b,b
c) = (a
p,b
a) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [a] -> (b, b) -> [(a, b)]
forall a b. [a] -> (b, b) -> [(a, b)]
pList' [a]
ps (b
b,b
c)
pList [a]
_ (b, b, b)
_ = String -> [(a, b)]
forall a. String -> a
internalError String
"pList"
pList' :: [a] -> (b, b) -> [(a, b)]
pList' :: forall a b. [a] -> (b, b) -> [(a, b)]
pList' [] (b, b)
_ = []
pList' [a
p] (b
_,b
c) = [(a
p,b
c)]
pList' (a
p:[a]
ps) (b
b,b
c) = (a
p, b
b) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [a] -> (b, b) -> [(a, b)]
forall a b. [a] -> (b, b) -> [(a, b)]
pList' [a]
ps (b
b,b
c)

parenList, squareList, squareColonList, curlyList, parenHashList,
  unboxedSumTypeList :: (ExactP ast) => [SrcSpan] -> [ast SrcSpanInfo] -> EP ()
parenList :: forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
parenList = (String, String, String) -> [SrcSpan] -> [ast SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
(String, String, String) -> [SrcSpan] -> [ast SrcSpanInfo] -> EP ()
bracketList (String
"(",String
",",String
")")
squareList :: forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
squareList = (String, String, String) -> [SrcSpan] -> [ast SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
(String, String, String) -> [SrcSpan] -> [ast SrcSpanInfo] -> EP ()
bracketList (String
"[",String
",",String
"]")
squareColonList :: forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
squareColonList = (String, String, String) -> [SrcSpan] -> [ast SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
(String, String, String) -> [SrcSpan] -> [ast SrcSpanInfo] -> EP ()
bracketList (String
"[:",String
",",String
":]")
curlyList :: forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
curlyList = (String, String, String) -> [SrcSpan] -> [ast SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
(String, String, String) -> [SrcSpan] -> [ast SrcSpanInfo] -> EP ()
bracketList (String
"{",String
",",String
"}")
parenHashList :: forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
parenHashList = (String, String, String) -> [SrcSpan] -> [ast SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
(String, String, String) -> [SrcSpan] -> [ast SrcSpanInfo] -> EP ()
bracketList (String
"(#",String
",",String
"#)")
unboxedSumTypeList :: forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
unboxedSumTypeList = (String, String, String) -> [SrcSpan] -> [ast SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
(String, String, String) -> [SrcSpan] -> [ast SrcSpanInfo] -> EP ()
bracketList (String
"(#", String
"|", String
"#)")

layoutList :: (ExactP ast) => [SrcSpan] -> [ast SrcSpanInfo] -> EP ()
layoutList :: forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
layoutList [SrcSpan]
poss [ast SrcSpanInfo]
asts = [(Pos, EP ())] -> [(Pos, EP ())] -> EP ()
printStreams
        (((SrcSpan, String) -> (Pos, EP ()))
-> [(SrcSpan, String)] -> [(Pos, EP ())]
forall a b. (a -> b) -> [a] -> [b]
map (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos (SrcSpan -> Pos)
-> (String -> EP ()) -> (SrcSpan, String) -> (Pos, EP ())
forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
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 l. ast l -> l
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann (ast SrcSpanInfo -> Pos)
-> (ast SrcSpanInfo -> EP ()) -> ast SrcSpanInfo -> (Pos, EP ())
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ast SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP) [ast SrcSpanInfo]
asts)

lList :: [SrcSpan] -> [(SrcSpan, String)]
lList :: [SrcSpan] -> [(SrcSpan, String)]
lList (SrcSpan
p:[SrcSpan]
ps) = (if SrcSpan -> Bool
isNullSpan SrcSpan
p then (SrcSpan
p,String
"") else (SrcSpan
p,String
"{")) (SrcSpan, String) -> [(SrcSpan, String)] -> [(SrcSpan, String)]
forall a. a -> [a] -> [a]
: [SrcSpan] -> [(SrcSpan, String)]
lList' [SrcSpan]
ps
lList [SrcSpan]
_ = String -> [(SrcSpan, String)]
forall a. String -> a
internalError String
"lList"
lList' :: [SrcSpan] -> [(SrcSpan, String)]
lList' :: [SrcSpan] -> [(SrcSpan, String)]
lList' [] = []
lList' [SrcSpan
p] = [if SrcSpan -> Bool
isNullSpan SrcSpan
p then (SrcSpan
p,String
"") else (SrcSpan
p,String
"}")]
lList' (SrcSpan
p:[SrcSpan]
ps) = (if SrcSpan -> Bool
isNullSpan SrcSpan
p then (SrcSpan
p,String
"") else (SrcSpan
p,String
";")) (SrcSpan, String) -> [(SrcSpan, String)] -> [(SrcSpan, String)]
forall a. a -> [a] -> [a]
: [SrcSpan] -> [(SrcSpan, String)]
lList' [SrcSpan]
ps

printSemi :: SrcSpan -> EP ()
printSemi :: SrcSpan -> EP ()
printSemi SrcSpan
p = do
  Pos -> EP ()
printWhitespace (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
p)
  Bool -> EP () -> EP ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (SrcSpan -> Bool
isNullSpan SrcSpan
p) (EP () -> EP ()) -> EP () -> EP ()
forall a b. (a -> b) -> a -> b
$ String -> EP ()
printString String
";"


--------------------------------------------------
-- Exact printing

class Annotated ast => ExactP ast where
  exactP :: ast SrcSpanInfo -> EP ()

instance ExactP Literal where
  exactP :: Literal SrcSpanInfo -> EP ()
exactP Literal SrcSpanInfo
lit = case Literal SrcSpanInfo
lit of
    Char       SrcSpanInfo
_ Char
_ String
rw -> String -> EP ()
printString (Char
'\''Char -> ShowS
forall a. a -> [a] -> [a]
:String
rw String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\'")
    String     SrcSpanInfo
_ String
_ String
rw -> String -> EP ()
printString (Char
'\"'Char -> ShowS
forall a. a -> [a] -> [a]
:String
rw String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\"")
    Int        SrcSpanInfo
_ Integer
_ String
rw -> String -> EP ()
printString String
rw
    Frac       SrcSpanInfo
_ Rational
_ String
rw -> String -> EP ()
printString String
rw
    PrimInt    SrcSpanInfo
_ Integer
_ String
rw -> String -> EP ()
printString (String
rw String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"#" )
    PrimWord   SrcSpanInfo
_ Integer
_ String
rw -> String -> EP ()
printString (String
rw String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"##")
    PrimFloat  SrcSpanInfo
_ Rational
_ String
rw -> String -> EP ()
printString (String
rw String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"#" )
    PrimDouble SrcSpanInfo
_ Rational
_ String
rw -> String -> EP ()
printString (String
rw String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"##")
    PrimChar   SrcSpanInfo
_ Char
_ String
rw -> String -> EP ()
printString (Char
'\''Char -> ShowS
forall a. a -> [a] -> [a]
:String
rw String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\'#" )
    PrimString SrcSpanInfo
_ String
_ String
rw -> String -> EP ()
printString (Char
'\"'Char -> ShowS
forall a. a -> [a] -> [a]
:String
rw String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\"#" )

instance ExactP Sign where
  exactP :: Sign SrcSpanInfo -> EP ()
exactP Sign SrcSpanInfo
sg = case Sign SrcSpanInfo
sg of
    Signless SrcSpanInfo
_ -> () -> EP ()
forall a. a -> EP a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Negative SrcSpanInfo
l -> Pos -> String -> EP ()
printStringAt (SrcSpanInfo -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpanInfo
l) String
"-"

instance ExactP ModuleName where
  exactP :: ModuleName SrcSpanInfo -> EP ()
exactP (ModuleName SrcSpanInfo
_ String
str) = String -> EP ()
printString String
str

instance ExactP SpecialCon where
  exactP :: SpecialCon SrcSpanInfo -> EP ()
exactP SpecialCon SrcSpanInfo
sc = case SpecialCon SrcSpanInfo
sc of
    UnitCon SrcSpanInfo
l   -> SrcSpanInfo -> [String] -> EP ()
printPoints SrcSpanInfo
l [String
"(",String
")"]
    ListCon SrcSpanInfo
l   -> SrcSpanInfo -> [String] -> EP ()
printPoints SrcSpanInfo
l [String
"[",String
"]"]
    FunCon  SrcSpanInfo
l   -> case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
                    [SrcSpan
_,SrcSpan
b,SrcSpan
_] -> Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"->"
                    [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: SpecialCon is given wrong number of srcInfoPoints"
    TupleCon SrcSpanInfo
l Boxed
b Int
n -> SrcSpanInfo -> [String] -> EP ()
printPoints SrcSpanInfo
l ([String] -> EP ()) -> [String] -> EP ()
forall a b. (a -> b) -> a -> b
$
        case Boxed
b of
         Boxed
Unboxed -> String
"(#"String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Int -> String -> [String]
forall a. Int -> a -> [a]
replicate (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) String
"," [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"#)"]
         Boxed
_       -> String
"(" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Int -> String -> [String]
forall a. Int -> a -> [a]
replicate (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) String
"," [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
")"]
    Cons SrcSpanInfo
_      -> String -> EP ()
printString String
":"
    UnboxedSingleCon SrcSpanInfo
l -> SrcSpanInfo -> [String] -> EP ()
printPoints SrcSpanInfo
l [String
"(#",String
"#)"]
    ExprHole SrcSpanInfo
l -> Pos -> String -> EP ()
printStringAt (SrcSpanInfo -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpanInfo
l) String
"_"

isSymbolName :: Name l -> Bool
isSymbolName :: forall l. Name l -> Bool
isSymbolName (Symbol l
_ String
_) = Bool
True
isSymbolName Name l
_            = Bool
False

isSymbolQName :: QName l -> Bool
isSymbolQName :: forall l. QName l -> Bool
isSymbolQName (UnQual l
_ Name l
n)         = Name l -> Bool
forall l. Name l -> Bool
isSymbolName Name l
n
isSymbolQName (Qual l
_ ModuleName l
_ Name l
n)         = Name l -> Bool
forall l. Name l -> Bool
isSymbolName Name l
n
isSymbolQName (Special l
_ Cons{})   = Bool
True
isSymbolQName (Special l
_ FunCon{}) = Bool
True
isSymbolQName QName l
_                    = Bool
False

instance ExactP QName where
  exactP :: QName SrcSpanInfo -> EP ()
exactP QName SrcSpanInfo
qn
    | QName SrcSpanInfo -> Bool
forall l. QName l -> Bool
isSymbolQName QName SrcSpanInfo
qn =
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints (QName SrcSpanInfo -> SrcSpanInfo
forall l. QName l -> l
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann QName SrcSpanInfo
qn) of
         [SrcSpan
_,SrcSpan
b,SrcSpan
c] -> do
            String -> EP ()
printString String
"("
            Pos -> EP ()
printWhitespace (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b)
            QName SrcSpanInfo -> EP ()
epQName QName SrcSpanInfo
qn
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
c) String
")"
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: QName is given wrong number of srcInfoPoints"
    | Bool
otherwise = QName SrcSpanInfo -> EP ()
epQName QName SrcSpanInfo
qn

epQName :: QName SrcSpanInfo -> EP ()
epQName :: QName SrcSpanInfo -> EP ()
epQName QName SrcSpanInfo
qn = case QName SrcSpanInfo
qn of
    Qual    SrcSpanInfo
_ ModuleName SrcSpanInfo
mn Name SrcSpanInfo
n  -> ModuleName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP ModuleName SrcSpanInfo
mn EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> EP ()
printString String
"." EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Name SrcSpanInfo
n
    UnQual  SrcSpanInfo
_    Name SrcSpanInfo
n  -> Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Name SrcSpanInfo
n
    Special SrcSpanInfo
_ SpecialCon SrcSpanInfo
sc    -> SpecialCon SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP SpecialCon SrcSpanInfo
sc

epInfixQName :: QName SrcSpanInfo -> EP ()
epInfixQName :: QName SrcSpanInfo -> EP ()
epInfixQName QName SrcSpanInfo
qn
    | QName SrcSpanInfo -> Bool
forall l. QName l -> Bool
isSymbolQName QName SrcSpanInfo
qn = Pos -> EP ()
printWhitespace (SrcSpanInfo -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos (QName SrcSpanInfo -> SrcSpanInfo
forall l. QName l -> l
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann QName SrcSpanInfo
qn)) EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
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 l. QName l -> l
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann QName SrcSpanInfo
qn) of
         [SrcSpan
a,SrcSpan
b,SrcSpan
c] -> do
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"`"
            Pos -> EP ()
printWhitespace (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b)
            QName SrcSpanInfo -> EP ()
epQName QName SrcSpanInfo
qn
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
c) String
"`"
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: QName (epInfixName) is given wrong number of srcInfoPoints"

instance ExactP Name where
  exactP :: Name SrcSpanInfo -> EP ()
exactP Name SrcSpanInfo
n = case Name SrcSpanInfo
n of
    Ident  SrcSpanInfo
_ String
str    -> String -> EP ()
printString String
str
    Symbol SrcSpanInfo
l String
str    ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
_,SrcSpan
b,SrcSpan
c] -> do
            String -> EP ()
printString String
"("
            Pos -> EP ()
printWhitespace (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b)
            String -> EP ()
printString String
str
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
c) String
")"
         [] -> String -> EP ()
printString String
str
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Name is given wrong number of srcInfoPoints"

epInfixName :: Name SrcSpanInfo -> EP ()
epInfixName :: Name SrcSpanInfo -> EP ()
epInfixName Name SrcSpanInfo
n
    | Name SrcSpanInfo -> Bool
forall l. Name l -> Bool
isSymbolName Name SrcSpanInfo
n = Pos -> EP ()
printWhitespace (SrcSpanInfo -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos (Name SrcSpanInfo -> SrcSpanInfo
forall l. Name l -> l
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann Name SrcSpanInfo
n)) EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
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 l. Name l -> l
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann Name SrcSpanInfo
n) of
         [SrcSpan
a,SrcSpan
b,SrcSpan
c] -> do
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"`"
            Pos -> EP ()
printWhitespace (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b)
            Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Name SrcSpanInfo
n
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
c) String
"`"
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Name (epInfixName) is given wrong number of srcInfoPoints"

instance ExactP IPName where
  exactP :: IPName SrcSpanInfo -> EP ()
exactP IPName SrcSpanInfo
ipn = case IPName SrcSpanInfo
ipn of
    IPDup SrcSpanInfo
_ String
str -> String -> EP ()
printString (String -> EP ()) -> String -> EP ()
forall a b. (a -> b) -> a -> b
$ Char
'?'Char -> ShowS
forall a. a -> [a] -> [a]
:String
str
    IPLin SrcSpanInfo
_ String
str -> String -> EP ()
printString (String -> EP ()) -> String -> EP ()
forall a b. (a -> b) -> a -> b
$ Char
'%'Char -> ShowS
forall a. a -> [a] -> [a]
:String
str

instance ExactP QOp where
  exactP :: QOp SrcSpanInfo -> EP ()
exactP QOp SrcSpanInfo
qop = case QOp SrcSpanInfo
qop of
    QVarOp SrcSpanInfo
_ QName SrcSpanInfo
qn -> QName SrcSpanInfo -> EP ()
epInfixQName QName SrcSpanInfo
qn
    QConOp SrcSpanInfo
_ QName SrcSpanInfo
qn -> QName SrcSpanInfo -> EP ()
epInfixQName QName SrcSpanInfo
qn

instance ExactP Op where
  exactP :: Op SrcSpanInfo -> EP ()
exactP Op SrcSpanInfo
op = case Op SrcSpanInfo
op of
    VarOp SrcSpanInfo
_ Name SrcSpanInfo
n -> Name SrcSpanInfo -> EP ()
epInfixName Name SrcSpanInfo
n
    ConOp SrcSpanInfo
_ Name SrcSpanInfo
n -> Name SrcSpanInfo -> EP ()
epInfixName Name SrcSpanInfo
n



instance ExactP CName where
  exactP :: CName SrcSpanInfo -> EP ()
exactP CName SrcSpanInfo
cn = case CName SrcSpanInfo
cn of
    VarName SrcSpanInfo
_ Name SrcSpanInfo
n -> Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Name SrcSpanInfo
n
    ConName SrcSpanInfo
_ Name SrcSpanInfo
n -> Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Name SrcSpanInfo
n

instance ExactP Namespace where
  exactP :: Namespace SrcSpanInfo -> EP ()
exactP Namespace SrcSpanInfo
ns = case Namespace SrcSpanInfo
ns of
     NoNamespace SrcSpanInfo
_   -> () -> EP ()
forall a. a -> EP a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     TypeNamespace SrcSpanInfo
l -> Pos -> String -> EP ()
printStringAt (SrcSpanInfo -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpanInfo
l) String
"type"
     PatternNamespace SrcSpanInfo
l -> Pos -> String -> EP ()
printStringAt (SrcSpanInfo -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpanInfo
l) String
"pattern"

instance ExactP ExportSpec where
  exactP :: ExportSpec SrcSpanInfo -> EP ()
exactP ExportSpec SrcSpanInfo
espec = case ExportSpec SrcSpanInfo
espec of
     EVar SrcSpanInfo
_ QName SrcSpanInfo
qn    -> QName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC QName SrcSpanInfo
qn
     EAbs SrcSpanInfo
_ Namespace SrcSpanInfo
ns QName SrcSpanInfo
qn -> Namespace SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Namespace SrcSpanInfo
ns EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> QName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC QName SrcSpanInfo
qn
     EThingWith SrcSpanInfo
l EWildcard SrcSpanInfo
wc QName SrcSpanInfo
qn [CName SrcSpanInfo]
cns    ->
         let names :: [CName SrcSpanInfo]
names = case EWildcard SrcSpanInfo
wc of
                        NoWildcard {} -> [CName SrcSpanInfo]
cns
                        EWildcard SrcSpanInfo
wcl Int
n  ->
                          let ([CName SrcSpanInfo]
before,[CName SrcSpanInfo]
after) = Int
-> [CName SrcSpanInfo]
-> ([CName SrcSpanInfo], [CName SrcSpanInfo])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [CName SrcSpanInfo]
cns
                              wildcardName :: CName SrcSpanInfo
wildcardName = SrcSpanInfo -> Name SrcSpanInfo -> CName SrcSpanInfo
forall l. l -> Name l -> CName l
VarName SrcSpanInfo
wcl (SrcSpanInfo -> String -> Name SrcSpanInfo
forall l. l -> String -> Name l
Ident SrcSpanInfo
wcl String
"..")
                          in [CName SrcSpanInfo]
before [CName SrcSpanInfo] -> [CName SrcSpanInfo] -> [CName SrcSpanInfo]
forall a. [a] -> [a] -> [a]
++ [CName SrcSpanInfo
wildcardName] [CName SrcSpanInfo] -> [CName SrcSpanInfo] -> [CName SrcSpanInfo]
forall a. [a] -> [a] -> [a]
++ [CName SrcSpanInfo]
after
             k :: Int
k = [SrcSpan] -> Int
forall a. [a] -> 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 a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [(SrcSpan, String)] -> [CName SrcSpanInfo] -> EP ()
forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved ([SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) ([String] -> [(SrcSpan, String)])
-> [String] -> [(SrcSpan, String)]
forall a b. (a -> b) -> a -> b
$ String
"("String -> [String] -> [String]
forall a. a -> [a] -> [a]
:Int -> String -> [String]
forall a. Int -> a -> [a]
replicate (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2) String
"," [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
")"]) [CName SrcSpanInfo]
names
     EModuleContents SrcSpanInfo
_ ModuleName SrcSpanInfo
mn -> String -> EP ()
printString String
"module" EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ModuleName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC ModuleName SrcSpanInfo
mn

instance ExactP ExportSpecList where
  exactP :: ExportSpecList SrcSpanInfo -> EP ()
exactP (ExportSpecList SrcSpanInfo
l [ExportSpec SrcSpanInfo]
ess) =
    let k :: Int
k = [SrcSpan] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l)
     in [(SrcSpan, String)] -> [ExportSpec SrcSpanInfo] -> EP ()
forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved ([SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) ([String] -> [(SrcSpan, String)])
-> [String] -> [(SrcSpan, String)]
forall a b. (a -> b) -> a -> b
$ String
"("String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Int -> String -> [String]
forall a. Int -> a -> [a]
replicate (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2) String
"," [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
")"]) [ExportSpec SrcSpanInfo]
ess

instance ExactP ImportSpecList where
  exactP :: ImportSpecList SrcSpanInfo -> EP ()
exactP (ImportSpecList SrcSpanInfo
l Bool
hid [ImportSpec SrcSpanInfo]
ispecs) = do
    let pts :: [SrcSpan]
pts = SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l
    [SrcSpan]
pts1 <- if Bool
hid then do
             let (SrcSpan
x:[SrcSpan]
pts') = [SrcSpan]
pts
             Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
x) String
"hiding"
             [SrcSpan] -> EP [SrcSpan]
forall a. a -> EP a
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts'
            else [SrcSpan] -> EP [SrcSpan]
forall a. a -> EP a
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts
    let k :: Int
k = [SrcSpan] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SrcSpan]
pts1
    [(SrcSpan, String)] -> [ImportSpec SrcSpanInfo] -> EP ()
forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved ([SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SrcSpan]
pts1 ([String] -> [(SrcSpan, String)])
-> [String] -> [(SrcSpan, String)]
forall a b. (a -> b) -> a -> b
$ String
"("String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Int -> String -> [String]
forall a. Int -> a -> [a]
replicate (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2) String
"," [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
")"]) [ImportSpec SrcSpanInfo]
ispecs

instance ExactP ImportSpec where
  exactP :: ImportSpec SrcSpanInfo -> EP ()
exactP ImportSpec SrcSpanInfo
ispec = case ImportSpec SrcSpanInfo
ispec of
    IVar SrcSpanInfo
_ Name SrcSpanInfo
qn       -> Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Name SrcSpanInfo
qn
    IAbs SrcSpanInfo
_ Namespace SrcSpanInfo
ns Name SrcSpanInfo
n     -> Namespace SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Namespace SrcSpanInfo
ns EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Name SrcSpanInfo
n
    IThingAll SrcSpanInfo
l Name SrcSpanInfo
n   -> Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Name SrcSpanInfo
n EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SrcSpanInfo -> [String] -> EP ()
printPoints SrcSpanInfo
l [String
"(",String
"..",String
")"]
    IThingWith SrcSpanInfo
l Name SrcSpanInfo
n [CName SrcSpanInfo]
cns    ->
        let k :: Int
k = [SrcSpan] -> Int
forall a. [a] -> 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 a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [(SrcSpan, String)] -> [CName SrcSpanInfo] -> EP ()
forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved ([SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) ([String] -> [(SrcSpan, String)])
-> [String] -> [(SrcSpan, String)]
forall a b. (a -> b) -> a -> b
$ String
"("String -> [String] -> [String]
forall a. a -> [a] -> [a]
:Int -> String -> [String]
forall a. Int -> a -> [a]
replicate (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2) String
"," [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
")"]) [CName SrcSpanInfo]
cns

instance ExactP ImportDecl where
  exactP :: ImportDecl SrcSpanInfo -> EP ()
exactP (ImportDecl SrcSpanInfo
l ModuleName SrcSpanInfo
mn Bool
qf Bool
src Bool
safe Maybe String
mpkg Maybe (ModuleName SrcSpanInfo)
mas Maybe (ImportSpecList SrcSpanInfo)
mispecs) = do
    String -> EP ()
printString String
"import"
    case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
     (SrcSpan
_:[SrcSpan]
pts) -> do
        [SrcSpan]
pts1 <- if Bool
src then
                 case [SrcSpan]
pts of
                  SrcSpan
x:SrcSpan
y:[SrcSpan]
pts' -> do
                     Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
x) String
"{-# SOURCE"
                     Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
y) String
"#-}"
                     [SrcSpan] -> EP [SrcSpan]
forall a. a -> EP a
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts'
                  [SrcSpan]
_ -> String -> EP [SrcSpan]
forall a. String -> EP a
errorEP String
"ExactP: ImportDecl is given too few srcInfoPoints"
                else [SrcSpan] -> EP [SrcSpan]
forall a. a -> EP a
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts
        [SrcSpan]
pts2 <- if Bool
safe then
                 case [SrcSpan]
pts1 of
                  SrcSpan
x:[SrcSpan]
pts' -> do
                     Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
x) String
"safe"
                     [SrcSpan] -> EP [SrcSpan]
forall a. a -> EP a
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts'
                  [SrcSpan]
_ -> String -> EP [SrcSpan]
forall a. String -> EP a
errorEP String
"ExactP: ImportDecl is given too few srcInfoPoints"
                else [SrcSpan] -> EP [SrcSpan]
forall a. a -> EP a
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts1
        [SrcSpan]
pts3 <- if Bool
qf then
                 case [SrcSpan]
pts2 of
                  SrcSpan
x:[SrcSpan]
pts' -> do
                     Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
x) String
"qualified"
                     [SrcSpan] -> EP [SrcSpan]
forall a. a -> EP a
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts'
                  [SrcSpan]
_ -> String -> EP [SrcSpan]
forall a. String -> EP a
errorEP String
"ExactP: ImportDecl is given too few srcInfoPoints"
                else [SrcSpan] -> EP [SrcSpan]
forall a. a -> EP a
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts2
        [SrcSpan]
pts4 <- case Maybe String
mpkg of
                Just String
pkg ->
                  case [SrcSpan]
pts3 of
                   SrcSpan
x:[SrcSpan]
pts' -> do
                      Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
x) (String -> EP ()) -> String -> EP ()
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. Show a => a -> String
show String
pkg
                      [SrcSpan] -> EP [SrcSpan]
forall a. a -> EP a
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts'
                   [SrcSpan]
_ -> String -> EP [SrcSpan]
forall a. String -> EP a
errorEP String
"ExactP: ImportDecl is given too few srcInfoPoints"
                Maybe String
_ -> [SrcSpan] -> EP [SrcSpan]
forall a. a -> EP a
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts3
        ModuleName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC ModuleName SrcSpanInfo
mn
        [SrcSpan]
_ <- case Maybe (ModuleName SrcSpanInfo)
mas of
                Just ModuleName SrcSpanInfo
as ->
                 case [SrcSpan]
pts4 of
                  SrcSpan
x:[SrcSpan]
pts' -> do
                     Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
x) String
"as"
                     ModuleName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC ModuleName SrcSpanInfo
as
                     [SrcSpan] -> EP [SrcSpan]
forall a. a -> EP a
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts'
                  [SrcSpan]
_ -> String -> EP [SrcSpan]
forall a. String -> EP a
errorEP String
"ExactP: ImportDecl is given too few srcInfoPoints"
                Maybe (ModuleName SrcSpanInfo)
_ -> [SrcSpan] -> EP [SrcSpan]
forall a. a -> EP a
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts4
        case Maybe (ImportSpecList SrcSpanInfo)
mispecs of
         Maybe (ImportSpecList SrcSpanInfo)
Nothing -> () -> EP ()
forall a. a -> EP a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
         Just ImportSpecList SrcSpanInfo
ispecs -> ImportSpecList SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC ImportSpecList SrcSpanInfo
ispecs
     [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: ImportDecl is given too few srcInfoPoints"

instance ExactP Module where
  exactP :: Module SrcSpanInfo -> EP ()
exactP Module SrcSpanInfo
mdl = case Module SrcSpanInfo
mdl of
    Module SrcSpanInfo
l Maybe (ModuleHead SrcSpanInfo)
mmh [ModulePragma SrcSpanInfo]
oss [ImportDecl SrcSpanInfo]
ids [Decl SrcSpanInfo]
decls -> do
        let ([SrcSpan]
oPts, [SrcSpan]
pts) = Int -> [SrcSpan] -> ([SrcSpan], [SrcSpan])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max ([ModulePragma SrcSpanInfo] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ModulePragma SrcSpanInfo]
oss Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
2) (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l)
        [SrcSpan] -> [ModulePragma SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
layoutList [SrcSpan]
oPts [ModulePragma SrcSpanInfo]
oss
        (ModuleHead SrcSpanInfo -> EP ())
-> Maybe (ModuleHead SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP ModuleHead SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (ModuleHead SrcSpanInfo)
mmh
        [(Pos, EP ())] -> [(Pos, EP ())] -> EP ()
printStreams (((SrcSpan, String) -> (Pos, EP ()))
-> [(SrcSpan, String)] -> [(Pos, EP ())]
forall a b. (a -> b) -> [a] -> [b]
map (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos (SrcSpan -> Pos)
-> (String -> EP ()) -> (SrcSpan, String) -> (Pos, EP ())
forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
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 l. ImportDecl l -> l
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann (ImportDecl SrcSpanInfo -> Pos)
-> (ImportDecl SrcSpanInfo -> EP ())
-> ImportDecl SrcSpanInfo
-> (Pos, EP ())
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
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 l. Decl l -> l
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann (Decl SrcSpanInfo -> Pos)
-> (Decl SrcSpanInfo -> EP ()) -> Decl SrcSpanInfo -> (Pos, EP ())
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Decl SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC) ([Decl SrcSpanInfo] -> [Decl SrcSpanInfo]
sepFunBinds [Decl SrcSpanInfo]
decls))
    XmlPage SrcSpanInfo
l ModuleName SrcSpanInfo
_mn [ModulePragma SrcSpanInfo]
oss XName SrcSpanInfo
xn [XAttr SrcSpanInfo]
attrs Maybe (Exp SrcSpanInfo)
mat [Exp SrcSpanInfo]
es  -> do
        let ([SrcSpan]
oPts, [SrcSpan]
pPts) = Int -> [SrcSpan] -> ([SrcSpan], [SrcSpan])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max ([ModulePragma SrcSpanInfo] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ModulePragma SrcSpanInfo]
oss Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
2) ([SrcSpan] -> ([SrcSpan], [SrcSpan]))
-> [SrcSpan] -> ([SrcSpan], [SrcSpan])
forall a b. (a -> b) -> a -> b
$ SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l
        case [SrcSpan]
pPts of
         [SrcSpan
a,SrcSpan
b,SrcSpan
c,SrcSpan
d,SrcSpan
e] -> do
            [SrcSpan] -> [ModulePragma SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
layoutList [SrcSpan]
oPts [ModulePragma SrcSpanInfo]
oss
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"<"
            XName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC XName SrcSpanInfo
xn
            (XAttr SrcSpanInfo -> EP ()) -> [XAttr SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ XAttr SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [XAttr SrcSpanInfo]
attrs
            (Exp SrcSpanInfo -> EP ()) -> Maybe (Exp SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (Exp SrcSpanInfo)
mat
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
">"
            (Exp SrcSpanInfo -> EP ()) -> [Exp SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [Exp SrcSpanInfo]
es
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
c) String
"</"
            Pos -> EP ()
printWhitespace (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
d)
            XName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP XName SrcSpanInfo
xn
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
e) String
">"
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Module: XmlPage is given wrong number of srcInfoPoints"
    XmlHybrid SrcSpanInfo
l Maybe (ModuleHead SrcSpanInfo)
mmh [ModulePragma SrcSpanInfo]
oss [ImportDecl SrcSpanInfo]
ids [Decl SrcSpanInfo]
decls XName SrcSpanInfo
xn [XAttr SrcSpanInfo]
attrs Maybe (Exp SrcSpanInfo)
mat [Exp SrcSpanInfo]
es -> do
        let ([SrcSpan]
oPts, [SrcSpan]
pts) = Int -> [SrcSpan] -> ([SrcSpan], [SrcSpan])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max ([ModulePragma SrcSpanInfo] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ModulePragma SrcSpanInfo]
oss Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
2) (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l)
        [SrcSpan] -> [ModulePragma SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
layoutList [SrcSpan]
oPts [ModulePragma SrcSpanInfo]
oss
        (ModuleHead SrcSpanInfo -> EP ())
-> Maybe (ModuleHead SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP ModuleHead SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (ModuleHead SrcSpanInfo)
mmh
        let ([SrcSpan]
dPts, [SrcSpan]
pPts) = Int -> [SrcSpan] -> ([SrcSpan], [SrcSpan])
forall a. Int -> [a] -> ([a], [a])
splitAt ([SrcSpan] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SrcSpan]
pts Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
5) [SrcSpan]
pts
        case [SrcSpan]
pPts of
         [SrcSpan
a,SrcSpan
b,SrcSpan
c,SrcSpan
d,SrcSpan
e] -> do
            [(Pos, EP ())] -> [(Pos, EP ())] -> EP ()
printStreams (((SrcSpan, String) -> (Pos, EP ()))
-> [(SrcSpan, String)] -> [(Pos, EP ())]
forall a b. (a -> b) -> [a] -> [b]
map (\(SrcSpan
p,String
s) -> (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
p, String -> EP ()
printString String
s)) ([(SrcSpan, String)] -> [(Pos, EP ())])
-> [(SrcSpan, String)] -> [(Pos, EP ())]
forall a b. (a -> b) -> a -> b
$ [SrcSpan] -> [(SrcSpan, String)]
lList [SrcSpan]
dPts)
                         ((ImportDecl SrcSpanInfo -> (Pos, EP ()))
-> [ImportDecl SrcSpanInfo] -> [(Pos, EP ())]
forall a b. (a -> b) -> [a] -> [b]
map (\ImportDecl SrcSpanInfo
i -> (SrcSpanInfo -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos (SrcSpanInfo -> Pos) -> SrcSpanInfo -> Pos
forall a b. (a -> b) -> a -> b
$ ImportDecl SrcSpanInfo -> SrcSpanInfo
forall l. ImportDecl l -> l
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann ImportDecl SrcSpanInfo
i, ImportDecl SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC ImportDecl SrcSpanInfo
i)) [ImportDecl SrcSpanInfo]
ids [(Pos, EP ())] -> [(Pos, EP ())] -> [(Pos, EP ())]
forall a. [a] -> [a] -> [a]
++ (Decl SrcSpanInfo -> (Pos, EP ()))
-> [Decl SrcSpanInfo] -> [(Pos, EP ())]
forall a b. (a -> b) -> [a] -> [b]
map (\Decl SrcSpanInfo
d' -> (SrcSpanInfo -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos (SrcSpanInfo -> Pos) -> SrcSpanInfo -> Pos
forall a b. (a -> b) -> a -> b
$ Decl SrcSpanInfo -> SrcSpanInfo
forall l. Decl l -> l
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann Decl SrcSpanInfo
d', Decl SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Decl SrcSpanInfo
d')) ([Decl SrcSpanInfo] -> [Decl SrcSpanInfo]
sepFunBinds [Decl SrcSpanInfo]
decls))

            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"<"
            XName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC XName SrcSpanInfo
xn
            (XAttr SrcSpanInfo -> EP ()) -> [XAttr SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ XAttr SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [XAttr SrcSpanInfo]
attrs
            (Exp SrcSpanInfo -> EP ()) -> Maybe (Exp SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (Exp SrcSpanInfo)
mat
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
">"
            (Exp SrcSpanInfo -> EP ()) -> [Exp SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [Exp SrcSpanInfo]
es
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
c) String
"</"
            Pos -> EP ()
printWhitespace (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
d)
            XName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP XName SrcSpanInfo
xn
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
e) String
">"
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Module: XmlHybrid is given wrong number of srcInfoPoints"

instance ExactP ModuleHead where
  exactP :: ModuleHead SrcSpanInfo -> EP ()
exactP (ModuleHead SrcSpanInfo
l ModuleName SrcSpanInfo
mn Maybe (WarningText SrcSpanInfo)
mwt Maybe (ExportSpecList SrcSpanInfo)
mess) =
    case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
     [SrcSpan
a,SrcSpan
b] -> do
        Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"module"
        ModuleName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC ModuleName SrcSpanInfo
mn
        (WarningText SrcSpanInfo -> EP ())
-> Maybe (WarningText SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP WarningText SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (WarningText SrcSpanInfo)
mwt
        (ExportSpecList SrcSpanInfo -> EP ())
-> Maybe (ExportSpecList SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP ExportSpecList SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (ExportSpecList SrcSpanInfo)
mess
        Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"where"
     [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: ModuleHead is given wrong number of srcInfoPoints"

instance ExactP ModulePragma where
  exactP :: ModulePragma SrcSpanInfo -> EP ()
exactP ModulePragma SrcSpanInfo
op = case ModulePragma SrcSpanInfo
op of
    LanguagePragma   SrcSpanInfo
l [Name SrcSpanInfo]
ns       ->
        let pts :: [SrcSpan]
pts = SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l
            k :: Int
k = [Name SrcSpanInfo] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Name SrcSpanInfo]
ns Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 -- number of commas
            m :: Int
m = [SrcSpan] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SrcSpan]
pts Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2 -- number of virtual semis, likely 0
         in [(SrcSpan, String)] -> [Name SrcSpanInfo] -> EP ()
forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved ([SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SrcSpan]
pts (String
"{-# LANGUAGE"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
k String
"," [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
m String
"" [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"#-}"])) [Name SrcSpanInfo]
ns
    OptionsPragma    SrcSpanInfo
l Maybe Tool
mt String
str   ->
        let k :: Int
k = [SrcSpan] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l)
            -- We strip out a leading space in the lexer unless the pragma
            -- starts with a newline.
            addSpace :: ShowS
addSpace xs :: String
xs@(Char
'\n':String
_) = String
xs
            addSpace String
xs = Char
' 'Char -> ShowS
forall a. a -> [a] -> [a]
:String
xs
            opstr :: String
opstr = String
"{-# OPTIONS" String -> ShowS
forall a. [a] -> [a] -> [a]
++ case Maybe Tool
mt of { Just Tool
t -> String
"_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Tool -> String
forall a. Show a => a -> String
show Tool
t ; Maybe Tool
_ -> String
"" } String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
addSpace String
str
         in SrcSpanInfo -> [String] -> EP ()
printPoints SrcSpanInfo
l ([String] -> EP ()) -> [String] -> EP ()
forall a b. (a -> b) -> a -> b
$ String
opstr String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Int -> String -> [String]
forall a. Int -> a -> [a]
replicate (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2) String
"" [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"#-}"]
    AnnModulePragma  SrcSpanInfo
l Annotation SrcSpanInfo
ann'      ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
_,SrcSpan
b] -> do
            String -> EP ()
printString String
"{-# ANN"
            Annotation SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Annotation SrcSpanInfo
ann'
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"#-}"
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: ModulePragma: AnnPragma is given wrong number of srcInfoPoints"

instance ExactP WarningText where
    exactP :: WarningText SrcSpanInfo -> EP ()
exactP (DeprText SrcSpanInfo
l String
str) = SrcSpanInfo -> [String] -> EP ()
printPoints SrcSpanInfo
l [String
"{-# DEPRECATED", String
str, String
"#-}"]
    exactP (WarnText SrcSpanInfo
l String
str) = SrcSpanInfo -> [String] -> EP ()
printPoints SrcSpanInfo
l [String
"{-# WARNING",    String
str, String
"#-}"]

instance ExactP Assoc where
  exactP :: Assoc SrcSpanInfo -> EP ()
exactP Assoc SrcSpanInfo
a = case Assoc SrcSpanInfo
a of
    AssocNone  SrcSpanInfo
_ -> String -> EP ()
printString String
"infix"
    AssocLeft  SrcSpanInfo
_ -> String -> EP ()
printString String
"infixl"
    AssocRight SrcSpanInfo
_ -> String -> EP ()
printString String
"infixr"

instance ExactP DataOrNew where
  exactP :: DataOrNew SrcSpanInfo -> EP ()
exactP (DataType SrcSpanInfo
_) = String -> EP ()
printString String
"data"
  exactP (NewType  SrcSpanInfo
_) = String -> EP ()
printString String
"newtype"

instance ExactP TypeEqn where
  exactP :: TypeEqn SrcSpanInfo -> EP ()
exactP (TypeEqn SrcSpanInfo
l Type SrcSpanInfo
t1 Type SrcSpanInfo
t2) =
    case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
      [SrcSpan
a] -> do
         Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t1
         Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"="
         Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t2
      [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: TypeEqn is given wrong number of srcInfoPoints"

instance ExactP InjectivityInfo where
  exactP :: InjectivityInfo SrcSpanInfo -> EP ()
exactP (InjectivityInfo SrcSpanInfo
l Name SrcSpanInfo
to [Name SrcSpanInfo]
from) =
    case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
      SrcSpan
a:SrcSpan
b:[SrcSpan]
_ -> do
        Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"|"
        Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Name SrcSpanInfo
to
        Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"->"
        (Name SrcSpanInfo -> EP ()) -> [Name SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [Name SrcSpanInfo]
from
      [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: InjectivityInfo given wrong number of srcInfoPoints"

instance ExactP ResultSig where
  exactP :: ResultSig SrcSpanInfo -> EP ()
exactP (KindSig SrcSpanInfo
l Type SrcSpanInfo
k) =
    case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
      SrcSpan
a:[SrcSpan]
_ -> do
        Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"::"
        Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
k
      [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: ResultSig given wrong number of srcInfoPoints"
  exactP (TyVarSig SrcSpanInfo
l TyVarBind SrcSpanInfo
tv) =
    case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
      SrcSpan
a:[SrcSpan]
_ -> do
        Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"="
        TyVarBind SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC TyVarBind SrcSpanInfo
tv
      [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: ResultSig given wrong number of srcInfoPoints"


instance ExactP Decl where
  exactP :: Decl SrcSpanInfo -> EP ()
exactP Decl SrcSpanInfo
decl = case Decl SrcSpanInfo
decl of
    TypeDecl     SrcSpanInfo
l DeclHead SrcSpanInfo
dh Type SrcSpanInfo
t      ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
a,SrcSpan
b] -> do
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"type"
            DeclHead SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC DeclHead SrcSpanInfo
dh
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"="
            Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: TypeDecl is given wrong number of srcInfoPoints"
    TypeFamDecl  SrcSpanInfo
l DeclHead SrcSpanInfo
dh Maybe (ResultSig SrcSpanInfo)
mk Maybe (InjectivityInfo SrcSpanInfo)
mi   ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         SrcSpan
a:SrcSpan
b:[SrcSpan]
_ -> do
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"type"
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"family"
            DeclHead SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC DeclHead SrcSpanInfo
dh
            (ResultSig SrcSpanInfo -> EP ())
-> Maybe (ResultSig SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP ResultSig SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (ResultSig SrcSpanInfo)
mk
            (InjectivityInfo SrcSpanInfo -> EP ())
-> Maybe (InjectivityInfo SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP InjectivityInfo SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (InjectivityInfo SrcSpanInfo)
mi
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: TypeFamDecl is given wrong number of srcInfoPoints"
    ClosedTypeFamDecl  SrcSpanInfo
l DeclHead SrcSpanInfo
dh Maybe (ResultSig SrcSpanInfo)
mk Maybe (InjectivityInfo SrcSpanInfo)
mi [TypeEqn SrcSpanInfo]
eqns ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         SrcSpan
a:SrcSpan
b:SrcSpan
c:[SrcSpan]
_ -> do
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"type"
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"family"
            DeclHead SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC DeclHead SrcSpanInfo
dh
            (ResultSig SrcSpanInfo -> EP ())
-> Maybe (ResultSig SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP ResultSig SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (ResultSig SrcSpanInfo)
mk
            (InjectivityInfo SrcSpanInfo -> EP ())
-> Maybe (InjectivityInfo SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP InjectivityInfo SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (InjectivityInfo SrcSpanInfo)
mi
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
c) String
"where"
            (TypeEqn SrcSpanInfo -> EP ()) -> [TypeEqn SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ TypeEqn SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP [TypeEqn SrcSpanInfo]
eqns
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: ClosedTypeFamDecl is given wrong number of srcInfoPoints"
    DataDecl     SrcSpanInfo
l DataOrNew SrcSpanInfo
dn Maybe (Context SrcSpanInfo)
mctxt DeclHead SrcSpanInfo
dh [QualConDecl SrcSpanInfo]
constrs [Deriving SrcSpanInfo]
mder -> do
        DataOrNew SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP DataOrNew SrcSpanInfo
dn
        (Context SrcSpanInfo -> EP ())
-> Maybe (Context SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Context SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (Context SrcSpanInfo)
mctxt
        DeclHead SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC DeclHead SrcSpanInfo
dh
        -- the next line works for empty data types since the srcInfoPoints will be empty then
        [(SrcSpan, String)] -> [QualConDecl SrcSpanInfo] -> EP ()
forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved ([SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) (String
"="String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
forall a. a -> [a]
repeat String
"|")) [QualConDecl SrcSpanInfo]
constrs
        (Deriving SrcSpanInfo -> EP ()) -> [Deriving SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Deriving SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [Deriving SrcSpanInfo]
mder
    GDataDecl    SrcSpanInfo
l DataOrNew SrcSpanInfo
dn Maybe (Context SrcSpanInfo)
mctxt DeclHead SrcSpanInfo
dh Maybe (Type SrcSpanInfo)
mk [GadtDecl SrcSpanInfo]
gds [Deriving SrcSpanInfo]
mder -> do
        let pts :: [SrcSpan]
pts = SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l
        DataOrNew SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP DataOrNew SrcSpanInfo
dn
        (Context SrcSpanInfo -> EP ())
-> Maybe (Context SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Context SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (Context SrcSpanInfo)
mctxt
        DeclHead SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC DeclHead SrcSpanInfo
dh
        [SrcSpan]
pts1 <- case Maybe (Type SrcSpanInfo)
mk of
                Maybe (Type SrcSpanInfo)
Nothing -> [SrcSpan] -> EP [SrcSpan]
forall a. a -> EP a
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts
                Just Type SrcSpanInfo
kd -> case [SrcSpan]
pts of
                            SrcSpan
p:[SrcSpan]
pts' -> do
                               Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
p) String
"::"
                               Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
kd
                               [SrcSpan] -> EP [SrcSpan]
forall a. a -> EP a
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts'
                            [SrcSpan]
_ -> String -> EP [SrcSpan]
forall a. String -> EP a
errorEP String
"ExactP: Decl: GDataDecl is given too few srcInfoPoints"
        case [SrcSpan]
pts1 of
         SrcSpan
x:[SrcSpan]
pts' -> do
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
x) String
"where"
            [SrcSpan] -> [GadtDecl SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
layoutList [SrcSpan]
pts' [GadtDecl SrcSpanInfo]
gds
            (Deriving SrcSpanInfo -> EP ()) -> [Deriving SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Deriving SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [Deriving SrcSpanInfo]
mder
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: GDataDecl is given too few srcInfoPoints"
    DataFamDecl  SrcSpanInfo
l Maybe (Context SrcSpanInfo)
mctxt DeclHead SrcSpanInfo
dh Maybe (ResultSig SrcSpanInfo)
mk -> do
        String -> EP ()
printString String
"data"
        (Context SrcSpanInfo -> EP ())
-> Maybe (Context SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Context SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (Context SrcSpanInfo)
mctxt
        DeclHead SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC DeclHead SrcSpanInfo
dh
        (ResultSig SrcSpanInfo -> EP ())
-> Maybe (ResultSig SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP (\ResultSig SrcSpanInfo
kd -> Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos ([SrcSpan] -> SrcSpan
forall a. HasCallStack => [a] -> a
head (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l))) String
"::" EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ResultSig SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC ResultSig SrcSpanInfo
kd) Maybe (ResultSig SrcSpanInfo)
mk
    TypeInsDecl  SrcSpanInfo
l Type SrcSpanInfo
t1 Type SrcSpanInfo
t2 ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
_,SrcSpan
b,SrcSpan
c] -> do
            String -> EP ()
printString String
"type"
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"instance"
            Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t1
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
c) String
"="
            Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t2
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: TypeInsDecl is given wrong number of srcInfoPoints"
    DataInsDecl  SrcSpanInfo
l DataOrNew SrcSpanInfo
dn Type SrcSpanInfo
t [QualConDecl SrcSpanInfo]
constrs [Deriving SrcSpanInfo]
mder    ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         SrcSpan
p:[SrcSpan]
pts -> do
            DataOrNew SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP DataOrNew SrcSpanInfo
dn
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
p) String
"instance"
            Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t
            [(SrcSpan, String)] -> [QualConDecl SrcSpanInfo] -> EP ()
forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved ([SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SrcSpan]
pts (String
"="String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
forall a. a -> [a]
repeat String
"|")) [QualConDecl SrcSpanInfo]
constrs
            (Deriving SrcSpanInfo -> EP ()) -> [Deriving SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Deriving SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [Deriving SrcSpanInfo]
mder
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: DataInsDecl is given too few srcInfoPoints"
    GDataInsDecl SrcSpanInfo
l DataOrNew SrcSpanInfo
dn Type SrcSpanInfo
t Maybe (Type SrcSpanInfo)
mk [GadtDecl SrcSpanInfo]
gds [Deriving SrcSpanInfo]
mder     ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         SrcSpan
p:[SrcSpan]
pts -> do
            DataOrNew SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP DataOrNew SrcSpanInfo
dn
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
p) String
"instance"
            Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t
            [SrcSpan]
pts1 <- case Maybe (Type SrcSpanInfo)
mk of
                    Maybe (Type SrcSpanInfo)
Nothing -> [SrcSpan] -> EP [SrcSpan]
forall a. a -> EP a
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts
                    Just Type SrcSpanInfo
kd -> case [SrcSpan]
pts of
                                SrcSpan
p':[SrcSpan]
pts' -> do
                                    Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
p') String
"::"
                                    Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
kd
                                    [SrcSpan] -> EP [SrcSpan]
forall a. a -> EP a
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts'
                                [SrcSpan]
_ -> String -> EP [SrcSpan]
forall a. String -> EP a
errorEP String
"ExactP: Decl: GDataInsDecl is given too few srcInfoPoints"
            case [SrcSpan]
pts1 of
             SrcSpan
x:[SrcSpan]
pts' -> do
                Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
x) String
"where"
                [SrcSpan] -> [GadtDecl SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
layoutList [SrcSpan]
pts' [GadtDecl SrcSpanInfo]
gds
                (Deriving SrcSpanInfo -> EP ()) -> [Deriving SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Deriving SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [Deriving SrcSpanInfo]
mder
             [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: GDataInsDecl is given too few srcInfoPoints"
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: GDataInsDecl is given too few srcInfoPoints"
    ClassDecl    SrcSpanInfo
l Maybe (Context SrcSpanInfo)
mctxt DeclHead SrcSpanInfo
dh [FunDep SrcSpanInfo]
fds Maybe [ClassDecl SrcSpanInfo]
mcds    ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         SrcSpan
_:[SrcSpan]
pts -> do
            String -> EP ()
printString String
"class"
            (Context SrcSpanInfo -> EP ())
-> Maybe (Context SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Context SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (Context SrcSpanInfo)
mctxt
            DeclHead SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC DeclHead SrcSpanInfo
dh
            [SrcSpan]
_ <- case [FunDep SrcSpanInfo]
fds of
                    [] -> [SrcSpan] -> EP [SrcSpan]
forall a. a -> EP a
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts
                    [FunDep SrcSpanInfo]
_  -> do
                      let ([SrcSpan]
pts1, [SrcSpan]
pts2) = Int -> [SrcSpan] -> ([SrcSpan], [SrcSpan])
forall a. Int -> [a] -> ([a], [a])
splitAt ([FunDep SrcSpanInfo] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FunDep SrcSpanInfo]
fds) [SrcSpan]
pts
                      [(SrcSpan, String)] -> [FunDep SrcSpanInfo] -> EP ()
forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved ([SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SrcSpan]
pts1 (String
"|"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:String -> [String]
forall a. a -> [a]
repeat String
",")) [FunDep SrcSpanInfo]
fds
                      [SrcSpan] -> EP [SrcSpan]
forall a. a -> EP a
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts2
            ([ClassDecl SrcSpanInfo] -> EP ())
-> Maybe [ClassDecl SrcSpanInfo] -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP (\[ClassDecl SrcSpanInfo]
cds ->
                case [SrcSpan]
pts of
                 SrcSpan
p:[SrcSpan]
pts' -> do
                    Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
p) String
"where"
                    [SrcSpan] -> [ClassDecl SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
layoutList [SrcSpan]
pts' ([ClassDecl SrcSpanInfo] -> EP ())
-> [ClassDecl SrcSpanInfo] -> EP ()
forall a b. (a -> b) -> a -> b
$ [ClassDecl SrcSpanInfo] -> [ClassDecl SrcSpanInfo]
sepClassFunBinds [ClassDecl SrcSpanInfo]
cds
                 [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: ClassDecl is given too few srcInfoPoints"
                ) Maybe [ClassDecl SrcSpanInfo]
mcds
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: ClassDecl is given too few srcInfoPoints"
    InstDecl     SrcSpanInfo
l Maybe (Overlap SrcSpanInfo)
movlp InstRule SrcSpanInfo
ih Maybe [InstDecl SrcSpanInfo]
mids        ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         SrcSpan
_:[SrcSpan]
pts -> do
            String -> EP ()
printString String
"instance"
            (Overlap SrcSpanInfo -> EP ())
-> Maybe (Overlap SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Overlap SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (Overlap SrcSpanInfo)
movlp
            InstRule SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC InstRule SrcSpanInfo
ih
            ([InstDecl SrcSpanInfo] -> EP ())
-> Maybe [InstDecl SrcSpanInfo] -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP (\[InstDecl SrcSpanInfo]
ids -> do
                let (SrcSpan
p:[SrcSpan]
pts') = [SrcSpan]
pts
                Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
p) String
"where"
                [SrcSpan] -> [InstDecl SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
layoutList [SrcSpan]
pts' ([InstDecl SrcSpanInfo] -> EP ())
-> [InstDecl SrcSpanInfo] -> EP ()
forall a b. (a -> b) -> a -> b
$ [InstDecl SrcSpanInfo] -> [InstDecl SrcSpanInfo]
sepInstFunBinds [InstDecl SrcSpanInfo]
ids
                ) Maybe [InstDecl SrcSpanInfo]
mids
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: InstDecl is given too few srcInfoPoints"
    DerivDecl    SrcSpanInfo
l Maybe (DerivStrategy SrcSpanInfo)
mds Maybe (Overlap SrcSpanInfo)
movlp InstRule SrcSpanInfo
ih             ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
_,SrcSpan
b] -> do
            String -> EP ()
printString String
"deriving"
            (DerivStrategy SrcSpanInfo -> EP ())
-> Maybe (DerivStrategy SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP DerivStrategy SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (DerivStrategy SrcSpanInfo)
mds
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"instance"
            (Overlap SrcSpanInfo -> EP ())
-> Maybe (Overlap SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Overlap SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (Overlap SrcSpanInfo)
movlp
            InstRule SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC InstRule SrcSpanInfo
ih
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: DerivDecl is given wrong number of srcInfoPoints"
    InfixDecl    SrcSpanInfo
l Assoc SrcSpanInfo
assoc Maybe Int
mprec [Op SrcSpanInfo]
ops      -> do
        let pts :: [SrcSpan]
pts = SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l
        Assoc SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Assoc SrcSpanInfo
assoc
        [SrcSpan]
pts1 <- case Maybe Int
mprec of
                Maybe Int
Nothing -> [SrcSpan] -> EP [SrcSpan]
forall a. a -> EP a
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts
                Just Int
prec ->
                    case [SrcSpan]
pts of
                     SrcSpan
p:[SrcSpan]
pts' -> do
                        Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
p) (Int -> String
forall a. Show a => a -> String
show Int
prec)
                        [SrcSpan] -> EP [SrcSpan]
forall a. a -> EP a
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts'
                     [SrcSpan]
_ -> String -> EP [SrcSpan]
forall a. String -> EP a
errorEP String
"ExactP: Decl: InfixDecl is given too few srcInfoPoints"
        [(SrcSpan, String)] -> [Op SrcSpanInfo] -> EP ()
forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved' ([SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SrcSpan]
pts1 (String -> [String]
forall a. a -> [a]
repeat String
",")) [Op SrcSpanInfo]
ops
    DefaultDecl  SrcSpanInfo
l [Type SrcSpanInfo]
ts   ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         SrcSpan
_:[SrcSpan]
pts -> do
            String -> EP ()
printString String
"default"
            [(SrcSpan, String)] -> [Type SrcSpanInfo] -> EP ()
forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved ([SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([SrcSpan] -> [SrcSpan]
forall a. HasCallStack => [a] -> [a]
init [SrcSpan]
pts) (String
"("String -> [String] -> [String]
forall a. a -> [a] -> [a]
:String -> [String]
forall a. a -> [a]
repeat String
",")) [Type SrcSpanInfo]
ts
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos ([SrcSpan] -> SrcSpan
forall a. HasCallStack => [a] -> a
last [SrcSpan]
pts)) String
")"
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: DefaultDecl is given too few srcInfoPoints"
    SpliceDecl   SrcSpanInfo
_ Exp SrcSpanInfo
spl  -> Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Exp SrcSpanInfo
spl
    TSpliceDecl  SrcSpanInfo
_ Exp SrcSpanInfo
spl  -> Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Exp SrcSpanInfo
spl
    TypeSig      SrcSpanInfo
l [Name SrcSpanInfo]
ns Type SrcSpanInfo
t -> do
        let pts :: [SrcSpan]
pts = SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l
        [(SrcSpan, String)] -> [Name SrcSpanInfo] -> EP ()
forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved' ([SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SrcSpan]
pts (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate ([SrcSpan] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SrcSpan]
pts Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) String
"," [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"::"])) [Name SrcSpanInfo]
ns
        Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t
    PatSynSig SrcSpanInfo
l [Name SrcSpanInfo]
ns Maybe [TyVarBind SrcSpanInfo]
dh Maybe (Context SrcSpanInfo)
c1 Maybe [TyVarBind SrcSpanInfo]
_ Maybe (Context SrcSpanInfo)
c2 Type SrcSpanInfo
t -> do
        let (SrcSpan
pat:[SrcSpan]
pts) = SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l
        Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
pat) String
"pattern"
        [(SrcSpan, String)] -> [Name SrcSpanInfo] -> EP ()
forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved' ([SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SrcSpan]
pts (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate ([Name SrcSpanInfo] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Name SrcSpanInfo]
ns Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) String
"," [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"::"])) [Name SrcSpanInfo]
ns
        case Maybe [TyVarBind SrcSpanInfo]
dh of
          Maybe [TyVarBind SrcSpanInfo]
Nothing -> () -> EP ()
forall a. a -> EP a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Just [TyVarBind SrcSpanInfo]
tvs ->
            -- (length ns - 1) commas + 1 for "::"
            case Int -> [SrcSpan] -> [SrcSpan]
forall a. Int -> [a] -> [a]
drop ([Name SrcSpanInfo] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Name SrcSpanInfo]
ns) [SrcSpan]
pts of
              (SrcSpan
a:SrcSpan
b:[SrcSpan]
_) -> do
                    Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"forall"
                    (TyVarBind SrcSpanInfo -> EP ())
-> [TyVarBind SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ TyVarBind SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [TyVarBind SrcSpanInfo]
tvs
                    Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"."
              [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP (String
"ExactP: Decl: PatSynSig: Forall: is given too few srcInfoPoints" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [SrcSpan] -> String
forall a. Show a => a -> String
show [SrcSpan]
pts String -> ShowS
forall a. [a] -> [a] -> [a]
++ [SrcSpan] -> String
forall a. Show a => a -> String
show (Int -> [SrcSpan] -> [SrcSpan]
forall a. Int -> [a] -> [a]
drop ([Name SrcSpanInfo] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Name SrcSpanInfo]
ns Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [SrcSpan]
pts))
        (Context SrcSpanInfo -> EP ())
-> Maybe (Context SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Context SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (Context SrcSpanInfo)
c1
        (Context SrcSpanInfo -> EP ())
-> Maybe (Context SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Context SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (Context SrcSpanInfo)
c2
        Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t
    FunBind      SrcSpanInfo
_ [Match SrcSpanInfo]
ms   -> (Match SrcSpanInfo -> EP ()) -> [Match SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Match SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [Match SrcSpanInfo]
ms
    PatBind      SrcSpanInfo
l Pat SrcSpanInfo
p Rhs SrcSpanInfo
rhs Maybe (Binds SrcSpanInfo)
mbs -> do
        let pts :: [SrcSpan]
pts = SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l
        Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Pat SrcSpanInfo
p
        Rhs SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Rhs SrcSpanInfo
rhs
        (Binds SrcSpanInfo -> EP ()) -> Maybe (Binds SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP (\Binds SrcSpanInfo
bs -> Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos ([SrcSpan] -> SrcSpan
forall a. HasCallStack => [a] -> a
head [SrcSpan]
pts)) String
"where" EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Binds SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Binds SrcSpanInfo
bs) Maybe (Binds SrcSpanInfo)
mbs
    PatSyn SrcSpanInfo
l Pat SrcSpanInfo
lhs Pat SrcSpanInfo
rhs PatternSynDirection SrcSpanInfo
dir ->
      case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
        [SrcSpan
pat,SrcSpan
sepPos] -> do
          let sep :: String
sep = case PatternSynDirection SrcSpanInfo
dir of
                      PatternSynDirection SrcSpanInfo
ImplicitBidirectional     -> String
"="
                      ExplicitBidirectional SrcSpanInfo
_ [Decl SrcSpanInfo]
_ -> String
"<-"
                      PatternSynDirection SrcSpanInfo
Unidirectional            -> String
"<-"
          Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
pat) String
"pattern"
          Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Pat SrcSpanInfo
lhs
          Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
sepPos) String
sep
          Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Pat SrcSpanInfo
rhs
          case PatternSynDirection SrcSpanInfo
dir of
            ExplicitBidirectional SrcSpanInfo
bl [Decl SrcSpanInfo]
ds -> do
              case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
bl of
                (SrcSpan
w:[SrcSpan]
pts) -> do
                  Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
w) String
"where"
                  [SrcSpan] -> [Decl SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
layoutList [SrcSpan]
pts [Decl SrcSpanInfo]
ds
                [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: PaySyn: ExplicitBidirectional is given too few srcInfoPoints"
            PatternSynDirection SrcSpanInfo
_ -> () -> EP ()
forall a. a -> EP a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: PatSyn is given too few srcInfoPoints"
    ForImp       SrcSpanInfo
l CallConv SrcSpanInfo
cc Maybe (Safety SrcSpanInfo)
msf Maybe String
mstr Name SrcSpanInfo
n Type SrcSpanInfo
t   ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         SrcSpan
_:SrcSpan
b:[SrcSpan]
pts -> do
            String -> EP ()
printString String
"foreign"
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"import"
            CallConv SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC CallConv SrcSpanInfo
cc
            (Safety SrcSpanInfo -> EP ())
-> Maybe (Safety SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Safety SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (Safety SrcSpanInfo)
msf
            [SrcSpan]
pts1 <- case Maybe String
mstr of
                      Maybe String
Nothing -> [SrcSpan] -> EP [SrcSpan]
forall a. a -> EP a
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts
                      Just String
str -> case [SrcSpan]
pts of
                                   SrcSpan
x:[SrcSpan]
pts' -> do
                                      Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
x) (ShowS
forall a. Show a => a -> String
show String
str)
                                      [SrcSpan] -> EP [SrcSpan]
forall a. a -> EP a
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts'
                                   [SrcSpan]
_ -> String -> EP [SrcSpan]
forall a. String -> EP a
errorEP String
"ExactP: Decl: ForImp is given too few srcInfoPoints"
            case [SrcSpan]
pts1 of
             SrcSpan
y:[SrcSpan]
_ -> do
                Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Name SrcSpanInfo
n
                Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
y) String
"::"
                Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t
             [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: ForImp is given too few srcInfoPoints"
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: ForImp is given too few srcInfoPoints"
    ForExp       SrcSpanInfo
l CallConv SrcSpanInfo
cc Maybe String
mstr Name SrcSpanInfo
n Type SrcSpanInfo
t      ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         SrcSpan
_:SrcSpan
b:[SrcSpan]
pts -> do
            String -> EP ()
printString String
"foreign"
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"export"
            CallConv SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC CallConv SrcSpanInfo
cc
            [SrcSpan]
pts1 <- case Maybe String
mstr of
                      Maybe String
Nothing -> [SrcSpan] -> EP [SrcSpan]
forall a. a -> EP a
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts
                      Just String
str -> case [SrcSpan]
pts of
                                   SrcSpan
x:[SrcSpan]
pts' -> do
                                      Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
x) (ShowS
forall a. Show a => a -> String
show String
str)
                                      [SrcSpan] -> EP [SrcSpan]
forall a. a -> EP a
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts'
                                   [SrcSpan]
_ -> String -> EP [SrcSpan]
forall a. String -> EP a
errorEP String
"ExactP: Decl: ForExp is given too few srcInfoPoints"
            case [SrcSpan]
pts1 of
             SrcSpan
y:[SrcSpan]
_ -> do
                Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Name SrcSpanInfo
n
                Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
y) String
"::"
                Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t
             [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: ForExp is given too few srcInfoPoints"
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: ForExp is given too few srcInfoPoints"
    RulePragmaDecl   SrcSpanInfo
l [Rule SrcSpanInfo]
rs   ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
_,SrcSpan
b] -> do
            String -> EP ()
printString String
"{-# RULES"
            (Rule SrcSpanInfo -> EP ()) -> [Rule SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Rule SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [Rule SrcSpanInfo]
rs
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"#-}"
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: RulePragmaDecl is given too few srcInfoPoints"
    DeprPragmaDecl   SrcSpanInfo
l [([Name SrcSpanInfo], String)]
nstrs ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         SrcSpan
_:[SrcSpan]
pts -> do
            String -> EP ()
printString String
"{-# DEPRECATED"
            [Pos] -> [([Name SrcSpanInfo], String)] -> EP ()
printWarndeprs ((SrcSpan -> Pos) -> [SrcSpan] -> [Pos]
forall a b. (a -> b) -> [a] -> [b]
map SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos ([SrcSpan] -> [SrcSpan]
forall a. HasCallStack => [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. HasCallStack => [a] -> a
last [SrcSpan]
pts)) String
"#-}"
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: DeprPragmaDecl is given too few srcInfoPoints"
    WarnPragmaDecl   SrcSpanInfo
l [([Name SrcSpanInfo], String)]
nstrs ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         SrcSpan
_:[SrcSpan]
pts -> do
            String -> EP ()
printString String
"{-# WARNING"
            [Pos] -> [([Name SrcSpanInfo], String)] -> EP ()
printWarndeprs ((SrcSpan -> Pos) -> [SrcSpan] -> [Pos]
forall a b. (a -> b) -> [a] -> [b]
map SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos ([SrcSpan] -> [SrcSpan]
forall a. HasCallStack => [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. HasCallStack => [a] -> a
last [SrcSpan]
pts)) String
"#-}"
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: WarnPragmaDecl is given too few srcInfoPoints"
    InlineSig        SrcSpanInfo
l Bool
inl Maybe (Activation SrcSpanInfo)
mact QName SrcSpanInfo
qn    ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
_,SrcSpan
b] -> do
            String -> EP ()
printString (String -> EP ()) -> String -> EP ()
forall a b. (a -> b) -> a -> b
$ if Bool
inl then String
"{-# INLINE" else String
"{-# NOINLINE"
            (Activation SrcSpanInfo -> EP ())
-> Maybe (Activation SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Activation SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (Activation SrcSpanInfo)
mact
            QName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC QName SrcSpanInfo
qn
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"#-}"
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: InlineSig is given wrong number of srcInfoPoints"
    InlineConlikeSig SrcSpanInfo
l Maybe (Activation SrcSpanInfo)
mact QName SrcSpanInfo
qn    ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
_,SrcSpan
b] -> do
            String -> EP ()
printString String
"{-# INLINE CONLIKE"
            (Activation SrcSpanInfo -> EP ())
-> Maybe (Activation SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Activation SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (Activation SrcSpanInfo)
mact
            QName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC QName SrcSpanInfo
qn
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"#-}"
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: InlineConlikeSig is given wrong number of srcInfoPoints"
    SpecSig          SrcSpanInfo
l Maybe (Activation SrcSpanInfo)
mact QName SrcSpanInfo
qn [Type SrcSpanInfo]
ts ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         SrcSpan
_:[SrcSpan]
pts -> do
            String -> EP ()
printString String
"{-# SPECIALISE"
            (Activation SrcSpanInfo -> EP ())
-> Maybe (Activation SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Activation SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (Activation SrcSpanInfo)
mact
            QName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC QName SrcSpanInfo
qn
            [(SrcSpan, String)] -> [Type SrcSpanInfo] -> EP ()
forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved ([SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SrcSpan]
pts (String
"::" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Int -> String -> [String]
forall a. Int -> a -> [a]
replicate ([SrcSpan] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SrcSpan]
pts Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) String
"," [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"#-}"])) [Type SrcSpanInfo]
ts
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: SpecSig is given too few srcInfoPoints"
    SpecInlineSig    SrcSpanInfo
l Bool
b Maybe (Activation SrcSpanInfo)
mact QName SrcSpanInfo
qn [Type SrcSpanInfo]
ts ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         SrcSpan
_:[SrcSpan]
pts -> do
            String -> EP ()
printString (String -> EP ()) -> String -> EP ()
forall a b. (a -> b) -> a -> b
$ String
"{-# SPECIALISE " String -> ShowS
forall a. [a] -> [a] -> [a]
++ if Bool
b then String
"INLINE" else String
"NOINLINE"
            (Activation SrcSpanInfo -> EP ())
-> Maybe (Activation SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Activation SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (Activation SrcSpanInfo)
mact
            QName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC QName SrcSpanInfo
qn
            [(SrcSpan, String)] -> [Type SrcSpanInfo] -> EP ()
forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved ([SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SrcSpan]
pts (String
"::" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Int -> String -> [String]
forall a. Int -> a -> [a]
replicate ([SrcSpan] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SrcSpan]
pts Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) String
"," [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"#-}"])) [Type SrcSpanInfo]
ts
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: SpecInlineSig is given too few srcInfoPoints"
    InstSig          SrcSpanInfo
l InstRule SrcSpanInfo
ih     ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
_,SrcSpan
b,SrcSpan
c] -> do
            String -> EP ()
printString String
"{-# SPECIALISE"
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"instance"
            InstRule SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC InstRule SrcSpanInfo
ih
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
c) String
"#-}"
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: InstSig is given wrong number of srcInfoPoints"
    AnnPragma       SrcSpanInfo
l Annotation SrcSpanInfo
ann'       ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
_,SrcSpan
b] -> do
            String -> EP ()
printString String
"{-# ANN"
            Annotation SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Annotation SrcSpanInfo
ann'
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"#-}"
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: AnnPragma is given wrong number of srcInfoPoints"
    MinimalPragma       SrcSpanInfo
l Maybe (BooleanFormula SrcSpanInfo)
b      ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
_,SrcSpan
b'] -> do
            String -> EP ()
printString String
"{-# MINIMAL"
            (BooleanFormula SrcSpanInfo -> EP ())
-> Maybe (BooleanFormula SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP BooleanFormula SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (BooleanFormula SrcSpanInfo)
b
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b') String
"#-}"
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: MinimalPragma is given wrong number of srcInfoPoints"
    RoleAnnotDecl SrcSpanInfo
l QName SrcSpanInfo
ty [Role SrcSpanInfo]
roles ->
      case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         (SrcSpan
t:SrcSpan
r:[SrcSpan]
_) -> do
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
t)  String
"type"
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
r)  String
"role"
            QName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC QName SrcSpanInfo
ty
            (Role SrcSpanInfo -> EP ()) -> [Role SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Role SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [Role SrcSpanInfo]
roles
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: RoleAnnotDecl is given wrong number of srcInfoPoints"
    CompletePragma SrcSpanInfo
l [Name SrcSpanInfo]
cls Maybe (QName SrcSpanInfo)
opt_ts ->
      case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
        (SrcSpan
t:[SrcSpan]
rs) -> do
          let ([SrcSpan]
cls_s, [SrcSpan]
rs') = Int -> [SrcSpan] -> ([SrcSpan], [SrcSpan])
forall a. Int -> [a] -> ([a], [a])
splitAt ([Name SrcSpanInfo] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Name SrcSpanInfo]
cls Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [SrcSpan]
rs
          Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
t)String
"{-# COMPLETE"
          [(SrcSpan, String)] -> [Name SrcSpanInfo] -> EP ()
forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved' ([SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SrcSpan]
cls_s (String -> [String]
forall a. a -> [a]
repeat String
",")) [Name SrcSpanInfo]
cls
          case ([SrcSpan]
rs', Maybe (QName SrcSpanInfo)
opt_ts) of
             ((SrcSpan
opt_dcolon: SrcSpan
end:[SrcSpan]
_), Just QName SrcSpanInfo
tc) -> do
                Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
opt_dcolon) String
"::"
                QName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC QName SrcSpanInfo
tc
                Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
end) String
"#-}"
             ([SrcSpan
end], Maybe (QName SrcSpanInfo)
Nothing) -> Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
end) String
"#-}"
             ([SrcSpan], Maybe (QName SrcSpanInfo))
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: CompletePragma is given wrong number of srcInfoPoints"
        [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Decl: CompletePragma is given wrong number of srcInfoPoints"


instance ExactP Role where
  exactP :: Role SrcSpanInfo -> EP ()
exactP Role SrcSpanInfo
r =
    case Role SrcSpanInfo
r of
      RoleWildcard SrcSpanInfo
l     -> Pos -> String -> EP ()
printStringAt (SrcSpanInfo -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpanInfo
l) String
"_"
      Representational SrcSpanInfo
l -> Pos -> String -> EP ()
printStringAt (SrcSpanInfo -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpanInfo
l) String
"representational"
      Phantom SrcSpanInfo
l          -> Pos -> String -> EP ()
printStringAt (SrcSpanInfo -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpanInfo
l) String
"phantom"
      Nominal SrcSpanInfo
l          -> Pos -> String -> EP ()
printStringAt (SrcSpanInfo -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpanInfo
l) String
"nominal"


instance ExactP Annotation where
    exactP :: Annotation SrcSpanInfo -> EP ()
exactP Annotation SrcSpanInfo
ann' = case Annotation SrcSpanInfo
ann' of
        Ann     SrcSpanInfo
_ Name SrcSpanInfo
n Exp SrcSpanInfo
e   -> do
            Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Name SrcSpanInfo
n
            Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
        TypeAnn SrcSpanInfo
_ Name SrcSpanInfo
n Exp SrcSpanInfo
e   -> do
            String -> EP ()
printString String
"type"
            Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Name SrcSpanInfo
n
            Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
        ModuleAnn SrcSpanInfo
_ Exp SrcSpanInfo
e   -> do
            String -> EP ()
printString String
"module"
            Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e

instance ExactP BooleanFormula where
    exactP :: BooleanFormula SrcSpanInfo -> EP ()
exactP BooleanFormula SrcSpanInfo
b' = case BooleanFormula SrcSpanInfo
b' of
        VarFormula SrcSpanInfo
_ Name SrcSpanInfo
n -> Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Name SrcSpanInfo
n
        AndFormula SrcSpanInfo
l [BooleanFormula SrcSpanInfo]
bs ->
         let pts :: [SrcSpan]
pts = SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l
         in [(Pos, EP ())] -> [(Pos, EP ())] -> EP ()
printStreams ([Pos] -> [EP ()] -> [(Pos, EP ())]
forall a b. [a] -> [b] -> [(a, b)]
zip ((SrcSpan -> Pos) -> [SrcSpan] -> [Pos]
forall a b. (a -> b) -> [a] -> [b]
map SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos [SrcSpan]
pts) (EP () -> [EP ()]
forall a. a -> [a]
repeat (EP () -> [EP ()]) -> EP () -> [EP ()]
forall a b. (a -> b) -> a -> b
$ String -> EP ()
printString String
",")) ((BooleanFormula SrcSpanInfo -> (Pos, EP ()))
-> [BooleanFormula SrcSpanInfo] -> [(Pos, EP ())]
forall a b. (a -> b) -> [a] -> [b]
map (SrcSpanInfo -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos (SrcSpanInfo -> Pos)
-> (BooleanFormula SrcSpanInfo -> SrcSpanInfo)
-> BooleanFormula SrcSpanInfo
-> Pos
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BooleanFormula SrcSpanInfo -> SrcSpanInfo
forall l. BooleanFormula l -> l
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann (BooleanFormula SrcSpanInfo -> Pos)
-> (BooleanFormula SrcSpanInfo -> EP ())
-> BooleanFormula SrcSpanInfo
-> (Pos, EP ())
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& BooleanFormula SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC) [BooleanFormula SrcSpanInfo]
bs)
        OrFormula SrcSpanInfo
l [BooleanFormula SrcSpanInfo]
bs   ->
         let pts :: [SrcSpan]
pts = SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l
         in [(Pos, EP ())] -> [(Pos, EP ())] -> EP ()
printStreams ([Pos] -> [EP ()] -> [(Pos, EP ())]
forall a b. [a] -> [b] -> [(a, b)]
zip ((SrcSpan -> Pos) -> [SrcSpan] -> [Pos]
forall a b. (a -> b) -> [a] -> [b]
map SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos [SrcSpan]
pts) (EP () -> [EP ()]
forall a. a -> [a]
repeat (EP () -> [EP ()]) -> EP () -> [EP ()]
forall a b. (a -> b) -> a -> b
$ String -> EP ()
printString String
"|")) ((BooleanFormula SrcSpanInfo -> (Pos, EP ()))
-> [BooleanFormula SrcSpanInfo] -> [(Pos, EP ())]
forall a b. (a -> b) -> [a] -> [b]
map (SrcSpanInfo -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos (SrcSpanInfo -> Pos)
-> (BooleanFormula SrcSpanInfo -> SrcSpanInfo)
-> BooleanFormula SrcSpanInfo
-> Pos
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BooleanFormula SrcSpanInfo -> SrcSpanInfo
forall l. BooleanFormula l -> l
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann (BooleanFormula SrcSpanInfo -> Pos)
-> (BooleanFormula SrcSpanInfo -> EP ())
-> BooleanFormula SrcSpanInfo
-> (Pos, EP ())
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& BooleanFormula SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC) [BooleanFormula SrcSpanInfo]
bs)
        ParenFormula SrcSpanInfo
l BooleanFormula SrcSpanInfo
b   ->
            case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
                [SrcSpan
a'',SrcSpan
b''] -> Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a'') String
"(" EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
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 a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b'') String
")"
                [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: BooleanFormula: ParenFormula is given wrong number of srcInfoPoints"

printWarndeprs :: [Pos] -> [([Name SrcSpanInfo], String)] -> EP ()
printWarndeprs :: [Pos] -> [([Name SrcSpanInfo], String)] -> EP ()
printWarndeprs [Pos]
_ [] = () -> EP ()
forall a. a -> EP a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
printWarndeprs [Pos]
ps' (([Name SrcSpanInfo]
ns',String
str'):[([Name SrcSpanInfo], String)]
nsts') = [Pos]
-> [Name SrcSpanInfo]
-> String
-> [([Name SrcSpanInfo], String)]
-> EP ()
printWd [Pos]
ps' [Name SrcSpanInfo]
ns' String
str' [([Name SrcSpanInfo], String)]
nsts'
  where printWd :: [Pos] -> [Name SrcSpanInfo] -> String -> [([Name SrcSpanInfo], String)] -> EP ()
        printWd :: [Pos]
-> [Name SrcSpanInfo]
-> String
-> [([Name SrcSpanInfo], String)]
-> EP ()
printWd (Pos
p:[Pos]
ps) []  String
str [([Name SrcSpanInfo], String)]
nsts = Pos -> String -> EP ()
printStringAt Pos
p (ShowS
forall a. Show a => a -> String
show String
str) EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Pos] -> [([Name SrcSpanInfo], String)] -> EP ()
printWarndeprs [Pos]
ps [([Name SrcSpanInfo], String)]
nsts
        printWd [Pos]
ps     [Name SrcSpanInfo
n] String
str [([Name SrcSpanInfo], String)]
nsts = Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Name SrcSpanInfo
n EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Pos]
-> [Name SrcSpanInfo]
-> String
-> [([Name SrcSpanInfo], String)]
-> EP ()
printWd [Pos]
ps [] String
str [([Name SrcSpanInfo], String)]
nsts
        printWd (Pos
p:[Pos]
ps) (Name SrcSpanInfo
n:[Name SrcSpanInfo]
ns) String
str [([Name SrcSpanInfo], String)]
nsts = Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Name SrcSpanInfo
n EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pos -> String -> EP ()
printStringAt Pos
p String
"," EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Pos]
-> [Name SrcSpanInfo]
-> String
-> [([Name SrcSpanInfo], String)]
-> EP ()
printWd [Pos]
ps [Name SrcSpanInfo]
ns String
str [([Name SrcSpanInfo], String)]
nsts
        printWd [Pos]
_ [Name SrcSpanInfo]
_ String
_ [([Name SrcSpanInfo], String)]
_ = String -> EP ()
forall a. String -> a
internalError String
"printWd"


sepFunBinds :: [Decl SrcSpanInfo] -> [Decl SrcSpanInfo]
sepFunBinds :: [Decl SrcSpanInfo] -> [Decl SrcSpanInfo]
sepFunBinds [] = []
sepFunBinds (FunBind SrcSpanInfo
_ [Match SrcSpanInfo]
ms:[Decl SrcSpanInfo]
ds) = (Match SrcSpanInfo -> Decl SrcSpanInfo)
-> [Match SrcSpanInfo] -> [Decl SrcSpanInfo]
forall a b. (a -> b) -> [a] -> [b]
map (\Match SrcSpanInfo
m -> SrcSpanInfo -> [Match SrcSpanInfo] -> Decl SrcSpanInfo
forall l. l -> [Match l] -> Decl l
FunBind (Match SrcSpanInfo -> SrcSpanInfo
forall l. Match l -> l
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann Match SrcSpanInfo
m) [Match SrcSpanInfo
m]) [Match SrcSpanInfo]
ms [Decl SrcSpanInfo] -> [Decl SrcSpanInfo] -> [Decl SrcSpanInfo]
forall a. [a] -> [a] -> [a]
++ [Decl SrcSpanInfo] -> [Decl SrcSpanInfo]
sepFunBinds [Decl SrcSpanInfo]
ds
sepFunBinds (Decl SrcSpanInfo
d:[Decl SrcSpanInfo]
ds) = Decl SrcSpanInfo
d Decl SrcSpanInfo -> [Decl SrcSpanInfo] -> [Decl SrcSpanInfo]
forall a. a -> [a] -> [a]
: [Decl SrcSpanInfo] -> [Decl SrcSpanInfo]
sepFunBinds [Decl SrcSpanInfo]
ds

sepClassFunBinds :: [ClassDecl SrcSpanInfo] -> [ClassDecl SrcSpanInfo]
sepClassFunBinds :: [ClassDecl SrcSpanInfo] -> [ClassDecl SrcSpanInfo]
sepClassFunBinds [] = []
sepClassFunBinds (ClsDecl SrcSpanInfo
_ (FunBind SrcSpanInfo
_ [Match SrcSpanInfo]
ms):[ClassDecl SrcSpanInfo]
ds) = (Match SrcSpanInfo -> ClassDecl SrcSpanInfo)
-> [Match SrcSpanInfo] -> [ClassDecl SrcSpanInfo]
forall a b. (a -> b) -> [a] -> [b]
map (\Match SrcSpanInfo
m -> SrcSpanInfo -> Decl SrcSpanInfo -> ClassDecl SrcSpanInfo
forall l. l -> Decl l -> ClassDecl l
ClsDecl (Match SrcSpanInfo -> SrcSpanInfo
forall l. Match l -> l
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 l. Match l -> l
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann Match SrcSpanInfo
m) [Match SrcSpanInfo
m]) [Match SrcSpanInfo]
ms [ClassDecl SrcSpanInfo]
-> [ClassDecl SrcSpanInfo] -> [ClassDecl SrcSpanInfo]
forall a. [a] -> [a] -> [a]
++ [ClassDecl SrcSpanInfo] -> [ClassDecl SrcSpanInfo]
sepClassFunBinds [ClassDecl SrcSpanInfo]
ds
sepClassFunBinds (ClassDecl SrcSpanInfo
d:[ClassDecl SrcSpanInfo]
ds) = ClassDecl SrcSpanInfo
d ClassDecl SrcSpanInfo
-> [ClassDecl SrcSpanInfo] -> [ClassDecl SrcSpanInfo]
forall a. a -> [a] -> [a]
: [ClassDecl SrcSpanInfo] -> [ClassDecl SrcSpanInfo]
sepClassFunBinds [ClassDecl SrcSpanInfo]
ds

sepInstFunBinds :: [InstDecl SrcSpanInfo] -> [InstDecl SrcSpanInfo]
sepInstFunBinds :: [InstDecl SrcSpanInfo] -> [InstDecl SrcSpanInfo]
sepInstFunBinds [] = []
sepInstFunBinds (InsDecl SrcSpanInfo
_ (FunBind SrcSpanInfo
_ [Match SrcSpanInfo]
ms):[InstDecl SrcSpanInfo]
ds) = (Match SrcSpanInfo -> InstDecl SrcSpanInfo)
-> [Match SrcSpanInfo] -> [InstDecl SrcSpanInfo]
forall a b. (a -> b) -> [a] -> [b]
map (\Match SrcSpanInfo
m -> SrcSpanInfo -> Decl SrcSpanInfo -> InstDecl SrcSpanInfo
forall l. l -> Decl l -> InstDecl l
InsDecl (Match SrcSpanInfo -> SrcSpanInfo
forall l. Match l -> l
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 l. Match l -> l
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann Match SrcSpanInfo
m) [Match SrcSpanInfo
m]) [Match SrcSpanInfo]
ms [InstDecl SrcSpanInfo]
-> [InstDecl SrcSpanInfo] -> [InstDecl SrcSpanInfo]
forall a. [a] -> [a] -> [a]
++ [InstDecl SrcSpanInfo] -> [InstDecl SrcSpanInfo]
sepInstFunBinds [InstDecl SrcSpanInfo]
ds
sepInstFunBinds (InstDecl SrcSpanInfo
d:[InstDecl SrcSpanInfo]
ds) = InstDecl SrcSpanInfo
d InstDecl SrcSpanInfo
-> [InstDecl SrcSpanInfo] -> [InstDecl SrcSpanInfo]
forall a. a -> [a] -> [a]
: [InstDecl SrcSpanInfo] -> [InstDecl SrcSpanInfo]
sepInstFunBinds [InstDecl SrcSpanInfo]
ds

instance ExactP DeclHead where
  exactP :: DeclHead SrcSpanInfo -> EP ()
exactP DeclHead SrcSpanInfo
dh' = case DeclHead SrcSpanInfo
dh' of
    DHead SrcSpanInfo
_ Name SrcSpanInfo
n           -> Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Name SrcSpanInfo
n
    DHInfix SrcSpanInfo
_ TyVarBind SrcSpanInfo
tva Name SrcSpanInfo
n     -> TyVarBind SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP TyVarBind SrcSpanInfo
tva EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Name SrcSpanInfo -> EP ()
epInfixName Name SrcSpanInfo
n
    DHParen SrcSpanInfo
l DeclHead SrcSpanInfo
dh        ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
_,SrcSpan
b] -> String -> EP ()
printString String
"(" EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
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 a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
")"
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: DeclHead: DeclParen is given wrong number of srcInfoPoints"
    DHApp   SrcSpanInfo
_ DeclHead SrcSpanInfo
dh TyVarBind SrcSpanInfo
t      -> DeclHead SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP DeclHead SrcSpanInfo
dh EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TyVarBind SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC TyVarBind SrcSpanInfo
t

instance ExactP InstRule where
  exactP :: InstRule SrcSpanInfo -> EP ()
exactP InstRule SrcSpanInfo
ih' = case InstRule SrcSpanInfo
ih' of
    IRule SrcSpanInfo
l Maybe [TyVarBind SrcSpanInfo]
mtvs Maybe (Context SrcSpanInfo)
mctxt InstHead SrcSpanInfo
qn    -> do
        let pts :: [SrcSpan]
pts = SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l
        [SrcSpan]
_ <- case Maybe [TyVarBind SrcSpanInfo]
mtvs of
                Maybe [TyVarBind SrcSpanInfo]
Nothing -> [SrcSpan] -> EP [SrcSpan]
forall a. a -> EP a
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts
                Just [TyVarBind SrcSpanInfo]
tvs ->
                    case [SrcSpan]
pts of
                     [SrcSpan
a,SrcSpan
b] -> do
                        Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"forall"
                        (TyVarBind SrcSpanInfo -> EP ())
-> [TyVarBind SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ TyVarBind SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [TyVarBind SrcSpanInfo]
tvs
                        Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"."
                        [SrcSpan] -> EP [SrcSpan]
forall a. a -> EP a
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts
                     [SrcSpan]
_ -> String -> EP [SrcSpan]
forall a. String -> EP a
errorEP String
"ExactP: InstRule: IRule is given too few srcInfoPoints"
        (Context SrcSpanInfo -> EP ())
-> Maybe (Context SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Context SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (Context SrcSpanInfo)
mctxt
        InstHead SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC InstHead SrcSpanInfo
qn
    IParen SrcSpanInfo
l InstRule SrcSpanInfo
ih        ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
a,SrcSpan
b] -> Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"(" EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
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 a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
")"
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: InstRule: IParen is given wrong number of srcInfoPoints"

instance ExactP InstHead where
   exactP :: InstHead SrcSpanInfo -> EP ()
exactP InstHead SrcSpanInfo
doih' = case InstHead SrcSpanInfo
doih' of
    IHCon SrcSpanInfo
_ QName SrcSpanInfo
qn      -> QName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC QName SrcSpanInfo
qn
    IHInfix SrcSpanInfo
_ Type SrcSpanInfo
ta QName SrcSpanInfo
qn -> Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
ta EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> QName SrcSpanInfo -> EP ()
epInfixQName QName SrcSpanInfo
qn
    IHParen SrcSpanInfo
l InstHead SrcSpanInfo
doih  ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
a,SrcSpan
b] -> Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"(" EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
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 a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
")"
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: OrInstHead: IHParen is given wrong number of srcInfoPoints"
    IHApp SrcSpanInfo
_ InstHead SrcSpanInfo
doih Type SrcSpanInfo
t  -> InstHead SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC InstHead SrcSpanInfo
doih EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t

instance ExactP TyVarBind where
  exactP :: TyVarBind SrcSpanInfo -> EP ()
exactP (KindedVar   SrcSpanInfo
l Name SrcSpanInfo
n Type SrcSpanInfo
k) =
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
_,SrcSpan
b,SrcSpan
c] -> do
            String -> EP ()
printString String
"("
            Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Name SrcSpanInfo
n
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"::"
            Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
k
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
c) String
")"
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: TyVarBind: KindedVar is given wrong number of srcInfoPoints"
  exactP (UnkindedVar SrcSpanInfo
l Name SrcSpanInfo
n) =
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
                 [SrcSpan
a,SrcSpan
_,SrcSpan
c] -> do
                    Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"("
                    Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Name SrcSpanInfo
n
                    Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
c) String
")"
                 [] -> Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Name SrcSpanInfo
n
                 [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: TyVarBind: UnkindedVar is given wrong number of srcInfoPoints"

instance ExactP Type where
  exactP :: Type SrcSpanInfo -> EP ()
exactP Type SrcSpanInfo
t' = case Type SrcSpanInfo
t' of
    TyForall SrcSpanInfo
l Maybe [TyVarBind SrcSpanInfo]
mtvs Maybe (Context SrcSpanInfo)
mctxt Type SrcSpanInfo
t -> do
        let pts :: [SrcSpan]
pts = SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l
        [SrcSpan]
_ <- case Maybe [TyVarBind SrcSpanInfo]
mtvs of
                Maybe [TyVarBind SrcSpanInfo]
Nothing -> [SrcSpan] -> EP [SrcSpan]
forall a. a -> EP a
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts
                Just [TyVarBind SrcSpanInfo]
tvs ->
                    case [SrcSpan]
pts of
                     SrcSpan
_:SrcSpan
b:[SrcSpan]
pts' -> do
                        String -> EP ()
printString String
"forall"
                        (TyVarBind SrcSpanInfo -> EP ())
-> [TyVarBind SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ TyVarBind SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [TyVarBind SrcSpanInfo]
tvs
                        Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"."
                        [SrcSpan] -> EP [SrcSpan]
forall a. a -> EP a
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts'
                     [SrcSpan]
_ -> String -> EP [SrcSpan]
forall a. String -> EP a
errorEP String
"ExactP: Type: TyForall is given too few srcInfoPoints"
        (Context SrcSpanInfo -> EP ())
-> Maybe (Context SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Context SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (Context SrcSpanInfo)
mctxt
        Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t
    TyStar  SrcSpanInfo
_ -> String -> EP ()
printString String
"*"
    TyFun   SrcSpanInfo
l Type SrcSpanInfo
t1 Type SrcSpanInfo
t2 ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
a] -> do
            Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Type SrcSpanInfo
t1
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"->"
            Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t2
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Type: TyFun is given wrong number of srcInfoPoints"
    TyTuple SrcSpanInfo
l Boxed
bx [Type SrcSpanInfo]
ts ->
        case Boxed
bx of
          Boxed
Boxed   -> [SrcSpan] -> [Type SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
parenList (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) [Type SrcSpanInfo]
ts
          Boxed
Unboxed -> [SrcSpan] -> [Type SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
parenHashList (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) [Type SrcSpanInfo]
ts
    TyUnboxedSum SrcSpanInfo
l [Type SrcSpanInfo]
es ->
      [SrcSpan] -> [Type SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
unboxedSumTypeList (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) [Type SrcSpanInfo]
es
    TyList  SrcSpanInfo
l Type SrcSpanInfo
t     ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
_,SrcSpan
b] -> do
            String -> EP ()
printString String
"["
            Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"]"
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Type: TyList is given wrong number of srcInfoPoints"
    TyParArray SrcSpanInfo
l Type SrcSpanInfo
t     ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
_,SrcSpan
b] -> do
            String -> EP ()
printString String
"[:"
            Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
":]"
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Type: TyParArray is given wrong number of srcInfoPoints"
    TyApp   SrcSpanInfo
_ Type SrcSpanInfo
t1 Type SrcSpanInfo
t2 -> Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Type SrcSpanInfo
t1 EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t2
    TyVar   SrcSpanInfo
_ Name SrcSpanInfo
n     -> Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Name SrcSpanInfo
n
    TyCon   SrcSpanInfo
_ QName SrcSpanInfo
qn    -> QName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP QName SrcSpanInfo
qn
    TyParen SrcSpanInfo
l Type SrcSpanInfo
t     ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
_,SrcSpan
b] -> do
            String -> EP ()
printString String
"("
            Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
")"
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Type: TyParen is given wrong number of srcInfoPoints"
    TyInfix SrcSpanInfo
_ Type SrcSpanInfo
t1 MaybePromotedName SrcSpanInfo
qn Type SrcSpanInfo
t2 -> Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Type SrcSpanInfo
t1 EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
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 a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t2
    TyKind  SrcSpanInfo
l Type SrcSpanInfo
t Type SrcSpanInfo
kd ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
_,SrcSpan
b,SrcSpan
c] -> do
            String -> EP ()
printString String
"("
            Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"::"
            Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
kd
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
c) String
")"
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Type: TyKind is given wrong number of srcInfoPoints"
    TyPromoted SrcSpanInfo
_ Promoted SrcSpanInfo
p -> Promoted SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Promoted SrcSpanInfo
p
    TyEquals SrcSpanInfo
l Type SrcSpanInfo
t0 Type SrcSpanInfo
t1 -> case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
                          SrcSpan
a:[SrcSpan]
_ -> Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t0 EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"~" EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t1
                          [SrcSpan]
_   -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Type: TyEquals is given wrong number of srcInfoPoints"

    TySplice SrcSpanInfo
_ Splice SrcSpanInfo
sp  -> Splice SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Splice SrcSpanInfo
sp
    TyBang SrcSpanInfo
_ BangType SrcSpanInfo
b Unpackedness SrcSpanInfo
u Type SrcSpanInfo
t -> Unpackedness SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Unpackedness SrcSpanInfo
u EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
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 a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t
    TyWildCard SrcSpanInfo
_ Maybe (Name SrcSpanInfo)
mn      -> String -> EP ()
printString String
"_" EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Name SrcSpanInfo -> EP ()) -> Maybe (Name SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (Name SrcSpanInfo)
mn
    TyQuasiQuote SrcSpanInfo
_ String
name String
qt    -> do
        let qtLines :: [String]
qtLines = String -> [String]
lines String
qt
        String -> EP ()
printString (String -> EP ()) -> String -> EP ()
forall a b. (a -> b) -> a -> b
$ String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"|"
        [EP ()] -> EP ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ (EP () -> [EP ()] -> [EP ()]
forall a. a -> [a] -> [a]
intersperse EP ()
newLine ([EP ()] -> [EP ()]) -> [EP ()] -> [EP ()]
forall a b. (a -> b) -> a -> b
$ (String -> EP ()) -> [String] -> [EP ()]
forall a b. (a -> b) -> [a] -> [b]
map String -> EP ()
printString [String]
qtLines)
        String -> EP ()
printString String
"|]"

instance ExactP MaybePromotedName where
  exactP :: MaybePromotedName SrcSpanInfo -> EP ()
exactP (PromotedName SrcSpanInfo
l QName SrcSpanInfo
qn)  = case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
    [SrcSpan
a] -> Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"'" EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> QName SrcSpanInfo -> EP ()
epInfixQName QName SrcSpanInfo
qn
    [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: MaybePromotedName: PromotedName given wrong number of args"
  exactP (UnpromotedName SrcSpanInfo
_ QName SrcSpanInfo
qn) = QName SrcSpanInfo -> EP ()
epInfixQName QName SrcSpanInfo
qn

instance ExactP Promoted where
  exactP :: Promoted SrcSpanInfo -> EP ()
exactP (PromotedInteger SrcSpanInfo
_ Integer
_ String
rw) = String -> EP ()
printString String
rw
  exactP (PromotedString SrcSpanInfo
_ String
_ String
rw)  = String -> EP ()
printString (Char
'\"'Char -> ShowS
forall a. a -> [a] -> [a]
:String
rw String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\"")
  exactP (PromotedCon SrcSpanInfo
l Bool
True QName SrcSpanInfo
qn)  = case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
    [SrcSpan
a] -> Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"'" EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> QName SrcSpanInfo -> EP ()
epQName QName SrcSpanInfo
qn
    [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Promoted: PromotedCon is given wrong number of srcInfoPoints"
  exactP (PromotedCon SrcSpanInfo
_ Bool
False QName SrcSpanInfo
qn) = QName SrcSpanInfo -> EP ()
epQName QName SrcSpanInfo
qn
  exactP (PromotedList SrcSpanInfo
l Bool
b [Type SrcSpanInfo]
pl) =
    let o :: String
o | Bool
b = String
"'[" | Bool
otherwise = String
"["
        e :: String
e = String
"]"
        pts :: [SrcSpan]
pts = SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l
    in [(SrcSpan, String)] -> [Type SrcSpanInfo] -> EP ()
forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved ([SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SrcSpan]
pts (String
oString -> [String] -> [String]
forall a. a -> [a] -> [a]
: Int -> String -> [String]
forall a. Int -> a -> [a]
replicate ([SrcSpan] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SrcSpan]
pts Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) String
"," [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
e])) [Type SrcSpanInfo]
pl
  exactP (PromotedTuple SrcSpanInfo
l [Type SrcSpanInfo]
pl) =
    let o :: String
o = String
"'("
        e :: String
e = String
")"
        pts :: [SrcSpan]
pts = SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l
    in [(SrcSpan, String)] -> [Type SrcSpanInfo] -> EP ()
forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved ([SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SrcSpan]
pts (String
oString -> [String] -> [String]
forall a. a -> [a] -> [a]
: Int -> String -> [String]
forall a. Int -> a -> [a]
replicate ([SrcSpan] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SrcSpan]
pts Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) String
"," [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
e])) [Type SrcSpanInfo]
pl
  exactP (PromotedUnit SrcSpanInfo
l) = case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
    [SrcSpan
_,SrcSpan
b] -> do
        String -> EP ()
printString String
"("
        Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
")"
    [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Promoted: PromotedUnit is given wrong number of srcInfoPoints"


instance ExactP Context where
  exactP :: Context SrcSpanInfo -> EP ()
exactP Context SrcSpanInfo
ctxt = do
    Context SrcSpanInfo -> EP ()
printContext Context SrcSpanInfo
ctxt
    Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos (SrcSpan -> Pos)
-> (Context SrcSpanInfo -> SrcSpan) -> Context SrcSpanInfo -> Pos
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SrcSpan] -> SrcSpan
forall a. HasCallStack => [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 l. Context l -> l
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann (Context SrcSpanInfo -> Pos) -> Context SrcSpanInfo -> Pos
forall a b. (a -> b) -> a -> b
$ Context SrcSpanInfo
ctxt) String
"=>"

printContext :: Context SrcSpanInfo -> EP ()
printContext :: Context SrcSpanInfo -> EP ()
printContext Context SrcSpanInfo
ctxt = do
    let l :: SrcSpanInfo
l = Context SrcSpanInfo -> SrcSpanInfo
forall l. Context l -> l
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann Context SrcSpanInfo
ctxt
        pts :: [SrcSpan]
pts = [SrcSpan] -> [SrcSpan]
forall a. HasCallStack => [a] -> [a]
init ([SrcSpan] -> [SrcSpan]) -> [SrcSpan] -> [SrcSpan]
forall a b. (a -> b) -> a -> b
$ SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l
    case Context SrcSpanInfo
ctxt of
     CxSingle SrcSpanInfo
_ Asst SrcSpanInfo
asst -> Asst SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Asst SrcSpanInfo
asst
     CxEmpty SrcSpanInfo
_ ->
        case [SrcSpan]
pts of
         [SrcSpan
a,SrcSpan
b] -> do
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"("
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
")"
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Context: CxEmpty is given wrong number of srcInfoPoints"
     CxTuple SrcSpanInfo
_ [Asst SrcSpanInfo]
assts -> [SrcSpan] -> [Asst SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
parenList [SrcSpan]
pts [Asst SrcSpanInfo]
assts


instance ExactP Asst where
  exactP :: Asst SrcSpanInfo -> EP ()
exactP Asst SrcSpanInfo
asst = case Asst SrcSpanInfo
asst of
    TypeA SrcSpanInfo
_ Type SrcSpanInfo
t -> Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Type SrcSpanInfo
t
    IParam SrcSpanInfo
l IPName SrcSpanInfo
ipn Type SrcSpanInfo
t    ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
a] -> do
            IPName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP IPName SrcSpanInfo
ipn
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"::"
            Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Asst: IParam is given wrong number of srcInfoPoints"
    ParenA SrcSpanInfo
l Asst SrcSpanInfo
asst' ->
        case Int -> [SrcSpan] -> [SrcSpan]
forall a. Int -> [a] -> [a]
take Int
2 ([SrcSpan] -> [SrcSpan]) -> [SrcSpan] -> [SrcSpan]
forall a b. (a -> b) -> a -> b
$ SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
a,SrcSpan
b] -> do
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"("
            Asst SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Asst SrcSpanInfo
asst'
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
")"
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Asst: ParenA is given wrong number of srcInfoPoints"

instance ExactP Deriving where
  exactP :: Deriving SrcSpanInfo -> EP ()
exactP (Deriving SrcSpanInfo
l Maybe (DerivStrategy SrcSpanInfo)
mds [InstRule SrcSpanInfo]
ihs) =
    case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
     SrcSpan
_:[SrcSpan]
pts -> do
        String -> EP ()
printString String
"deriving"
        (DerivStrategy SrcSpanInfo -> EP ())
-> Maybe (DerivStrategy SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP DerivStrategy SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (DerivStrategy SrcSpanInfo)
mds
        case [SrcSpan]
pts of
         [] -> InstRule SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC (InstRule SrcSpanInfo -> EP ()) -> InstRule SrcSpanInfo -> EP ()
forall a b. (a -> b) -> a -> b
$ [InstRule SrcSpanInfo] -> InstRule SrcSpanInfo
forall a. HasCallStack => [a] -> a
head [InstRule SrcSpanInfo]
ihs
         [SrcSpan]
_  -> [SrcSpan] -> [InstRule SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
parenList [SrcSpan]
pts [InstRule SrcSpanInfo]
ihs
     [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Deriving is given too few srcInfoPoints"

instance ExactP DerivStrategy where
  exactP :: DerivStrategy SrcSpanInfo -> EP ()
exactP (DerivStock SrcSpanInfo
_) =
    String -> EP ()
printString String
"stock"
  exactP (DerivAnyclass SrcSpanInfo
_) =
    String -> EP ()
printString String
"anyclass"
  exactP (DerivNewtype SrcSpanInfo
_) =
    String -> EP ()
printString String
"newtype"
  exactP (DerivVia SrcSpanInfo
_ Type SrcSpanInfo
ty) = do
    String -> EP ()
printString String
"via"
    Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Type SrcSpanInfo
ty

instance ExactP ClassDecl where
  exactP :: ClassDecl SrcSpanInfo -> EP ()
exactP ClassDecl SrcSpanInfo
cdecl = case ClassDecl SrcSpanInfo
cdecl of
    ClsDecl    SrcSpanInfo
_ Decl SrcSpanInfo
d -> Decl SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Decl SrcSpanInfo
d
    ClsDataFam SrcSpanInfo
l Maybe (Context SrcSpanInfo)
mctxt DeclHead SrcSpanInfo
dh Maybe (ResultSig SrcSpanInfo)
mk ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         SrcSpan
_:[SrcSpan]
pts -> do
            String -> EP ()
printString String
"data"
            (Context SrcSpanInfo -> EP ())
-> Maybe (Context SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Context SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (Context SrcSpanInfo)
mctxt
            DeclHead SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC DeclHead SrcSpanInfo
dh
            (ResultSig SrcSpanInfo -> EP ())
-> Maybe (ResultSig SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP (\ResultSig SrcSpanInfo
kd -> Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos ([SrcSpan] -> SrcSpan
forall a. HasCallStack => [a] -> a
head [SrcSpan]
pts)) String
"::" EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ResultSig SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC ResultSig SrcSpanInfo
kd) Maybe (ResultSig SrcSpanInfo)
mk
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: ClassDecl: ClsDataFam is given too few srcInfoPoints"
    ClsTyFam   SrcSpanInfo
l DeclHead SrcSpanInfo
dh Maybe (ResultSig SrcSpanInfo)
mk Maybe (InjectivityInfo SrcSpanInfo)
mi ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         SrcSpan
_:[SrcSpan]
_ -> do
            String -> EP ()
printString String
"type"
            DeclHead SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC DeclHead SrcSpanInfo
dh
            (ResultSig SrcSpanInfo -> EP ())
-> Maybe (ResultSig SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP ResultSig SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (ResultSig SrcSpanInfo)
mk
            (InjectivityInfo SrcSpanInfo -> EP ())
-> Maybe (InjectivityInfo SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP InjectivityInfo SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (InjectivityInfo SrcSpanInfo)
mi
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: ClassDecl: ClsTyFam is given too few srcInfoPoints"
    ClsTyDef   SrcSpanInfo
l TypeEqn SrcSpanInfo
t1 ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         SrcSpan
_:SrcSpan
b:[SrcSpan]
_ -> do -- 3 sourceInfoPoints implies parsed as "type instance"
            String -> EP ()
printString String
"type"
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"instance"
            TypeEqn SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC TypeEqn SrcSpanInfo
t1
         SrcSpan
_:[SrcSpan]
_ -> do
            String -> EP ()
printString String
"type"
            TypeEqn SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC TypeEqn SrcSpanInfo
t1
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: ClassDecl: ClsTyDef is given too few srcInfoPoints"
    ClsDefSig  SrcSpanInfo
l Name SrcSpanInfo
n Type SrcSpanInfo
t    ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         SrcSpan
_:SrcSpan
b:[SrcSpan]
_ -> do
            String -> EP ()
printString String
"default"
            Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Name SrcSpanInfo
n
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"::"
            Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: ClassDecl: ClsDefSig is given too few srcInfoPoints"


instance ExactP InstDecl where
  exactP :: InstDecl SrcSpanInfo -> EP ()
exactP InstDecl SrcSpanInfo
idecl = case InstDecl SrcSpanInfo
idecl of
    InsDecl   SrcSpanInfo
_ Decl SrcSpanInfo
d -> Decl SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Decl SrcSpanInfo
d
    InsType   SrcSpanInfo
l Type SrcSpanInfo
t1 Type SrcSpanInfo
t2 ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
_,SrcSpan
b] -> do
            String -> EP ()
printString String
"type"
            Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t1
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"="
            Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t2
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> a
internalError String
"InstDecl -> InsType"
    InsData   SrcSpanInfo
l DataOrNew SrcSpanInfo
dn Type SrcSpanInfo
t [QualConDecl SrcSpanInfo]
constrs [Deriving SrcSpanInfo]
mder -> do
        DataOrNew SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP DataOrNew SrcSpanInfo
dn
        Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t
        [(SrcSpan, String)] -> [QualConDecl SrcSpanInfo] -> EP ()
forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved ([SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) (String
"="String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
forall a. a -> [a]
repeat String
"|")) [QualConDecl SrcSpanInfo]
constrs
        (Deriving SrcSpanInfo -> EP ()) -> [Deriving SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Deriving SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [Deriving SrcSpanInfo]
mder
    InsGData  SrcSpanInfo
l DataOrNew SrcSpanInfo
dn Type SrcSpanInfo
t Maybe (Type SrcSpanInfo)
mk [GadtDecl SrcSpanInfo]
gds [Deriving SrcSpanInfo]
mder  -> do
        let pts :: [SrcSpan]
pts = SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l
        DataOrNew SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP DataOrNew SrcSpanInfo
dn
        Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t
        [SrcSpan]
pts1 <- case Maybe (Type SrcSpanInfo)
mk of
                Maybe (Type SrcSpanInfo)
Nothing -> [SrcSpan] -> EP [SrcSpan]
forall a. a -> EP a
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts
                Just Type SrcSpanInfo
kd -> case [SrcSpan]
pts of
                            SrcSpan
p:[SrcSpan]
pts' -> do
                                Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
p) String
"::"
                                Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
kd
                                [SrcSpan] -> EP [SrcSpan]
forall a. a -> EP a
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts'
                            [SrcSpan]
_ -> String -> EP [SrcSpan]
forall a. String -> EP a
errorEP String
"ExactP: InstDecl: InsGData is given too few srcInfoPoints"
        case [SrcSpan]
pts1 of
         SrcSpan
x:[SrcSpan]
_ -> do
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
x) String
"where"
            (GadtDecl SrcSpanInfo -> EP ()) -> [GadtDecl SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ GadtDecl SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [GadtDecl SrcSpanInfo]
gds
            (Deriving SrcSpanInfo -> EP ()) -> [Deriving SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Deriving SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [Deriving SrcSpanInfo]
mder
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: InstDecl: InsGData is given too few srcInfoPoints"
--  InsInline l inl mact qn   -> do
--        case srcInfoPoints l of
--         [a,b] -> do
--            printString $ if inl then "{-# INLINE" else "{-# NOINLINE"
--            maybeEP exactPC mact
--            exactPC qn
--            printStringAt (pos b) "#-}"
--         _ -> errorEP "ExactP: InstDecl: InsInline is given wrong number of srcInfoPoints"

instance ExactP FunDep where
  exactP :: FunDep SrcSpanInfo -> EP ()
exactP (FunDep SrcSpanInfo
l [Name SrcSpanInfo]
nxs [Name SrcSpanInfo]
nys) =
    case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
     [SrcSpan
a] -> do
        (Name SrcSpanInfo -> EP ()) -> [Name SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [Name SrcSpanInfo]
nxs
        Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"->"
        (Name SrcSpanInfo -> EP ()) -> [Name SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [Name SrcSpanInfo]
nys
     [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: FunDep is given wrong number of srcInfoPoints"

instance ExactP QualConDecl where
  exactP :: QualConDecl SrcSpanInfo -> EP ()
exactP (QualConDecl SrcSpanInfo
l Maybe [TyVarBind SrcSpanInfo]
mtvs Maybe (Context SrcSpanInfo)
mctxt ConDecl SrcSpanInfo
cd) = do
        let pts :: [SrcSpan]
pts = SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l
        [SrcSpan]
_ <- case Maybe [TyVarBind SrcSpanInfo]
mtvs of
                Maybe [TyVarBind SrcSpanInfo]
Nothing -> [SrcSpan] -> EP [SrcSpan]
forall a. a -> EP a
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts
                Just [TyVarBind SrcSpanInfo]
tvs ->
                    case [SrcSpan]
pts of
                     SrcSpan
_:SrcSpan
b:[SrcSpan]
pts' -> do
                        String -> EP ()
printString String
"forall"
                        (TyVarBind SrcSpanInfo -> EP ())
-> [TyVarBind SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ TyVarBind SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [TyVarBind SrcSpanInfo]
tvs
                        Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"."
                        [SrcSpan] -> EP [SrcSpan]
forall a. a -> EP a
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts'
                     [SrcSpan]
_ -> String -> EP [SrcSpan]
forall a. String -> EP a
errorEP String
"ExactP: QualConDecl is given wrong number of srcInfoPoints"
        (Context SrcSpanInfo -> EP ())
-> Maybe (Context SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Context SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (Context SrcSpanInfo)
mctxt
        ConDecl SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC ConDecl SrcSpanInfo
cd

instance ExactP ConDecl where
  exactP :: ConDecl SrcSpanInfo -> EP ()
exactP ConDecl SrcSpanInfo
cd = case ConDecl SrcSpanInfo
cd of
    ConDecl SrcSpanInfo
_ Name SrcSpanInfo
n [Type SrcSpanInfo]
bts -> Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Name SrcSpanInfo
n EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Type SrcSpanInfo -> EP ()) -> [Type SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [Type SrcSpanInfo]
bts
    InfixConDecl SrcSpanInfo
_ Type SrcSpanInfo
bta Name SrcSpanInfo
n Type SrcSpanInfo
btb -> Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Type SrcSpanInfo
bta EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Name SrcSpanInfo -> EP ()
epInfixName Name SrcSpanInfo
n EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Type SrcSpanInfo
btb
    RecDecl SrcSpanInfo
l Name SrcSpanInfo
n [FieldDecl SrcSpanInfo]
fds -> Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Name SrcSpanInfo
n EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [SrcSpan] -> [FieldDecl SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
curlyList (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) [FieldDecl SrcSpanInfo]
fds

instance ExactP GadtDecl where
  exactP :: GadtDecl SrcSpanInfo -> EP ()
exactP (GadtDecl SrcSpanInfo
l Name SrcSpanInfo
n Maybe [TyVarBind SrcSpanInfo]
_mtvs Maybe (Context SrcSpanInfo)
mctxt Maybe [FieldDecl SrcSpanInfo]
ns' Type SrcSpanInfo
t) =
    case Maybe [FieldDecl SrcSpanInfo]
ns' of
        Maybe [FieldDecl SrcSpanInfo]
Nothing ->
            case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
                [SrcSpan
a] -> do
                    Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Name SrcSpanInfo
n
                    Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"::"
                    Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t
                [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: GadtDecl is given wrong number of srcInfoPoints"
        Just [FieldDecl SrcSpanInfo]
ts ->
            case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
                (SrcSpan
a:SrcSpan
b:SrcSpan
c:SrcSpan
d:[SrcSpan]
rest) -> do
                    Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Name SrcSpanInfo
n
                    Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"::"
                    (Context SrcSpanInfo -> EP ())
-> Maybe (Context SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Context SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (Context SrcSpanInfo)
mctxt
                    Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"{"
                    [(SrcSpan, String)] -> [FieldDecl SrcSpanInfo] -> EP ()
forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved' ([SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SrcSpan]
rest (String -> [String]
forall a. a -> [a]
repeat String
",")) [FieldDecl SrcSpanInfo]
ts
                    Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
c) String
"}"
                    Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
d) String
"->"
                    Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t
                [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: GadtDecl is given wrong number of srcInfoPoints"

instance ExactP BangType where
  exactP :: BangType SrcSpanInfo -> EP ()
exactP BangType SrcSpanInfo
bt = case BangType SrcSpanInfo
bt of
    BangedTy   SrcSpanInfo
l  -> Pos -> String -> EP ()
printStringAt (SrcSpanInfo -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpanInfo
l) String
"!"
    LazyTy SrcSpanInfo
l -> Pos -> String -> EP ()
printStringAt (SrcSpanInfo -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpanInfo
l) String
"~"
    BangType SrcSpanInfo
_ -> () -> EP ()
forall a. a -> EP a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

instance ExactP Unpackedness where
  exactP :: Unpackedness SrcSpanInfo -> EP ()
exactP Unpackedness SrcSpanInfo
bt = case Unpackedness SrcSpanInfo
bt of
    Unpack SrcSpanInfo
l  ->
      case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
       [SrcSpan
a,SrcSpan
b] -> do
          Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"{-# UNPACK"
          Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"#-}"
       [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Unpackedness: Unpack is given wrong number of srcInfoPoints"
    NoUnpack SrcSpanInfo
l  ->
      case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
       [SrcSpan
a,SrcSpan
b] -> do
          Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"{-# NOUNPACK"
          Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"#-}"
       [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Unpackedness: NoUnpack is given wrong number of srcInfoPoints"
    NoUnpackPragma {} -> () -> EP ()
forall a. a -> EP a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

instance ExactP Splice where
  exactP :: Splice SrcSpanInfo -> EP ()
exactP (IdSplice SrcSpanInfo
_ String
str) = String -> EP ()
printString (String -> EP ()) -> String -> EP ()
forall a b. (a -> b) -> a -> b
$ Char
'$'Char -> ShowS
forall a. a -> [a] -> [a]
:String
str
  exactP (TIdSplice SrcSpanInfo
_ String
str) = String -> EP ()
printString (String -> EP ()) -> String -> EP ()
forall a b. (a -> b) -> a -> b
$ String
"$$" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
str
  exactP (ParenSplice SrcSpanInfo
l Exp SrcSpanInfo
e) = String -> String -> SrcSpanInfo -> Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *).
ExactP ast =>
String -> String -> SrcSpanInfo -> ast SrcSpanInfo -> EP ()
printParen String
"ParenSplice" String
"$(" SrcSpanInfo
l Exp SrcSpanInfo
e
  exactP (TParenSplice SrcSpanInfo
l Exp SrcSpanInfo
e) = String -> String -> SrcSpanInfo -> Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *).
ExactP ast =>
String -> String -> SrcSpanInfo -> ast SrcSpanInfo -> EP ()
printParen String
"TParenSplice" String
"$$(" SrcSpanInfo
l Exp SrcSpanInfo
e

printParen :: ExactP ast => String -> String -> SrcSpanInfo -> ast SrcSpanInfo -> EP ()
printParen :: forall (ast :: * -> *).
ExactP ast =>
String -> String -> SrcSpanInfo -> ast SrcSpanInfo -> EP ()
printParen String
con String
paren SrcSpanInfo
l ast SrcSpanInfo
e =
    case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
     [SrcSpan
_,SrcSpan
b] -> do
        String -> EP ()
printString String
paren
        ast SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC ast SrcSpanInfo
e
        Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
")"
     [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP (String -> EP ()) -> String -> EP ()
forall a b. (a -> b) -> a -> b
$ String
"ExactP: Splice: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
con String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is given wrong number of srcInfoPoints"

instance ExactP Exp where
  exactP :: Exp SrcSpanInfo -> EP ()
exactP Exp SrcSpanInfo
exp = case Exp SrcSpanInfo
exp of
    Var SrcSpanInfo
_ QName SrcSpanInfo
qn        -> QName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP QName SrcSpanInfo
qn
    OverloadedLabel SrcSpanInfo
_ String
qn -> String -> EP ()
printString (Char
'#'Char -> ShowS
forall a. a -> [a] -> [a]
:String
qn)
    IPVar SrcSpanInfo
_ IPName SrcSpanInfo
ipn     -> IPName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP IPName SrcSpanInfo
ipn
    Con SrcSpanInfo
_ QName SrcSpanInfo
qn        -> QName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP QName SrcSpanInfo
qn
    Lit SrcSpanInfo
_ Literal SrcSpanInfo
lit       -> Literal SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Literal SrcSpanInfo
lit
    InfixApp SrcSpanInfo
_ Exp SrcSpanInfo
e1 QOp SrcSpanInfo
op Exp SrcSpanInfo
e2 -> Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Exp SrcSpanInfo
e1 EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
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 a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e2
    App SrcSpanInfo
_ Exp SrcSpanInfo
e1 Exp SrcSpanInfo
e2     -> Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Exp SrcSpanInfo
e1 EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e2
    NegApp SrcSpanInfo
_ Exp SrcSpanInfo
e      -> String -> EP ()
printString String
"-" EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
    Lambda SrcSpanInfo
l [Pat SrcSpanInfo]
ps Exp SrcSpanInfo
e   ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
_,SrcSpan
b] -> do
            String -> EP ()
printString String
"\\"
            (Pat SrcSpanInfo -> EP ()) -> [Pat SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [Pat SrcSpanInfo]
ps
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"->"
            Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: Lambda is given wrong number of srcInfoPoints"
    Let SrcSpanInfo
l Binds SrcSpanInfo
bs Exp SrcSpanInfo
e      ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
_,SrcSpan
b] -> do
            String -> EP ()
printString String
"let"
            Binds SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Binds SrcSpanInfo
bs
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"in"
            Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: Let is given wrong number of srcInfoPoints"
    If SrcSpanInfo
l Exp SrcSpanInfo
ec Exp SrcSpanInfo
et Exp SrcSpanInfo
ee   -> -- traceShow (srcInfoPoints l) $ do
        -- First we need to sort out if there are any optional
        -- semicolons hiding among the srcInfoPoints.
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         (SrcSpan
_:SrcSpan
b:SrcSpan
c:[SrcSpan]
rest) -> do
            let (Maybe SrcSpan
mpSemi1,SrcSpan
pThen,[SrcSpan]
rest2) =
                           if Pos -> Int
forall a b. (a, b) -> b
snd (SrcSpan -> Pos
spanSize SrcSpan
b) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4 -- this is "then", not a semi
                            then (Maybe SrcSpan
forall a. Maybe a
Nothing, SrcSpan
b, SrcSpan
cSrcSpan -> [SrcSpan] -> [SrcSpan]
forall a. a -> [a] -> [a]
:[SrcSpan]
rest)
                            else (SrcSpan -> Maybe SrcSpan
forall a. a -> Maybe a
Just SrcSpan
b, SrcSpan
c, [SrcSpan]
rest)
            case [SrcSpan]
rest2 of
              (SrcSpan
c':[SrcSpan]
rest3) -> do
                let (Maybe SrcSpan
mpSemi2,[SrcSpan]
rest4) = if Pos -> Int
forall a b. (a, b) -> b
snd (SrcSpan -> Pos
spanSize SrcSpan
c') Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4 -- this is "else", not a semi
                                       then (Maybe SrcSpan
forall a. Maybe a
Nothing, [SrcSpan]
rest2)
                                       else (SrcSpan -> Maybe SrcSpan
forall a. a -> Maybe a
Just SrcSpan
c', [SrcSpan]
rest3)
                case [SrcSpan]
rest4 of
                  [SrcSpan
pElse] -> do
                    -- real work starts here:
                    String -> EP ()
printString String
"if"
                    Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
ec
                    (SrcSpan -> EP ()) -> Maybe SrcSpan -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP SrcSpan -> EP ()
printSemi  Maybe SrcSpan
mpSemi1
                    Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
pThen) String
"then"
                    Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
et
                    (SrcSpan -> EP ()) -> Maybe SrcSpan -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP SrcSpan -> EP ()
printSemi Maybe SrcSpan
mpSemi2
                    Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
pElse) String
"else"
                    Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
ee
                  [] -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: If is given too few srcInfoPoints"
                  [SrcSpan]
_  -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: If is given too many srcInfoPoints"
              [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: If is given too few srcInfoPoints"

         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: If is given too few srcInfoPoints"
    MultiIf SrcSpanInfo
l [GuardedRhs SrcSpanInfo]
alts ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
          SrcSpan
_:[SrcSpan]
pts -> do
            String -> EP ()
printString String
"if"
            [SrcSpan] -> [GuardedAlt SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
layoutList [SrcSpan]
pts ((GuardedRhs SrcSpanInfo -> GuardedAlt SrcSpanInfo)
-> [GuardedRhs SrcSpanInfo] -> [GuardedAlt SrcSpanInfo]
forall a b. (a -> b) -> [a] -> [b]
map GuardedRhs SrcSpanInfo -> GuardedAlt SrcSpanInfo
forall l. GuardedRhs l -> GuardedAlt l
GuardedAlt [GuardedRhs SrcSpanInfo]
alts)
          [SrcSpan]
_ -> String -> EP ()
forall a. String -> a
internalError String
"Exp -> MultiIf"
    Case SrcSpanInfo
l Exp SrcSpanInfo
e [Alt SrcSpanInfo]
alts   ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         SrcSpan
_:SrcSpan
b:[SrcSpan]
pts -> do
            String -> EP ()
printString String
"case"
            Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"of"
            [SrcSpan] -> [Alt SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
layoutList [SrcSpan]
pts [Alt SrcSpanInfo]
alts
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: Case is given too few srcInfoPoints"
    Do SrcSpanInfo
l [Stmt SrcSpanInfo]
stmts      ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         SrcSpan
_:[SrcSpan]
pts -> do
            String -> EP ()
printString String
"do"
            [SrcSpan] -> [Stmt SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
layoutList [SrcSpan]
pts [Stmt SrcSpanInfo]
stmts
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: Do is given too few srcInfoPoints"
    MDo SrcSpanInfo
l [Stmt SrcSpanInfo]
stmts     ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         SrcSpan
_:[SrcSpan]
pts -> do
            String -> EP ()
printString String
"mdo"
            [SrcSpan] -> [Stmt SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
layoutList [SrcSpan]
pts [Stmt SrcSpanInfo]
stmts
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: Mdo is given wrong number of srcInfoPoints"
    Tuple SrcSpanInfo
l Boxed
bx [Exp SrcSpanInfo]
es   ->
        case Boxed
bx of
          Boxed
Boxed   -> [SrcSpan] -> [Exp SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
parenList (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) [Exp SrcSpanInfo]
es
          Boxed
Unboxed -> [SrcSpan] -> [Exp SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
parenHashList (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) [Exp SrcSpanInfo]
es
    UnboxedSum SrcSpanInfo
l Int
b Int
a Exp SrcSpanInfo
es -> do
        SrcSpanInfo -> Int -> Int -> Exp SrcSpanInfo -> EP ()
forall (e :: * -> *).
ExactP e =>
SrcSpanInfo -> Int -> Int -> e SrcSpanInfo -> EP ()
unboxedSumEP SrcSpanInfo
l Int
b Int
a Exp SrcSpanInfo
es
    TupleSection SrcSpanInfo
l Boxed
bx [Maybe (Exp SrcSpanInfo)]
mexps -> do
        let pts :: [SrcSpan]
pts = SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l
            (String
o, String
e) = case Boxed
bx of Boxed
Boxed -> (String
"(", String
")"); Boxed
Unboxed -> (String
"(#", String
"#)")
        [(Pos, EP ())] -> EP ()
printSeq ([(Pos, EP ())] -> EP ()) -> [(Pos, EP ())] -> EP ()
forall a b. (a -> b) -> a -> b
$ [(Pos, EP ())] -> [(Pos, EP ())] -> [(Pos, EP ())]
forall a. [a] -> [a] -> [a]
interleave ([Pos] -> [EP ()] -> [(Pos, EP ())]
forall a b. [a] -> [b] -> [(a, b)]
zip ((SrcSpan -> Pos) -> [SrcSpan] -> [Pos]
forall a b. (a -> b) -> [a] -> [b]
map SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos ([SrcSpan] -> [Pos]) -> [SrcSpan] -> [Pos]
forall a b. (a -> b) -> a -> b
$ [SrcSpan] -> [SrcSpan]
forall a. HasCallStack => [a] -> [a]
init [SrcSpan]
pts) ((String -> EP ()) -> [String] -> [EP ()]
forall a b. (a -> b) -> [a] -> [b]
map String -> EP ()
printString (String
oString -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
forall a. a -> [a]
repeat String
",")) [(Pos, EP ())] -> [(Pos, EP ())] -> [(Pos, EP ())]
forall a. [a] -> [a] -> [a]
++ [(SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos (SrcSpan -> Pos) -> SrcSpan -> Pos
forall a b. (a -> b) -> a -> b
$ [SrcSpan] -> SrcSpan
forall a. HasCallStack => [a] -> a
last [SrcSpan]
pts, String -> EP ()
printString String
e)])
                              ((Maybe (Exp SrcSpanInfo) -> (Pos, EP ()))
-> [Maybe (Exp SrcSpanInfo)] -> [(Pos, EP ())]
forall a b. (a -> b) -> [a] -> [b]
map (Pos -> (Exp SrcSpanInfo -> Pos) -> Maybe (Exp SrcSpanInfo) -> Pos
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int
0,Int
0) (SrcSpanInfo -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos (SrcSpanInfo -> Pos)
-> (Exp SrcSpanInfo -> SrcSpanInfo) -> Exp SrcSpanInfo -> Pos
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp SrcSpanInfo -> SrcSpanInfo
forall l. Exp l -> l
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann) (Maybe (Exp SrcSpanInfo) -> Pos)
-> (Maybe (Exp SrcSpanInfo) -> EP ())
-> Maybe (Exp SrcSpanInfo)
-> (Pos, EP ())
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (Exp SrcSpanInfo -> EP ()) -> Maybe (Exp SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC) [Maybe (Exp SrcSpanInfo)]
mexps)
    List SrcSpanInfo
l [Exp SrcSpanInfo]
es               -> [SrcSpan] -> [Exp SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
squareList (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) [Exp SrcSpanInfo]
es
    ParArray SrcSpanInfo
l [Exp SrcSpanInfo]
es           -> [SrcSpan] -> [Exp SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
squareColonList (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) [Exp SrcSpanInfo]
es
    Paren SrcSpanInfo
l Exp SrcSpanInfo
p               -> [SrcSpan] -> [Exp SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
parenList (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) [Exp SrcSpanInfo
p]
    LeftSection SrcSpanInfo
l Exp SrcSpanInfo
e QOp SrcSpanInfo
qop     ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
_,SrcSpan
b] -> do
            String -> EP ()
printString String
"("
            Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
            QOp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC QOp SrcSpanInfo
qop
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
")"
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: LeftSection is given wrong number of srcInfoPoints"
    RightSection SrcSpanInfo
l QOp SrcSpanInfo
qop Exp SrcSpanInfo
e    ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
_,SrcSpan
b] -> do
            String -> EP ()
printString String
"("
            QOp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC QOp SrcSpanInfo
qop
            Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
")"
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: RightSection is given wrong number of srcInfoPoints"
    RecConstr SrcSpanInfo
l QName SrcSpanInfo
qn [FieldUpdate SrcSpanInfo]
fups     -> do
        let pts :: [SrcSpan]
pts = SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l
        QName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP QName SrcSpanInfo
qn
        [SrcSpan] -> [FieldUpdate SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
curlyList [SrcSpan]
pts [FieldUpdate SrcSpanInfo]
fups
    RecUpdate SrcSpanInfo
l Exp SrcSpanInfo
e [FieldUpdate SrcSpanInfo]
fups      -> do
        let pts :: [SrcSpan]
pts = SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l
        Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Exp SrcSpanInfo
e
        [SrcSpan] -> [FieldUpdate SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
curlyList [SrcSpan]
pts [FieldUpdate SrcSpanInfo]
fups
    EnumFrom SrcSpanInfo
l Exp SrcSpanInfo
e            ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
_,SrcSpan
b,SrcSpan
c] -> do
            String -> EP ()
printString String
"["
            Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
".."
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
c) String
"]"
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: EnumFrom is given wrong number of srcInfoPoints"
    EnumFromTo SrcSpanInfo
l Exp SrcSpanInfo
e1 Exp SrcSpanInfo
e2      ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
_,SrcSpan
b,SrcSpan
c] -> do
            String -> EP ()
printString String
"["
            Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e1
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
".."
            Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e2
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
c) String
"]"
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: EnumFromTo is given wrong number of srcInfoPoints"
    EnumFromThen SrcSpanInfo
l Exp SrcSpanInfo
e1 Exp SrcSpanInfo
e2    ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
_,SrcSpan
b,SrcSpan
c,SrcSpan
d] -> do
            String -> EP ()
printString String
"["
            Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e1
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
","
            Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e2
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
c) String
".."
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
d) String
"]"
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: EnumFromThen is given wrong number of srcInfoPoints"
    EnumFromThenTo SrcSpanInfo
l Exp SrcSpanInfo
e1 Exp SrcSpanInfo
e2 Exp SrcSpanInfo
e3   ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
_,SrcSpan
b,SrcSpan
c,SrcSpan
d] -> do
            String -> EP ()
printString String
"["
            Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e1
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
","
            Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e2
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
c) String
".."
            Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e3
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
d) String
"]"
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: EnumFromToThen is given wrong number of srcInfoPoints"
    ParArrayFromTo SrcSpanInfo
l Exp SrcSpanInfo
e1 Exp SrcSpanInfo
e2      ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
_,SrcSpan
b,SrcSpan
c] -> do
            String -> EP ()
printString String
"[:"
            Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e1
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
".."
            Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e2
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
c) String
":]"
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: ParArrayFromTo is given wrong number of srcInfoPoints"
    ParArrayFromThenTo SrcSpanInfo
l Exp SrcSpanInfo
e1 Exp SrcSpanInfo
e2 Exp SrcSpanInfo
e3   ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
_,SrcSpan
b,SrcSpan
c,SrcSpan
d] -> do
            String -> EP ()
printString String
"[:"
            Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e1
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
","
            Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e2
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
c) String
".."
            Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e3
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
d) String
":]"
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: ParArrayFromToThen is given wrong number of srcInfoPoints"
    ListComp SrcSpanInfo
l Exp SrcSpanInfo
e [QualStmt SrcSpanInfo]
qss            ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         SrcSpan
_:[SrcSpan]
pts -> do
            String -> EP ()
printString String
"["
            Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
            (String, String, String)
-> [SrcSpan] -> [QualStmt SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
(String, String, String) -> [SrcSpan] -> [ast SrcSpanInfo] -> EP ()
bracketList (String
"|",String
",",String
"]") [SrcSpan]
pts [QualStmt SrcSpanInfo]
qss
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: ListComp is given too few srcInfoPoints"
    ParComp  SrcSpanInfo
l Exp SrcSpanInfo
e [[QualStmt SrcSpanInfo]]
qsss           ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         SrcSpan
_:[SrcSpan]
pts -> do
            let ([String]
strs, [QualStmt SrcSpanInfo]
qss) = [(String, QualStmt SrcSpanInfo)]
-> ([String], [QualStmt SrcSpanInfo])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(String, QualStmt SrcSpanInfo)]
 -> ([String], [QualStmt SrcSpanInfo]))
-> [(String, QualStmt SrcSpanInfo)]
-> ([String], [QualStmt SrcSpanInfo])
forall a b. (a -> b) -> a -> b
$ [[QualStmt SrcSpanInfo]] -> [(String, QualStmt SrcSpanInfo)]
forall {b}. [[b]] -> [(String, b)]
pairUp [[QualStmt SrcSpanInfo]]
qsss
            String -> EP ()
printString String
"["
            Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
            [(SrcSpan, String)] -> [QualStmt SrcSpanInfo] -> EP ()
forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved ([SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SrcSpan]
pts ([String]
strs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"]"])) [QualStmt SrcSpanInfo]
qss
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: ParComp is given wrong number of srcInfoPoints"
      where pairUp :: [[b]] -> [(String, b)]
pairUp [] = []
            pairUp ((b
a:[b]
as):[[b]]
xs) = (String
"|", b
a) (String, b) -> [(String, b)] -> [(String, b)]
forall a. a -> [a] -> [a]
: [String] -> [b] -> [(String, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip (String -> [String]
forall a. a -> [a]
repeat String
",") [b]
as [(String, b)] -> [(String, b)] -> [(String, b)]
forall a. [a] -> [a] -> [a]
++ [[b]] -> [(String, b)]
pairUp [[b]]
xs
            pairUp [[b]]
_ = String -> [(String, b)]
forall a. String -> a
internalError String
"Exp -> ParComp -> pairUp"
    ParArrayComp  SrcSpanInfo
l Exp SrcSpanInfo
e [[QualStmt SrcSpanInfo]]
qsss           ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         SrcSpan
_:[SrcSpan]
pts -> do
            let ([String]
strs, [QualStmt SrcSpanInfo]
qss) = [(String, QualStmt SrcSpanInfo)]
-> ([String], [QualStmt SrcSpanInfo])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(String, QualStmt SrcSpanInfo)]
 -> ([String], [QualStmt SrcSpanInfo]))
-> [(String, QualStmt SrcSpanInfo)]
-> ([String], [QualStmt SrcSpanInfo])
forall a b. (a -> b) -> a -> b
$ [[QualStmt SrcSpanInfo]] -> [(String, QualStmt SrcSpanInfo)]
forall {b}. [[b]] -> [(String, b)]
pairUp [[QualStmt SrcSpanInfo]]
qsss
            String -> EP ()
printString String
"[:"
            Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
            [(SrcSpan, String)] -> [QualStmt SrcSpanInfo] -> EP ()
forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved ([SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SrcSpan]
pts ([String]
strs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
":]"])) [QualStmt SrcSpanInfo]
qss
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: ParArrayComp is given wrong number of srcInfoPoints"
      where pairUp :: [[b]] -> [(String, b)]
pairUp [] = []
            pairUp ((b
a:[b]
as):[[b]]
xs) = (String
"|", b
a) (String, b) -> [(String, b)] -> [(String, b)]
forall a. a -> [a] -> [a]
: [String] -> [b] -> [(String, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip (String -> [String]
forall a. a -> [a]
repeat String
"|") [b]
as [(String, b)] -> [(String, b)] -> [(String, b)]
forall a. [a] -> [a] -> [a]
++ [[b]] -> [(String, b)]
pairUp [[b]]
xs
            pairUp [[b]]
_ = String -> [(String, b)]
forall a. String -> a
internalError String
"Exp -> ParArrayComp -> pairUp"

    ExpTypeSig SrcSpanInfo
l Exp SrcSpanInfo
e Type SrcSpanInfo
t    ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
a] -> do
            Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Exp SrcSpanInfo
e
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"::"
            Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: ExpTypeSig is given wrong number of srcInfoPoints"
    VarQuote SrcSpanInfo
_ QName SrcSpanInfo
qn   -> do
      String -> EP ()
printString String
"'"
      QName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC QName SrcSpanInfo
qn
    TypQuote SrcSpanInfo
_ QName SrcSpanInfo
qn -> do
      String -> EP ()
printString String
"''"
      QName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC QName SrcSpanInfo
qn
    BracketExp SrcSpanInfo
_ Bracket SrcSpanInfo
br -> Bracket SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Bracket SrcSpanInfo
br
    SpliceExp SrcSpanInfo
_ Splice SrcSpanInfo
sp  -> Splice SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Splice SrcSpanInfo
sp
    QuasiQuote SrcSpanInfo
_ String
name String
qt    -> do
        let qtLines :: [String]
qtLines = String -> [String]
lines String
qt
        String -> EP ()
printString (String -> EP ()) -> String -> EP ()
forall a b. (a -> b) -> a -> b
$ String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"|"
        [EP ()] -> EP ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ (EP () -> [EP ()] -> [EP ()]
forall a. a -> [a] -> [a]
intersperse EP ()
newLine ([EP ()] -> [EP ()]) -> [EP ()] -> [EP ()]
forall a b. (a -> b) -> a -> b
$ (String -> EP ()) -> [String] -> [EP ()]
forall a b. (a -> b) -> [a] -> [b]
map String -> EP ()
printString [String]
qtLines)
        String -> EP ()
printString String
"|]"
    XTag SrcSpanInfo
l XName SrcSpanInfo
xn [XAttr SrcSpanInfo]
attrs Maybe (Exp SrcSpanInfo)
mat [Exp SrcSpanInfo]
es  ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
_,SrcSpan
b,SrcSpan
c,SrcSpan
d,SrcSpan
e] -> do
            String -> EP ()
printString String
"<"
            XName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC XName SrcSpanInfo
xn
            (XAttr SrcSpanInfo -> EP ()) -> [XAttr SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ XAttr SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [XAttr SrcSpanInfo]
attrs
            (Exp SrcSpanInfo -> EP ()) -> Maybe (Exp SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (Exp SrcSpanInfo)
mat
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
">"
            (Exp SrcSpanInfo -> EP ()) -> [Exp SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [Exp SrcSpanInfo]
es
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
c) String
"</"
            Pos -> EP ()
printWhitespace (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
d)
            XName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP XName SrcSpanInfo
xn
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
e) String
">"
         -- TODO: Fugly hack/duplication, should be refactored
         -- For the case when there's an optional semicolon
         [SrcSpan
_,SrcSpan
b,SrcSpan
semi,SrcSpan
c,SrcSpan
d,SrcSpan
e] -> do
            String -> EP ()
printString String
"<"
            XName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC XName SrcSpanInfo
xn
            (XAttr SrcSpanInfo -> EP ()) -> [XAttr SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ XAttr SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [XAttr SrcSpanInfo]
attrs
            (Exp SrcSpanInfo -> EP ()) -> Maybe (Exp SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (Exp SrcSpanInfo)
mat
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
">"
            (Exp SrcSpanInfo -> EP ()) -> [Exp SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [Exp SrcSpanInfo]
es
            SrcSpan -> EP ()
printSemi SrcSpan
semi
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
c) String
"</"
            Pos -> EP ()
printWhitespace (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
d)
            XName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP XName SrcSpanInfo
xn
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
e) String
">"
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: XTag is given wrong number of srcInfoPoints"
    XETag SrcSpanInfo
l XName SrcSpanInfo
xn [XAttr SrcSpanInfo]
attrs Maybe (Exp SrcSpanInfo)
mat    ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
_,SrcSpan
b] -> do
            String -> EP ()
printString String
"<"
            XName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC XName SrcSpanInfo
xn
            (XAttr SrcSpanInfo -> EP ()) -> [XAttr SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ XAttr SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [XAttr SrcSpanInfo]
attrs
            (Exp SrcSpanInfo -> EP ()) -> Maybe (Exp SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (Exp SrcSpanInfo)
mat
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"/>"
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: XETag is given wrong number of srcInfoPoints"
    XPcdata SrcSpanInfo
_ String
str   -> do
        let strLines :: [String]
strLines = String -> [String]
lines String
str
        [EP ()] -> EP ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ (EP () -> [EP ()] -> [EP ()]
forall a. a -> [a] -> [a]
intersperse EP ()
newLine ([EP ()] -> [EP ()]) -> [EP ()] -> [EP ()]
forall a b. (a -> b) -> a -> b
$ (String -> EP ()) -> [String] -> [EP ()]
forall a b. (a -> b) -> [a] -> [b]
map String -> EP ()
printString [String]
strLines)
    XExpTag SrcSpanInfo
l Exp SrcSpanInfo
e     ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
_,SrcSpan
b] -> do
            String -> EP ()
printString String
"<%"
            Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"%>"
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: XExpTag is given wrong number of srcInfoPoints"
    XChildTag SrcSpanInfo
l [Exp SrcSpanInfo]
es  ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
_,SrcSpan
b,SrcSpan
c] -> do
            String -> EP ()
printString String
"<%>"
            (Exp SrcSpanInfo -> EP ()) -> [Exp SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [Exp SrcSpanInfo]
es
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"</"
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
c) String
"%>"
         -- Ugly duplication for when there's an optional semi
         [SrcSpan
_,SrcSpan
semi,SrcSpan
b,SrcSpan
c] -> do
            String -> EP ()
printString String
"<%>"
            (Exp SrcSpanInfo -> EP ()) -> [Exp SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [Exp SrcSpanInfo]
es
            SrcSpan -> EP ()
printSemi SrcSpan
semi
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"</"
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
c) String
"%>"
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: XChildTag is given wrong number of srcInfoPoints"
    CorePragma SrcSpanInfo
l      String
str Exp SrcSpanInfo
e         ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
_,SrcSpan
b] -> do
            String -> EP ()
printString (String -> EP ()) -> String -> EP ()
forall a b. (a -> b) -> a -> b
$ String
"{-# CORE " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
str
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"#-}"
            Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: CorePragma is given wrong number of srcInfoPoints"
    SCCPragma  SrcSpanInfo
l      String
str Exp SrcSpanInfo
e         ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
_,SrcSpan
b] -> do
            String -> EP ()
printString (String -> EP ()) -> String -> EP ()
forall a b. (a -> b) -> a -> b
$ String
"{-# SCC " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
str
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"#-}"
            Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: SCCPragma is given wrong number of srcInfoPoints"
    GenPragma  SrcSpanInfo
l      String
str (Int
i1,Int
i2) (Int
i3,Int
i4) Exp SrcSpanInfo
e -> do
        [(SrcSpan, String)] -> EP ()
forall loc. SrcInfo loc => [(loc, String)] -> EP ()
printStrs ([(SrcSpan, String)] -> EP ()) -> [(SrcSpan, String)] -> EP ()
forall a b. (a -> b) -> a -> b
$ [SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) [String
"{-# GENERATED", ShowS
forall a. Show a => a -> String
show String
str, Int -> String
forall a. Show a => a -> String
show Int
i1, String
":", Int -> String
forall a. Show a => a -> String
show Int
i2, String
"-", Int -> String
forall a. Show a => a -> String
show Int
i3, String
":", Int -> String
forall a. Show a => a -> String
show Int
i4, String
"#-}"]
        Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
    Proc            SrcSpanInfo
l Pat SrcSpanInfo
p Exp SrcSpanInfo
e   ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
_,SrcSpan
b] -> do
            String -> EP ()
printString String
"proc"
            Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Pat SrcSpanInfo
p
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"->"
            Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: Proc is given wrong number of srcInfoPoints"
    LeftArrApp      SrcSpanInfo
l Exp SrcSpanInfo
e1 Exp SrcSpanInfo
e2 ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
a] -> do
            Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Exp SrcSpanInfo
e1
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"-<"
            Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e2
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: LeftArrApp is given wrong number of srcInfoPoints"
    RightArrApp     SrcSpanInfo
l Exp SrcSpanInfo
e1 Exp SrcSpanInfo
e2 ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
a] -> do
            Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Exp SrcSpanInfo
e1
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
">-"
            Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e2
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: RightArrApp is given wrong number of srcInfoPoints"
    LeftArrHighApp  SrcSpanInfo
l Exp SrcSpanInfo
e1 Exp SrcSpanInfo
e2 ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
a] -> do
            Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Exp SrcSpanInfo
e1
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"-<<"
            Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e2
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: LeftArrHighApp is given wrong number of srcInfoPoints"
    RightArrHighApp SrcSpanInfo
l Exp SrcSpanInfo
e1 Exp SrcSpanInfo
e2 ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
a] -> do
            Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Exp SrcSpanInfo
e1
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
">>-"
            Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e2
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: RightArrHighApp is given wrong number of srcInfoPoints"

    ArrOp SrcSpanInfo
l Exp SrcSpanInfo
e -> case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
      [SrcSpan
a, SrcSpan
b] -> do
        Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"(|"
        Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
        Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"|)"
      [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: ArrOp is given wrong number of srcInfoPoints"

    LCase SrcSpanInfo
l [Alt SrcSpanInfo]
alts   ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         SrcSpan
_:SrcSpan
b:[SrcSpan]
pts -> do
            String -> EP ()
printString String
"\\"
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"case"
            [SrcSpan] -> [Alt SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
layoutList [SrcSpan]
pts [Alt SrcSpanInfo]
alts
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Exp: LCase is given wrong number of srcInfoPoints"
    TypeApp SrcSpanInfo
_ Type SrcSpanInfo
ty -> String -> EP ()
printString String
"@" EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
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 :: forall (e :: * -> *).
ExactP e =>
SrcSpanInfo -> Int -> Int -> e SrcSpanInfo -> EP ()
unboxedSumEP SrcSpanInfo
l Int
b Int
_a e SrcSpanInfo
es = do
        let (SrcSpan
opt:[SrcSpan]
pts) = SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l
            (String
o, String
e) = (String
"(#", String
"#)")
            bars :: [(Pos, EP ())]
bars = [Pos] -> [EP ()] -> [(Pos, EP ())]
forall a b. [a] -> [b] -> [(a, b)]
zip ((SrcSpan -> Pos) -> [SrcSpan] -> [Pos]
forall a b. (a -> b) -> [a] -> [b]
map SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos ([SrcSpan] -> [SrcSpan]
forall a. HasCallStack => [a] -> [a]
init [SrcSpan]
pts)) ((String -> EP ()) -> [String] -> [EP ()]
forall a b. (a -> b) -> [a] -> [b]
map String -> EP ()
printString (String -> [String]
forall a. a -> [a]
repeat String
"|"))
            open :: (Pos, EP ())
open = (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
opt, String -> EP ()
printString String
o)
            close :: (Pos, EP ())
close = (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos ([SrcSpan] -> SrcSpan
forall a. HasCallStack => [a] -> a
last [SrcSpan]
pts), String -> EP ()
printString String
e)
            fs :: [(Pos, EP ())]
fs = Int -> [(Pos, EP ())] -> [(Pos, EP ())]
forall a. Int -> [a] -> [a]
take Int
b [(Pos, EP ())]
bars
            as :: [(Pos, EP ())]
as = Int -> [(Pos, EP ())] -> [(Pos, EP ())]
forall a. Int -> [a] -> [a]
drop Int
b [(Pos, EP ())]
bars
        [(Pos, EP ())] -> EP ()
printSeq ([(Pos, EP ())] -> EP ()) -> [(Pos, EP ())] -> EP ()
forall a b. (a -> b) -> a -> b
$ (Pos, EP ())
open (Pos, EP ()) -> [(Pos, EP ())] -> [(Pos, EP ())]
forall a. a -> [a] -> [a]
: [(Pos, EP ())]
fs [(Pos, EP ())] -> [(Pos, EP ())] -> [(Pos, EP ())]
forall a. [a] -> [a] -> [a]
++ [((Int
0, Int
0), e SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC e SrcSpanInfo
es)] [(Pos, EP ())] -> [(Pos, EP ())] -> [(Pos, EP ())]
forall a. [a] -> [a] -> [a]
++ [(Pos, EP ())]
as [(Pos, EP ())] -> [(Pos, EP ())] -> [(Pos, EP ())]
forall a. [a] -> [a] -> [a]
++ [(Pos, EP ())
close]

instance ExactP FieldUpdate where
  exactP :: FieldUpdate SrcSpanInfo -> EP ()
exactP FieldUpdate SrcSpanInfo
fup = case FieldUpdate SrcSpanInfo
fup of
    FieldUpdate SrcSpanInfo
l QName SrcSpanInfo
qn Exp SrcSpanInfo
e  ->
      case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
       [SrcSpan
a] -> do
          QName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP QName SrcSpanInfo
qn
          Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"="
          Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
       [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: FieldUpdate is given wrong number of srcInfoPoints"
    FieldPun SrcSpanInfo
_ QName SrcSpanInfo
n    -> QName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP QName SrcSpanInfo
n
    FieldWildcard SrcSpanInfo
_ -> String -> EP ()
printString String
".."

instance ExactP Stmt where
  exactP :: Stmt SrcSpanInfo -> EP ()
exactP Stmt SrcSpanInfo
stmt = case Stmt SrcSpanInfo
stmt of
    Generator SrcSpanInfo
l Pat SrcSpanInfo
p Exp SrcSpanInfo
e ->
      case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
       [SrcSpan
a] -> do
          Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Pat SrcSpanInfo
p
          Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"<-"
          Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
       [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Stmt: Generator is given wrong number of srcInfoPoints"
    Qualifier SrcSpanInfo
_ Exp SrcSpanInfo
e -> Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Exp SrcSpanInfo
e
    LetStmt SrcSpanInfo
_ Binds SrcSpanInfo
bds   -> do
      String -> EP ()
printString String
"let"
      Binds SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Binds SrcSpanInfo
bds
    RecStmt SrcSpanInfo
l [Stmt SrcSpanInfo]
ss    ->
      case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
       SrcSpan
_:[SrcSpan]
pts -> do
          String -> EP ()
printString String
"rec"
          [SrcSpan] -> [Stmt SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
layoutList [SrcSpan]
pts [Stmt SrcSpanInfo]
ss
       [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Stmt: RecStmt is given too few srcInfoPoints"

instance ExactP QualStmt where
  exactP :: QualStmt SrcSpanInfo -> EP ()
exactP QualStmt SrcSpanInfo
qstmt = case QualStmt SrcSpanInfo
qstmt of
    QualStmt     SrcSpanInfo
_ Stmt SrcSpanInfo
stmt -> Stmt SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Stmt SrcSpanInfo
stmt
    ThenTrans    SrcSpanInfo
_ Exp SrcSpanInfo
e    -> String -> EP ()
printString String
"then" EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
    ThenBy      SrcSpanInfo
l Exp SrcSpanInfo
e1 Exp SrcSpanInfo
e2 ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
_,SrcSpan
b] -> do
            String -> EP ()
printString String
"then"
            Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e1
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"by"
            Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e2
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: QualStmt: ThenBy is given wrong number of srcInfoPoints"
    GroupBy      SrcSpanInfo
l Exp SrcSpanInfo
e        -> do
        [(SrcSpan, String)] -> EP ()
forall loc. SrcInfo loc => [(loc, String)] -> EP ()
printStrs ([(SrcSpan, String)] -> EP ()) -> [(SrcSpan, String)] -> EP ()
forall a b. (a -> b) -> a -> b
$ [SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) [String
"then",String
"group",String
"by"]
        Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
    GroupUsing   SrcSpanInfo
l Exp SrcSpanInfo
e        -> do
        [(SrcSpan, String)] -> EP ()
forall loc. SrcInfo loc => [(loc, String)] -> EP ()
printStrs ([(SrcSpan, String)] -> EP ()) -> [(SrcSpan, String)] -> EP ()
forall a b. (a -> b) -> a -> b
$ [SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) [String
"then",String
"group",String
"using"]
        Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
    GroupByUsing SrcSpanInfo
l Exp SrcSpanInfo
e1 Exp SrcSpanInfo
e2    -> do
        let pts :: [SrcSpan]
pts = SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l
        [(SrcSpan, String)] -> EP ()
forall loc. SrcInfo loc => [(loc, String)] -> EP ()
printStrs ([(SrcSpan, String)] -> EP ()) -> [(SrcSpan, String)] -> EP ()
forall a b. (a -> b) -> a -> b
$ [SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([SrcSpan] -> [SrcSpan]
forall a. HasCallStack => [a] -> [a]
init [SrcSpan]
pts) [String
"then",String
"group",String
"by"]
        Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e1
        Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos ([SrcSpan] -> SrcSpan
forall a. HasCallStack => [a] -> a
last [SrcSpan]
pts)) String
"using"
        Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e2

instance ExactP Bracket where
  exactP :: Bracket SrcSpanInfo -> EP ()
exactP Bracket SrcSpanInfo
br = case Bracket SrcSpanInfo
br of
    ExpBracket SrcSpanInfo
l Exp SrcSpanInfo
e  -> String
-> String -> String -> SrcSpanInfo -> Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *).
ExactP ast =>
String
-> String -> String -> SrcSpanInfo -> ast SrcSpanInfo -> EP ()
printBracket String
"ExpBracket" String
"[|" String
"|]" SrcSpanInfo
l Exp SrcSpanInfo
e
    TExpBracket SrcSpanInfo
l Exp SrcSpanInfo
e -> String
-> String -> String -> SrcSpanInfo -> Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *).
ExactP ast =>
String
-> String -> String -> SrcSpanInfo -> ast SrcSpanInfo -> EP ()
printBracket String
"TExpBracket" String
"[||" String
"||]" SrcSpanInfo
l Exp SrcSpanInfo
e
    PatBracket SrcSpanInfo
l Pat SrcSpanInfo
p  -> String
-> String -> String -> SrcSpanInfo -> Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *).
ExactP ast =>
String
-> String -> String -> SrcSpanInfo -> ast SrcSpanInfo -> EP ()
printBracket String
"PatBracket" String
"[p|" String
"|]" SrcSpanInfo
l Pat SrcSpanInfo
p
    TypeBracket SrcSpanInfo
l Type SrcSpanInfo
t -> String
-> String -> String -> SrcSpanInfo -> Type SrcSpanInfo -> EP ()
forall (ast :: * -> *).
ExactP ast =>
String
-> String -> String -> SrcSpanInfo -> ast SrcSpanInfo -> EP ()
printBracket String
"TypeBracket" String
"[t|" String
"|]" SrcSpanInfo
l Type SrcSpanInfo
t
    DeclBracket SrcSpanInfo
l [Decl SrcSpanInfo]
ds ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         pts :: [SrcSpan]
pts@(SrcSpan
_:[SrcSpan]
_) -> do
            String -> EP ()
printString String
"[d|"
            [SrcSpan] -> [Decl SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
layoutList ([SrcSpan] -> [SrcSpan]
forall a. HasCallStack => [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. HasCallStack => [a] -> a
last [SrcSpan]
pts)) String
"|]"
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Bracket: DeclBracket is given too few srcInfoPoints"

printBracket :: ExactP ast => String -> String -> String -> SrcSpanInfo -> ast SrcSpanInfo -> EP ()
printBracket :: forall (ast :: * -> *).
ExactP ast =>
String
-> String -> String -> SrcSpanInfo -> ast SrcSpanInfo -> EP ()
printBracket String
con String
oBracket String
cBracket SrcSpanInfo
l ast SrcSpanInfo
c =
  case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
    [SrcSpan
_,SrcSpan
b] -> do
      String -> EP ()
printString String
oBracket
      ast SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC ast SrcSpanInfo
c
      Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
cBracket
    [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP (String -> EP ()) -> String -> EP ()
forall a b. (a -> b) -> a -> b
$ String
"ExactP: Bracket: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
con String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is given wrong number of srcInfoPoints"

instance ExactP XAttr where
  exactP :: XAttr SrcSpanInfo -> EP ()
exactP (XAttr SrcSpanInfo
l XName SrcSpanInfo
xn Exp SrcSpanInfo
e) =
    case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
     [SrcSpan
a] -> do
        XName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP XName SrcSpanInfo
xn
        Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"="
        Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
     [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: XAttr is given wrong number of srcInfoPoints"

instance ExactP Alt where
  exactP :: Alt SrcSpanInfo -> EP ()
exactP (Alt SrcSpanInfo
l Pat SrcSpanInfo
p Rhs SrcSpanInfo
galts Maybe (Binds SrcSpanInfo)
mbs) = do
    Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Pat SrcSpanInfo
p
    GuardedAlts SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC (Rhs SrcSpanInfo -> GuardedAlts SrcSpanInfo
forall l. Rhs l -> GuardedAlts l
GuardedAlts Rhs SrcSpanInfo
galts)
    (Binds SrcSpanInfo -> EP ()) -> Maybe (Binds SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP (\Binds SrcSpanInfo
bs -> Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos ([SrcSpan] -> SrcSpan
forall a. HasCallStack => [a] -> a
head (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l))) String
"where" EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Binds SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Binds SrcSpanInfo
bs) Maybe (Binds SrcSpanInfo)
mbs

instance ExactP Match where
  exactP :: Match SrcSpanInfo -> EP ()
exactP (Match SrcSpanInfo
l Name SrcSpanInfo
n [Pat SrcSpanInfo]
ps Rhs SrcSpanInfo
rhs Maybe (Binds SrcSpanInfo)
mbinds) = do
    let pts :: [SrcSpan]
pts = SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l
        len :: Int
len = [SrcSpan] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SrcSpan]
pts
        pars :: Int
pars = Int
len Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
        ([SrcSpan]
oPars,[SrcSpan]
cParsWh) = Int -> [SrcSpan] -> ([SrcSpan], [SrcSpan])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
pars [SrcSpan]
pts
        ([SrcSpan]
cPars,[SrcSpan]
_) = Int -> [SrcSpan] -> ([SrcSpan], [SrcSpan])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
pars [SrcSpan]
cParsWh    -- _§ is either singleton or empty
    [(SrcSpan, String)] -> EP ()
forall loc. SrcInfo loc => [(loc, String)] -> EP ()
printStrs ([SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SrcSpan]
oPars (String -> [String]
forall a. a -> [a]
repeat String
"("))
    Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Name SrcSpanInfo
n
    [(Pos, EP ())] -> [(Pos, EP ())] -> EP ()
printStreams ([Pos] -> [EP ()] -> [(Pos, EP ())]
forall a b. [a] -> [b] -> [(a, b)]
zip ((SrcSpan -> Pos) -> [SrcSpan] -> [Pos]
forall a b. (a -> b) -> [a] -> [b]
map SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos [SrcSpan]
cPars) (EP () -> [EP ()]
forall a. a -> [a]
repeat (EP () -> [EP ()]) -> EP () -> [EP ()]
forall a b. (a -> b) -> a -> b
$ String -> EP ()
printString String
")")) ((Pat SrcSpanInfo -> (Pos, EP ()))
-> [Pat SrcSpanInfo] -> [(Pos, EP ())]
forall a b. (a -> b) -> [a] -> [b]
map (SrcSpanInfo -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos (SrcSpanInfo -> Pos)
-> (Pat SrcSpanInfo -> SrcSpanInfo) -> Pat SrcSpanInfo -> Pos
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pat SrcSpanInfo -> SrcSpanInfo
forall l. Pat l -> l
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann (Pat SrcSpanInfo -> Pos)
-> (Pat SrcSpanInfo -> EP ()) -> Pat SrcSpanInfo -> (Pos, EP ())
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC) [Pat SrcSpanInfo]
ps)
    Rhs SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Rhs SrcSpanInfo
rhs
    (Binds SrcSpanInfo -> EP ()) -> Maybe (Binds SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP (\Binds SrcSpanInfo
bds -> Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos ([SrcSpan] -> SrcSpan
forall a. HasCallStack => [a] -> a
head [SrcSpan]
pts)) String
"where" EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Binds SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Binds SrcSpanInfo
bds) Maybe (Binds SrcSpanInfo)
mbinds
  exactP (InfixMatch SrcSpanInfo
l Pat SrcSpanInfo
a Name SrcSpanInfo
n [Pat SrcSpanInfo]
bs Rhs SrcSpanInfo
rhs Maybe (Binds SrcSpanInfo)
mbinds) = do
    let pts :: [SrcSpan]
pts = SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l
        len :: Int
len = [SrcSpan] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SrcSpan]
pts
        pars :: Int
pars = Int
len Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
        ([SrcSpan]
oPars,[SrcSpan]
cParsWh) = Int -> [SrcSpan] -> ([SrcSpan], [SrcSpan])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
pars [SrcSpan]
pts
        ([SrcSpan]
cPars,[SrcSpan]
whPt) = Int -> [SrcSpan] -> ([SrcSpan], [SrcSpan])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
pars [SrcSpan]
cParsWh    -- whPt is either singleton or empty
    [(SrcSpan, String)] -> EP ()
forall loc. SrcInfo loc => [(loc, String)] -> EP ()
printStrs ([SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SrcSpan]
oPars (String -> [String]
forall a. a -> [a]
repeat String
"("))
    Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Pat SrcSpanInfo
a
    Name SrcSpanInfo -> EP ()
epInfixName Name SrcSpanInfo
n
    [(SrcSpan, String)] -> [Pat SrcSpanInfo] -> EP ()
forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved' ([SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SrcSpan]
cPars (String -> [String]
forall a. a -> [a]
repeat String
")")) [Pat SrcSpanInfo]
bs
    Rhs SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Rhs SrcSpanInfo
rhs
    (Binds SrcSpanInfo -> EP ()) -> Maybe (Binds SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP (\Binds SrcSpanInfo
bds -> Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos ([SrcSpan] -> SrcSpan
forall a. HasCallStack => [a] -> a
head [SrcSpan]
whPt)) String
"where" EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Binds SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Binds SrcSpanInfo
bds) Maybe (Binds SrcSpanInfo)
mbinds

instance ExactP Rhs where
  exactP :: Rhs SrcSpanInfo -> EP ()
exactP (UnGuardedRhs SrcSpanInfo
_ Exp SrcSpanInfo
e) = String -> EP ()
printString String
"=" EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
  exactP (GuardedRhss  SrcSpanInfo
_ [GuardedRhs SrcSpanInfo]
grhss) = (GuardedRhs SrcSpanInfo -> EP ())
-> [GuardedRhs SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ GuardedRhs SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [GuardedRhs SrcSpanInfo]
grhss

instance ExactP GuardedRhs where
  exactP :: GuardedRhs SrcSpanInfo -> EP ()
exactP (GuardedRhs SrcSpanInfo
l [Stmt SrcSpanInfo]
ss Exp SrcSpanInfo
e) =
    case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
     SrcSpan
_:[SrcSpan]
pts -> do
        String -> EP ()
printString String
"|"
        [(SrcSpan, String)] -> [Stmt SrcSpanInfo] -> EP ()
forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved' ([SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([SrcSpan] -> [SrcSpan]
forall a. HasCallStack => [a] -> [a]
init [SrcSpan]
pts) (String -> [String]
forall a. a -> [a]
repeat String
",") [(SrcSpan, String)] -> [(SrcSpan, String)] -> [(SrcSpan, String)]
forall a. [a] -> [a] -> [a]
++ [([SrcSpan] -> SrcSpan
forall a. HasCallStack => [a] -> a
last [SrcSpan]
pts, String
"=")]) [Stmt SrcSpanInfo]
ss
        Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
     [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: GuardedRhs is given wrong number of srcInfoPoints"

newtype GuardedAlts l = GuardedAlts (Rhs l)
    deriving ((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
$cfmap :: forall a b. (a -> b) -> GuardedAlts a -> GuardedAlts b
fmap :: forall a b. (a -> b) -> GuardedAlts a -> GuardedAlts b
$c<$ :: forall a b. a -> GuardedAlts b -> GuardedAlts a
<$ :: forall a b. a -> GuardedAlts b -> GuardedAlts a
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
$cshowsPrec :: forall l. Show l => Int -> GuardedAlts l -> ShowS
showsPrec :: Int -> GuardedAlts l -> ShowS
$cshow :: forall l. Show l => GuardedAlts l -> String
show :: GuardedAlts l -> String
$cshowList :: forall l. Show l => [GuardedAlts l] -> ShowS
showList :: [GuardedAlts l] -> ShowS
Show)
instance Annotated GuardedAlts where
    amap :: forall l. (l -> l) -> GuardedAlts l -> GuardedAlts l
amap l -> l
f (GuardedAlts Rhs l
v) = Rhs l -> GuardedAlts l
forall l. Rhs l -> GuardedAlts l
GuardedAlts ((l -> l) -> Rhs l -> Rhs l
forall l. (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 :: forall l. GuardedAlts l -> l
ann (GuardedAlts Rhs l
v) = Rhs l -> l
forall l. Rhs l -> l
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann Rhs l
v

newtype GuardedAlt l = GuardedAlt (GuardedRhs l)
    deriving ((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
$cfmap :: forall a b. (a -> b) -> GuardedAlt a -> GuardedAlt b
fmap :: forall a b. (a -> b) -> GuardedAlt a -> GuardedAlt b
$c<$ :: forall a b. a -> GuardedAlt b -> GuardedAlt a
<$ :: forall a b. a -> GuardedAlt b -> GuardedAlt a
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
$cshowsPrec :: forall l. Show l => Int -> GuardedAlt l -> ShowS
showsPrec :: Int -> GuardedAlt l -> ShowS
$cshow :: forall l. Show l => GuardedAlt l -> String
show :: GuardedAlt l -> String
$cshowList :: forall l. Show l => [GuardedAlt l] -> ShowS
showList :: [GuardedAlt l] -> ShowS
Show)
instance Annotated GuardedAlt where
    amap :: forall l. (l -> l) -> GuardedAlt l -> GuardedAlt l
amap l -> l
f (GuardedAlt GuardedRhs l
v) = GuardedRhs l -> GuardedAlt l
forall l. GuardedRhs l -> GuardedAlt l
GuardedAlt ((l -> l) -> GuardedRhs l -> GuardedRhs l
forall l. (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 :: forall l. GuardedAlt l -> l
ann (GuardedAlt GuardedRhs l
v) = GuardedRhs l -> l
forall l. GuardedRhs l -> l
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann GuardedRhs l
v

instance ExactP GuardedAlts where
  exactP :: GuardedAlts SrcSpanInfo -> EP ()
exactP (GuardedAlts (UnGuardedRhs SrcSpanInfo
_ Exp SrcSpanInfo
e)) = String -> EP ()
printString String
"->" EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
  exactP (GuardedAlts (GuardedRhss  SrcSpanInfo
_ [GuardedRhs SrcSpanInfo]
grhss)) = (GuardedRhs SrcSpanInfo -> EP ())
-> [GuardedRhs SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (GuardedAlt SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC (GuardedAlt SrcSpanInfo -> EP ())
-> (GuardedRhs SrcSpanInfo -> GuardedAlt SrcSpanInfo)
-> GuardedRhs SrcSpanInfo
-> EP ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GuardedRhs SrcSpanInfo -> GuardedAlt SrcSpanInfo
forall l. GuardedRhs l -> GuardedAlt l
GuardedAlt) [GuardedRhs SrcSpanInfo]
grhss

instance ExactP GuardedAlt where
  exactP :: GuardedAlt SrcSpanInfo -> EP ()
exactP (GuardedAlt (GuardedRhs SrcSpanInfo
l [Stmt SrcSpanInfo]
ss Exp SrcSpanInfo
e)) =
    case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
     SrcSpan
_:[SrcSpan]
pts -> do
        String -> EP ()
printString String
"|"
        [(SrcSpan, String)] -> [Stmt SrcSpanInfo] -> EP ()
forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved' ([SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([SrcSpan] -> [SrcSpan]
forall a. HasCallStack => [a] -> [a]
init [SrcSpan]
pts) (String -> [String]
forall a. a -> [a]
repeat String
",") [(SrcSpan, String)] -> [(SrcSpan, String)] -> [(SrcSpan, String)]
forall a. [a] -> [a] -> [a]
++ [([SrcSpan] -> SrcSpan
forall a. HasCallStack => [a] -> a
last [SrcSpan]
pts, String
"->")]) [Stmt SrcSpanInfo]
ss
        Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
     [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: GuardedAlt is given wrong number of srcInfoPoints"

instance ExactP Pat where
  exactP :: Pat SrcSpanInfo -> EP ()
exactP Pat SrcSpanInfo
pat = case Pat SrcSpanInfo
pat of
    PVar SrcSpanInfo
l Name SrcSpanInfo
n    -> Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC ((SrcSpanInfo -> SrcSpanInfo)
-> Name SrcSpanInfo -> Name SrcSpanInfo
forall a b. (a -> b) -> Name a -> Name b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SrcSpanInfo -> SrcSpanInfo -> SrcSpanInfo
forall a b. a -> b -> a
const SrcSpanInfo
l) Name SrcSpanInfo
n)
    PLit SrcSpanInfo
_ Sign SrcSpanInfo
sg Literal SrcSpanInfo
lit -> Sign SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Sign SrcSpanInfo
sg EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Literal SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Literal SrcSpanInfo
lit
    PNPlusK SrcSpanInfo
l Name SrcSpanInfo
n Integer
k   ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
a,SrcSpan
b] -> do
            Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Name SrcSpanInfo
n
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"+"
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) (Integer -> String
forall a. Show a => a -> String
show Integer
k)
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Pat: PNPlusK is given wrong number of srcInfoPoints"
    PInfixApp SrcSpanInfo
_ Pat SrcSpanInfo
pa QName SrcSpanInfo
qn Pat SrcSpanInfo
pb -> Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Pat SrcSpanInfo
pa EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> QName SrcSpanInfo -> EP ()
epInfixQName QName SrcSpanInfo
qn EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Pat SrcSpanInfo
pb
    PApp SrcSpanInfo
_ QName SrcSpanInfo
qn [Pat SrcSpanInfo]
ps    -> QName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP QName SrcSpanInfo
qn EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Pat SrcSpanInfo -> EP ()) -> [Pat SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [Pat SrcSpanInfo]
ps
    PTuple SrcSpanInfo
l Boxed
bx [Pat SrcSpanInfo]
ps ->
        case Boxed
bx of
          Boxed
Boxed   -> [SrcSpan] -> [Pat SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
parenList (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) [Pat SrcSpanInfo]
ps
          Boxed
Unboxed -> [SrcSpan] -> [Pat SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
parenHashList (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) [Pat SrcSpanInfo]
ps
    PUnboxedSum SrcSpanInfo
l Int
before Int
after Pat SrcSpanInfo
e ->
      SrcSpanInfo -> Int -> Int -> Pat SrcSpanInfo -> EP ()
forall (e :: * -> *).
ExactP e =>
SrcSpanInfo -> Int -> Int -> e SrcSpanInfo -> EP ()
unboxedSumEP SrcSpanInfo
l Int
before Int
after Pat SrcSpanInfo
e
    PList SrcSpanInfo
l [Pat SrcSpanInfo]
ps  -> [SrcSpan] -> [Pat SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
squareList (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) [Pat SrcSpanInfo]
ps
    PParen SrcSpanInfo
l Pat SrcSpanInfo
p  -> [SrcSpan] -> [Pat SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
parenList (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) [Pat SrcSpanInfo
p]
    PRec SrcSpanInfo
l QName SrcSpanInfo
qn [PatField SrcSpanInfo]
pfs   -> QName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP QName SrcSpanInfo
qn EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [SrcSpan] -> [PatField SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
curlyList (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) [PatField SrcSpanInfo]
pfs
    PAsPat SrcSpanInfo
l Name SrcSpanInfo
n Pat SrcSpanInfo
p    ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
a] -> do
            Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Name SrcSpanInfo
n
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"@"
            Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Pat SrcSpanInfo
p
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Pat: PAsPat is given wrong number of srcInfoPoints"
    PWildCard SrcSpanInfo
_ -> String -> EP ()
printString String
"_"
    PIrrPat SrcSpanInfo
_ Pat SrcSpanInfo
p -> String -> EP ()
printString String
"~" EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Pat SrcSpanInfo
p
    PatTypeSig SrcSpanInfo
l Pat SrcSpanInfo
p Type SrcSpanInfo
t ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
a] -> do
            Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Pat SrcSpanInfo
p
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"::"
            Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Pat: PatTypeSig is given wrong number of srcInfoPoints"
    PViewPat SrcSpanInfo
l Exp SrcSpanInfo
e Pat SrcSpanInfo
p ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
a] -> do
            Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Exp SrcSpanInfo
e
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"->"
            Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Pat SrcSpanInfo
p
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Pat: PViewPat is given wrong number of srcInfoPoints"
    PRPat SrcSpanInfo
l [RPat SrcSpanInfo]
rps -> [SrcSpan] -> [RPat SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
squareList (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) [RPat SrcSpanInfo]
rps
    PXTag SrcSpanInfo
l XName SrcSpanInfo
xn [PXAttr SrcSpanInfo]
attrs Maybe (Pat SrcSpanInfo)
mat [Pat SrcSpanInfo]
ps ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
_,SrcSpan
b,SrcSpan
c,SrcSpan
d,SrcSpan
e] -> do
            String -> EP ()
printString String
"<"
            XName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC XName SrcSpanInfo
xn
            (PXAttr SrcSpanInfo -> EP ()) -> [PXAttr SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ PXAttr SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [PXAttr SrcSpanInfo]
attrs
            (Pat SrcSpanInfo -> EP ()) -> Maybe (Pat SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (Pat SrcSpanInfo)
mat
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
">"
            (Pat SrcSpanInfo -> EP ()) -> [Pat SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [Pat SrcSpanInfo]
ps
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
c) String
"</"
            Pos -> EP ()
printWhitespace (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
d)
            XName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP XName SrcSpanInfo
xn
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
e) String
">"
         -- Optional semi
         [SrcSpan
_,SrcSpan
b,SrcSpan
semi,SrcSpan
c,SrcSpan
d,SrcSpan
e] -> do
            String -> EP ()
printString String
"<"
            XName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC XName SrcSpanInfo
xn
            (PXAttr SrcSpanInfo -> EP ()) -> [PXAttr SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ PXAttr SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [PXAttr SrcSpanInfo]
attrs
            (Pat SrcSpanInfo -> EP ()) -> Maybe (Pat SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (Pat SrcSpanInfo)
mat
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
">"
            (Pat SrcSpanInfo -> EP ()) -> [Pat SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [Pat SrcSpanInfo]
ps
            SrcSpan -> EP ()
printSemi SrcSpan
semi
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
c) String
"</"
            Pos -> EP ()
printWhitespace (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
d)
            XName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP XName SrcSpanInfo
xn
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
e) String
">"
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Pat: PXTag is given wrong number of srcInfoPoints"
    PXETag SrcSpanInfo
l XName SrcSpanInfo
xn [PXAttr SrcSpanInfo]
attrs Maybe (Pat SrcSpanInfo)
mat ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
_,SrcSpan
b] -> do
            String -> EP ()
printString String
"<"
            XName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC XName SrcSpanInfo
xn
            (PXAttr SrcSpanInfo -> EP ()) -> [PXAttr SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ PXAttr SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [PXAttr SrcSpanInfo]
attrs
            (Pat SrcSpanInfo -> EP ()) -> Maybe (Pat SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Maybe (Pat SrcSpanInfo)
mat
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"/>"
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Pat: PXETag is given wrong number of srcInfoPoints"
    PXPcdata SrcSpanInfo
_ String
str -> String -> EP ()
printString String
str
    PXPatTag SrcSpanInfo
l Pat SrcSpanInfo
p   ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
_,SrcSpan
_] -> do
            String -> EP ()
printString String
"<%"
            Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Pat SrcSpanInfo
p
            String -> EP ()
printString String
"%>"
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Pat: PXPatTag is given wrong number of srcInfoPoints"
    PXRPats  SrcSpanInfo
l [RPat SrcSpanInfo]
rps  -> (String, String, String)
-> [SrcSpan] -> [RPat SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
(String, String, String) -> [SrcSpan] -> [ast SrcSpanInfo] -> EP ()
bracketList (String
"<[",String
",",String
"]>") (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) [RPat SrcSpanInfo]
rps
    PSplice SrcSpanInfo
_ Splice SrcSpanInfo
sp  -> Splice SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Splice SrcSpanInfo
sp
    PQuasiQuote SrcSpanInfo
_ String
name String
qt   -> String -> EP ()
printString (String -> EP ()) -> String -> EP ()
forall a b. (a -> b) -> a -> b
$ String
"[$" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"|" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
qt String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"
    PBangPat SrcSpanInfo
_ Pat SrcSpanInfo
p    -> String -> EP ()
printString String
"!" EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Pat SrcSpanInfo
p

instance ExactP PatField where
  exactP :: PatField SrcSpanInfo -> EP ()
exactP PatField SrcSpanInfo
pf = case PatField SrcSpanInfo
pf of
    PFieldPat SrcSpanInfo
l QName SrcSpanInfo
qn Pat SrcSpanInfo
p        ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
a] -> do
            QName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP QName SrcSpanInfo
qn
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"="
            Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Pat SrcSpanInfo
p
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: PatField: PFieldPat is given wrong number of srcInfoPoints"
    PFieldPun SrcSpanInfo
_ QName SrcSpanInfo
n   -> QName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP QName SrcSpanInfo
n
    PFieldWildcard SrcSpanInfo
_ -> String -> EP ()
printString String
".."

instance ExactP RPat where
  exactP :: RPat SrcSpanInfo -> EP ()
exactP RPat SrcSpanInfo
rpat = case RPat SrcSpanInfo
rpat of
    RPOp SrcSpanInfo
_ RPat SrcSpanInfo
rp RPatOp SrcSpanInfo
op    -> RPat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP RPat SrcSpanInfo
rp EP () -> EP () -> EP ()
forall a b. EP a -> EP b -> EP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RPatOp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC RPatOp SrcSpanInfo
op
    RPEither SrcSpanInfo
l RPat SrcSpanInfo
r1 RPat SrcSpanInfo
r2 ->
      case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
       [SrcSpan
a] -> do
          RPat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP RPat SrcSpanInfo
r1
          Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"|"
          RPat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC RPat SrcSpanInfo
r2
       [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: RPat: RPEither is given wrong number of srcInfoPoints"
    RPSeq SrcSpanInfo
l [RPat SrcSpanInfo]
rps -> (String, String, String)
-> [SrcSpan] -> [RPat SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
(String, String, String) -> [SrcSpan] -> [ast SrcSpanInfo] -> EP ()
bracketList (String
"(|",String
",",String
"|)") (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) [RPat SrcSpanInfo]
rps
    RPGuard SrcSpanInfo
l Pat SrcSpanInfo
p [Stmt SrcSpanInfo]
stmts   ->
      case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
       SrcSpan
_:[SrcSpan]
pts -> do
          String -> EP ()
printString String
"(|"
          Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Pat SrcSpanInfo
p
          (String, String, String)
-> [SrcSpan] -> [Stmt SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
(String, String, String) -> [SrcSpan] -> [ast SrcSpanInfo] -> EP ()
bracketList (String
"|",String
",",String
"|)") [SrcSpan]
pts [Stmt SrcSpanInfo]
stmts
       [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: RPat: RPGuard is given wrong number of srcInfoPoints"
    RPCAs SrcSpanInfo
l Name SrcSpanInfo
n RPat SrcSpanInfo
rp    ->
      case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
       [SrcSpan
a] -> do
          Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Name SrcSpanInfo
n
          Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"@:"
          RPat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC RPat SrcSpanInfo
rp
       [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: RPat: RPCAs is given wrong number of srcInfoPoints"
    RPAs SrcSpanInfo
l Name SrcSpanInfo
n RPat SrcSpanInfo
rp     ->
      case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
       [SrcSpan
a] -> do
          Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Name SrcSpanInfo
n
          Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"@"
          RPat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC RPat SrcSpanInfo
rp
       [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: RPat: RPAs is given wrong number of srcInfoPoints"
    RPParen SrcSpanInfo
l RPat SrcSpanInfo
rp    -> [SrcSpan] -> [RPat SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
parenList (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) [RPat SrcSpanInfo
rp]
    RPPat SrcSpanInfo
_ Pat SrcSpanInfo
p   -> Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Pat SrcSpanInfo
p

instance ExactP RPatOp where
  exactP :: RPatOp SrcSpanInfo -> EP ()
exactP RPatOp SrcSpanInfo
rop = String -> EP ()
printString (String -> EP ()) -> String -> EP ()
forall a b. (a -> b) -> a -> b
$ case RPatOp SrcSpanInfo
rop of
    RPStar  SrcSpanInfo
_  -> String
"*"
    RPStarG SrcSpanInfo
_  -> String
"*!"
    RPPlus  SrcSpanInfo
_  -> String
"+"
    RPPlusG SrcSpanInfo
_  -> String
"+!"
    RPOpt   SrcSpanInfo
_  -> String
"?"
    RPOptG  SrcSpanInfo
_  -> String
"?!"

instance ExactP PXAttr where
  exactP :: PXAttr SrcSpanInfo -> EP ()
exactP (PXAttr SrcSpanInfo
l XName SrcSpanInfo
xn Pat SrcSpanInfo
p) =
    case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
     [SrcSpan
a] -> do
        XName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP XName SrcSpanInfo
xn
        Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"="
        Pat SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Pat SrcSpanInfo
p
     [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: PXAttr is given wrong number of srcInfoPoints"

instance ExactP XName where
  exactP :: XName SrcSpanInfo -> EP ()
exactP XName SrcSpanInfo
xn = case XName SrcSpanInfo
xn of
    XName SrcSpanInfo
_ String
name -> String -> EP ()
printString String
name
    XDomName SrcSpanInfo
l String
dom String
name ->
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
_,SrcSpan
b,SrcSpan
c] -> do
            String -> EP ()
printString String
dom
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
":"
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
c) String
name
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: XName: XDomName is given wrong number of srcInfoPoints"

instance ExactP Binds where
  exactP :: Binds SrcSpanInfo -> EP ()
exactP (BDecls  SrcSpanInfo
l [Decl SrcSpanInfo]
ds)  = [SrcSpan] -> [Decl SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
layoutList (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) ([Decl SrcSpanInfo] -> [Decl SrcSpanInfo]
sepFunBinds [Decl SrcSpanInfo]
ds)
  exactP (IPBinds SrcSpanInfo
l [IPBind SrcSpanInfo]
ips) = [SrcSpan] -> [IPBind SrcSpanInfo] -> EP ()
forall (ast :: * -> *).
ExactP ast =>
[SrcSpan] -> [ast SrcSpanInfo] -> EP ()
layoutList (SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l) [IPBind SrcSpanInfo]
ips

instance ExactP CallConv where
  exactP :: CallConv SrcSpanInfo -> EP ()
exactP (StdCall    SrcSpanInfo
_) = String -> EP ()
printString String
"stdcall"
  exactP (CCall      SrcSpanInfo
_) = String -> EP ()
printString String
"ccall"
  exactP (CPlusPlus  SrcSpanInfo
_) = String -> EP ()
printString String
"cplusplus"
  exactP (DotNet     SrcSpanInfo
_) = String -> EP ()
printString String
"dotnet"
  exactP (Jvm        SrcSpanInfo
_) = String -> EP ()
printString String
"jvm"
  exactP (Js         SrcSpanInfo
_) = String -> EP ()
printString String
"js"
  exactP (JavaScript SrcSpanInfo
_) = String -> EP ()
printString String
"javascript"
  exactP (CApi       SrcSpanInfo
_) = String -> EP ()
printString String
"capi"

instance ExactP Safety where
  exactP :: Safety SrcSpanInfo -> EP ()
exactP (PlayRisky SrcSpanInfo
_) = String -> EP ()
printString String
"unsafe"
  exactP (PlaySafe SrcSpanInfo
_ Bool
b) = String -> EP ()
printString (String -> EP ()) -> String -> EP ()
forall a b. (a -> b) -> a -> b
$ if Bool
b then String
"threadsafe" else String
"safe"
  exactP (PlayInterruptible SrcSpanInfo
_) = String -> EP ()
printString String
"interruptible"

instance ExactP Rule where
  exactP :: Rule SrcSpanInfo -> EP ()
exactP (Rule SrcSpanInfo
l String
str Maybe (Activation SrcSpanInfo)
mact Maybe [RuleVar SrcSpanInfo]
mrvs Exp SrcSpanInfo
e1 Exp SrcSpanInfo
e2) =
    case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
     SrcSpan
_:[SrcSpan]
pts -> do
        String -> EP ()
printString (ShowS
forall a. Show a => a -> String
show String
str)
        (Activation SrcSpanInfo -> EP ())
-> Maybe (Activation SrcSpanInfo) -> EP ()
forall a. (a -> EP ()) -> Maybe a -> EP ()
maybeEP Activation SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Maybe (Activation SrcSpanInfo)
mact
        [SrcSpan]
pts1 <- case Maybe [RuleVar SrcSpanInfo]
mrvs of
                Maybe [RuleVar SrcSpanInfo]
Nothing -> [SrcSpan] -> EP [SrcSpan]
forall a. a -> EP a
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts
                Just [RuleVar SrcSpanInfo]
rvs ->
                    case [SrcSpan]
pts of
                     SrcSpan
a':SrcSpan
b:[SrcSpan]
pts' -> do
                        Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a') String
"forall"
                        (RuleVar SrcSpanInfo -> EP ()) -> [RuleVar SrcSpanInfo] -> EP ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ RuleVar SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC [RuleVar SrcSpanInfo]
rvs
                        Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"."
                        [SrcSpan] -> EP [SrcSpan]
forall a. a -> EP a
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan]
pts'
                     [SrcSpan]
_ -> String -> EP [SrcSpan]
forall a. String -> EP a
errorEP String
"ExactP: Rule is given too few srcInfoPoints"
        case [SrcSpan]
pts1 of
         [SrcSpan
x] -> do
            Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e1
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
x) String
"="
            Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e2
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Rule is given wrong number of srcInfoPoints"
     [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: Rule is given too few srcInfoPoints"

instance ExactP RuleVar where
  exactP :: RuleVar SrcSpanInfo -> EP ()
exactP (TypedRuleVar SrcSpanInfo
l Name SrcSpanInfo
n Type SrcSpanInfo
t) =
        case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
         [SrcSpan
_,SrcSpan
b,SrcSpan
c] -> do
            String -> EP ()
printString String
"("
            Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Name SrcSpanInfo
n
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
b) String
"::"
            Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
t
            Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
c) String
")"
         [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: RuleVar: TypedRuleVar is given wrong number of srcInfoPoints"
  exactP (RuleVar SrcSpanInfo
_ Name SrcSpanInfo
n) = Name SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP Name SrcSpanInfo
n

instance ExactP Overlap where
  exactP :: Overlap SrcSpanInfo -> EP ()
exactP (NoOverlap SrcSpanInfo
_) =
    String -> EP ()
printString String
"{-# NO_OVERLAP #-}"
  exactP (Overlap SrcSpanInfo
_) =
    String -> EP ()
printString String
"{-# OVERLAP #-}"
  exactP (Overlaps SrcSpanInfo
_) =
    String -> EP ()
printString String
"{-# OVERLAPS #-}"
  exactP (Overlapping SrcSpanInfo
_) =
    String -> EP ()
printString String
"{-# OVERLAPPING #-}"
  exactP (Overlappable SrcSpanInfo
_) =
    String -> EP ()
printString String
"{-# OVERLAPPABLE #-}"
  exactP (Incoherent SrcSpanInfo
_) =
    String -> EP ()
printString String
"{-# INCOHERENT #-}"

instance ExactP Activation where
  exactP :: Activation SrcSpanInfo -> EP ()
exactP (ActiveFrom   SrcSpanInfo
l Int
i) =
    SrcSpanInfo -> [String] -> EP ()
printPoints SrcSpanInfo
l [String
"[", Int -> String
forall a. Show a => a -> String
show Int
i, String
"]"]
  exactP (ActiveUntil  SrcSpanInfo
l Int
i) =
    SrcSpanInfo -> [String] -> EP ()
printPoints SrcSpanInfo
l [String
"[", String
"~", Int -> String
forall a. Show a => a -> String
show Int
i, String
"]"]

instance ExactP FieldDecl where
  exactP :: FieldDecl SrcSpanInfo -> EP ()
exactP (FieldDecl SrcSpanInfo
l [Name SrcSpanInfo]
ns Type SrcSpanInfo
bt) = do
    let pts :: [SrcSpan]
pts = SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l
    [(SrcSpan, String)] -> [Name SrcSpanInfo] -> EP ()
forall (ast :: * -> *) loc.
(ExactP ast, SrcInfo loc) =>
[(loc, String)] -> [ast SrcSpanInfo] -> EP ()
printInterleaved' ([SrcSpan] -> [String] -> [(SrcSpan, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([SrcSpan] -> [SrcSpan]
forall a. HasCallStack => [a] -> [a]
init [SrcSpan]
pts) (String -> [String]
forall a. a -> [a]
repeat String
",") [(SrcSpan, String)] -> [(SrcSpan, String)] -> [(SrcSpan, String)]
forall a. [a] -> [a] -> [a]
++ [([SrcSpan] -> SrcSpan
forall a. HasCallStack => [a] -> a
last [SrcSpan]
pts, String
"::")]) [Name SrcSpanInfo]
ns
    Type SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Type SrcSpanInfo
bt

instance ExactP IPBind where
  exactP :: IPBind SrcSpanInfo -> EP ()
exactP (IPBind SrcSpanInfo
l IPName SrcSpanInfo
ipn Exp SrcSpanInfo
e) =
    case SrcSpanInfo -> [SrcSpan]
srcInfoPoints SrcSpanInfo
l of
     [SrcSpan
a] -> do
        IPName SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactP IPName SrcSpanInfo
ipn
        Pos -> String -> EP ()
printStringAt (SrcSpan -> Pos
forall loc. SrcInfo loc => loc -> Pos
pos SrcSpan
a) String
"="
        Exp SrcSpanInfo -> EP ()
forall (ast :: * -> *). ExactP ast => ast SrcSpanInfo -> EP ()
exactPC Exp SrcSpanInfo
e
     [SrcSpan]
_ -> String -> EP ()
forall a. String -> EP a
errorEP String
"ExactP: IPBind is given wrong number of srcInfoPoints"

-- Hopefully, this will never fire.
-- If it does, hopefully by that time https://github.com/sol/rewrite-with-location
-- will be implemented.
-- If not, then removing all calls to internalError should give a better
-- idea where the error comes from.
-- So far, it's necessary to eliminate non-exhaustive patterns warnings.
-- We don't want to turn them off, as we want unhandled AST nodes to be
-- reported.
internalError :: String -> a
internalError :: forall a. String -> a
internalError String
loc' = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
    [ String
"haskell-src-exts: ExactPrint: internal error (non-exhaustive pattern)"
    , String
"Location: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
loc'
    , String
"This is either caused by supplying incorrect location information or by"
    , String
"a bug in haskell-src-exts. If this happens on an unmodified AST obtained"
    , String
"by the haskell-src-exts Parser it is a bug, please it report it at"
    , String
"https://github.com/haskell-suite/haskell-src-exts"]