{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
module HIndent.Pretty
(pretty)
where
import Control.Applicative
import Control.Monad.State.Strict hiding (state)
import qualified Data.ByteString.Builder as S
import Data.Foldable (for_, forM_, traverse_)
import Data.Int
import Data.List
import Data.Maybe
import Data.Monoid ((<>))
import Data.Typeable
import HIndent.Types
import qualified Language.Haskell.Exts as P
import Language.Haskell.Exts.SrcLoc
import Language.Haskell.Exts.Syntax
import Prelude hiding (exp)
class (Annotated ast,Typeable ast) => Pretty ast where
prettyInternal :: ast NodeInfo -> Printer ()
pretty :: (Pretty ast,Show (ast NodeInfo))
=> ast NodeInfo -> Printer ()
pretty :: ast NodeInfo -> Printer ()
pretty ast NodeInfo
a = do
(NodeComment -> Printer ()) -> [NodeComment] -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
(\NodeComment
c' -> do
case NodeComment
c' of
CommentBeforeLine SrcSpan
_ SomeComment
c -> do
case SomeComment
c of
EndOfLine String
s -> String -> Printer ()
write (String
"--" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s)
MultiLine String
s -> String -> Printer ()
write (String
"{-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-}")
Printer ()
newline
NodeComment
_ -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
[NodeComment]
comments
ast NodeInfo -> Printer ()
forall (ast :: * -> *). Pretty ast => ast NodeInfo -> Printer ()
prettyInternal ast NodeInfo
a
((Int, NodeComment) -> Printer ())
-> [(Int, NodeComment)] -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
(\(Int
i, NodeComment
c') -> do
case NodeComment
c' of
CommentSameLine SrcSpan
spn SomeComment
c -> do
Int64
col <- (PrintState -> Int64) -> Printer Int64
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Int64
psColumn
if Int64
col Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0
then do
let col' :: Int64
col' = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int64) -> Int -> Int64
forall a b. (a -> b) -> a -> b
$ SrcSpan -> Int
srcSpanStartColumn SrcSpan
spn Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
column Int64
col' (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ SomeComment -> Printer ()
writeComment SomeComment
c
else do
Printer ()
space
SomeComment -> Printer ()
writeComment SomeComment
c
CommentAfterLine SrcSpan
spn SomeComment
c -> do
Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) Printer ()
newline
let col :: Int64
col = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int64) -> Int -> Int64
forall a b. (a -> b) -> a -> b
$ SrcSpan -> Int
srcSpanStartColumn SrcSpan
spn Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
column Int64
col (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ SomeComment -> Printer ()
writeComment SomeComment
c
NodeComment
_ -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
([Int] -> [NodeComment] -> [(Int, NodeComment)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 :: Int ..] [NodeComment]
comments)
where
comments :: [NodeComment]
comments = NodeInfo -> [NodeComment]
nodeInfoComments (ast NodeInfo -> NodeInfo
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann ast NodeInfo
a)
writeComment :: SomeComment -> Printer ()
writeComment =
\case
EndOfLine String
cs -> do
String -> Printer ()
write (String
"--" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cs)
(PrintState -> PrintState) -> Printer ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify
(\PrintState
s ->
PrintState
s
{ psEolComment :: Bool
psEolComment = Bool
True
})
MultiLine String
cs -> do
String -> Printer ()
write (String
"{-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-}")
(PrintState -> PrintState) -> Printer ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify
(\PrintState
s ->
PrintState
s
{ psEolComment :: Bool
psEolComment = Bool
True
})
pretty' :: (Pretty ast,P.Pretty (ast SrcSpanInfo))
=> ast NodeInfo -> Printer ()
pretty' :: ast NodeInfo -> Printer ()
pretty' = String -> Printer ()
write (String -> Printer ())
-> (ast NodeInfo -> String) -> ast NodeInfo -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ast SrcSpanInfo -> String
forall a. Pretty a => a -> String
P.prettyPrint (ast SrcSpanInfo -> String)
-> (ast NodeInfo -> ast SrcSpanInfo) -> ast NodeInfo -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeInfo -> SrcSpanInfo) -> ast NodeInfo -> ast SrcSpanInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NodeInfo -> SrcSpanInfo
nodeInfoSpan
indented :: Int64 -> Printer a -> Printer a
indented :: Int64 -> Printer a -> Printer a
indented Int64
i Printer a
p =
do Int64
level <- (PrintState -> Int64) -> Printer Int64
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Int64
psIndentLevel
(PrintState -> PrintState) -> Printer ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\PrintState
s -> PrintState
s {psIndentLevel :: Int64
psIndentLevel = Int64
level Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
i})
a
m <- Printer a
p
(PrintState -> PrintState) -> Printer ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\PrintState
s -> PrintState
s {psIndentLevel :: Int64
psIndentLevel = Int64
level})
a -> Printer a
forall (m :: * -> *) a. Monad m => a -> m a
return a
m
indentedBlock :: Printer a -> Printer a
indentedBlock :: Printer a -> Printer a
indentedBlock Printer a
p =
do Int64
indentSpaces <- Printer Int64
getIndentSpaces
Int64 -> Printer a -> Printer a
forall a. Int64 -> Printer a -> Printer a
indented Int64
indentSpaces Printer a
p
spaced :: [Printer ()] -> Printer ()
spaced :: [Printer ()] -> Printer ()
spaced = Printer () -> [Printer ()] -> Printer ()
inter Printer ()
space
commas :: [Printer ()] -> Printer ()
commas :: [Printer ()] -> Printer ()
commas = Printer () -> [Printer ()] -> Printer ()
inter (String -> Printer ()
write String
", ")
inter :: Printer () -> [Printer ()] -> Printer ()
inter :: Printer () -> [Printer ()] -> Printer ()
inter Printer ()
sep [Printer ()]
ps =
((Int, Printer ()) -> Printer () -> Printer ())
-> Printer () -> [(Int, Printer ())] -> Printer ()
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
(\(Int
i,Printer ()
p) Printer ()
next ->
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend
(do Printer ()
p
if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [Printer ()] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Printer ()]
ps
then Printer ()
sep
else () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
Printer ()
next)
(() -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
([Int] -> [Printer ()] -> [(Int, Printer ())]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1 ..] [Printer ()]
ps)
lined :: [Printer ()] -> Printer ()
lined :: [Printer ()] -> Printer ()
lined [Printer ()]
ps = [Printer ()] -> Printer ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ (Printer () -> [Printer ()] -> [Printer ()]
forall a. a -> [a] -> [a]
intersperse Printer ()
newline [Printer ()]
ps)
prefixedLined :: String -> [Printer ()] -> Printer ()
prefixedLined :: String -> [Printer ()] -> Printer ()
prefixedLined String
pref [Printer ()]
ps' =
case [Printer ()]
ps' of
[] -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
(Printer ()
p:[Printer ()]
ps) ->
do Printer ()
p
Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indented (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
(String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
pref Int -> Int -> Int
forall a. Num a => a -> a -> a
*
(-Int
1)))
((Printer () -> Printer ()) -> [Printer ()] -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Printer ()
p' ->
do Printer ()
newline
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
pref) Printer ()
p')
[Printer ()]
ps)
column :: Int64 -> Printer a -> Printer a
column :: Int64 -> Printer a -> Printer a
column Int64
i Printer a
p =
do Int64
level <- (PrintState -> Int64) -> Printer Int64
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Int64
psIndentLevel
(PrintState -> PrintState) -> Printer ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\PrintState
s -> PrintState
s {psIndentLevel :: Int64
psIndentLevel = Int64
i})
a
m <- Printer a
p
(PrintState -> PrintState) -> Printer ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\PrintState
s -> PrintState
s {psIndentLevel :: Int64
psIndentLevel = Int64
level})
a -> Printer a
forall (m :: * -> *) a. Monad m => a -> m a
return a
m
newline :: Printer ()
newline :: Printer ()
newline =
do String -> Printer ()
write String
"\n"
(PrintState -> PrintState) -> Printer ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\PrintState
s -> PrintState
s {psNewline :: Bool
psNewline = Bool
True})
withCaseContext :: Bool -> Printer a -> Printer a
withCaseContext :: Bool -> Printer a -> Printer a
withCaseContext Bool
bool Printer a
pr =
do Bool
original <- (PrintState -> Bool) -> Printer Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Bool
psInsideCase
(PrintState -> PrintState) -> Printer ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\PrintState
s -> PrintState
s {psInsideCase :: Bool
psInsideCase = Bool
bool})
a
result <- Printer a
pr
(PrintState -> PrintState) -> Printer ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\PrintState
s -> PrintState
s {psInsideCase :: Bool
psInsideCase = Bool
original})
a -> Printer a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result
rhsSeparator :: Printer ()
rhsSeparator :: Printer ()
rhsSeparator =
do Bool
inCase <- (PrintState -> Bool) -> Printer Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Bool
psInsideCase
if Bool
inCase
then String -> Printer ()
write String
"->"
else String -> Printer ()
write String
"="
depend :: Printer () -> Printer b -> Printer b
depend :: Printer () -> Printer b -> Printer b
depend Printer ()
maker Printer b
dependent =
do PrintState
state' <- Printer PrintState
forall s (m :: * -> *). MonadState s m => m s
get
Printer ()
maker
PrintState
st <- Printer PrintState
forall s (m :: * -> *). MonadState s m => m s
get
Int64
col <- (PrintState -> Int64) -> Printer Int64
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Int64
psColumn
if PrintState -> Int64
psLine PrintState
state' Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
/= PrintState -> Int64
psLine PrintState
st Bool -> Bool -> Bool
|| PrintState -> Int64
psColumn PrintState
state' Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
/= PrintState -> Int64
psColumn PrintState
st
then Int64 -> Printer b -> Printer b
forall a. Int64 -> Printer a -> Printer a
column Int64
col Printer b
dependent
else Printer b
dependent
wrap :: String -> String -> Printer a -> Printer a
wrap :: String -> String -> Printer a -> Printer a
wrap String
open String
close Printer a
p = Printer () -> Printer a -> Printer a
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
open) (Printer a -> Printer a) -> Printer a -> Printer a
forall a b. (a -> b) -> a -> b
$ Printer a
p Printer a -> Printer () -> Printer a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> Printer ()
write String
close
parens :: Printer a -> Printer a
parens :: Printer a -> Printer a
parens = String -> String -> Printer a -> Printer a
forall a. String -> String -> Printer a -> Printer a
wrap String
"(" String
")"
braces :: Printer a -> Printer a
braces :: Printer a -> Printer a
braces = String -> String -> Printer a -> Printer a
forall a. String -> String -> Printer a -> Printer a
wrap String
"{" String
"}"
brackets :: Printer a -> Printer a
brackets :: Printer a -> Printer a
brackets = String -> String -> Printer a -> Printer a
forall a. String -> String -> Printer a -> Printer a
wrap String
"[" String
"]"
space :: Printer ()
space :: Printer ()
space = String -> Printer ()
write String
" "
comma :: Printer ()
comma :: Printer ()
comma = String -> Printer ()
write String
","
int :: Integer -> Printer ()
int :: Integer -> Printer ()
int = String -> Printer ()
write (String -> Printer ())
-> (Integer -> String) -> Integer -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show
write :: String -> Printer ()
write :: String -> Printer ()
write String
x =
do Bool
eol <- (PrintState -> Bool) -> Printer Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Bool
psEolComment
Bool
hardFail <- (PrintState -> Bool) -> Printer Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Bool
psFitOnOneLine
let addingNewline :: Bool
addingNewline = Bool
eol Bool -> Bool -> Bool
&& String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"\n"
Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
addingNewline Printer ()
newline
PrintState
state <- Printer PrintState
forall s (m :: * -> *). MonadState s m => m s
get
let writingNewline :: Bool
writingNewline = String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"\n"
out :: String
out :: String
out =
if PrintState -> Bool
psNewline PrintState
state Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
writingNewline
then (Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (PrintState -> Int64
psIndentLevel PrintState
state))
Char
' ') String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
String
x
else String
x
psColumn' :: Int64
psColumn' =
if Int
additionalLines Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
then Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
1 ([String] -> [String]
forall a. [a] -> [a]
reverse [String]
srclines))))
else PrintState -> Int64
psColumn PrintState
state Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
out)
Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
Bool
hardFail
(Bool -> Printer ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard
(Int
additionalLines Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&&
(Int64
psColumn' Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Config -> Int64
configMaxColumns (PrintState -> Config
psConfig PrintState
state))))
(PrintState -> PrintState) -> Printer ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\PrintState
s ->
PrintState
s {psOutput :: Builder
psOutput = PrintState -> Builder
psOutput PrintState
state Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
S.stringUtf8 String
out
,psNewline :: Bool
psNewline = Bool
False
,psLine :: Int64
psLine = PrintState -> Int64
psLine PrintState
state Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
additionalLines
,psEolComment :: Bool
psEolComment= Bool
False
,psColumn :: Int64
psColumn = Int64
psColumn'})
where srclines :: [String]
srclines = String -> [String]
lines String
x
additionalLines :: Int
additionalLines =
String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n') String
x)
string :: String -> Printer ()
string :: String -> Printer ()
string = String -> Printer ()
write
getIndentSpaces :: Printer Int64
getIndentSpaces :: Printer Int64
getIndentSpaces =
(PrintState -> Int64) -> Printer Int64
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Config -> Int64
configIndentSpaces (Config -> Int64) -> (PrintState -> Config) -> PrintState -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrintState -> Config
psConfig)
sandbox :: Printer a -> Printer (a,PrintState)
sandbox :: Printer a -> Printer (a, PrintState)
sandbox Printer a
p =
do PrintState
orig <- Printer PrintState
forall s (m :: * -> *). MonadState s m => m s
get
a
a <- Printer a
p
PrintState
new <- Printer PrintState
forall s (m :: * -> *). MonadState s m => m s
get
PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
orig
(a, PrintState) -> Printer (a, PrintState)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a,PrintState
new)
withCtx :: (Pretty ast,Show (ast NodeInfo))
=> Maybe (ast NodeInfo) -> Printer b -> Printer b
withCtx :: Maybe (ast NodeInfo) -> Printer b -> Printer b
withCtx Maybe (ast NodeInfo)
Nothing Printer b
m = Printer b
m
withCtx (Just ast NodeInfo
ctx) Printer b
m =
do ast NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ast NodeInfo
ctx
String -> Printer ()
write String
" =>"
Printer ()
newline
Printer b
m
maybeOverlap :: Maybe (Overlap NodeInfo) -> Printer ()
maybeOverlap :: Maybe (Overlap NodeInfo) -> Printer ()
maybeOverlap =
Printer ()
-> (Overlap NodeInfo -> Printer ())
-> Maybe (Overlap NodeInfo)
-> Printer ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
(\Overlap NodeInfo
p ->
Overlap NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Overlap NodeInfo
p Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Printer ()
space)
swing :: Printer () -> Printer b -> Printer ()
swing :: Printer () -> Printer b -> Printer ()
swing Printer ()
a Printer b
b =
do Int64
orig <- (PrintState -> Int64) -> Printer Int64
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Int64
psIndentLevel
Printer ()
a
Maybe PrintState
mst <- Printer b -> Printer (Maybe PrintState)
forall a. Printer a -> Printer (Maybe PrintState)
fitsOnOneLine (do Printer ()
space
Printer b
b)
case Maybe PrintState
mst of
Just PrintState
st -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st
Maybe PrintState
Nothing -> do Printer ()
newline
Int64
indentSpaces <- Printer Int64
getIndentSpaces
b
_ <- Int64 -> Printer b -> Printer b
forall a. Int64 -> Printer a -> Printer a
column (Int64
orig Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
indentSpaces) Printer b
b
() -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
swingBy :: Int64 -> Printer() -> Printer b -> Printer b
swingBy :: Int64 -> Printer () -> Printer b -> Printer b
swingBy Int64
i Printer ()
a Printer b
b =
do Int64
orig <- (PrintState -> Int64) -> Printer Int64
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Int64
psIndentLevel
Printer ()
a
Printer ()
newline
Int64 -> Printer b -> Printer b
forall a. Int64 -> Printer a -> Printer a
column (Int64
orig Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
i) Printer b
b
instance Pretty Context where
prettyInternal :: Context NodeInfo -> Printer ()
prettyInternal ctx :: Context NodeInfo
ctx@(CxTuple NodeInfo
_ [Asst NodeInfo]
asserts) = do
Maybe PrintState
mst <- Printer () -> Printer (Maybe PrintState)
forall a. Printer a -> Printer (Maybe PrintState)
fitsOnOneLine (Printer () -> Printer ()
forall a. Printer a -> Printer a
parens (Printer () -> [Printer ()] -> Printer ()
inter (Printer ()
comma Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space) ((Asst NodeInfo -> Printer ()) -> [Asst NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Asst NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Asst NodeInfo]
asserts)))
case Maybe PrintState
mst of
Maybe PrintState
Nothing -> Context NodeInfo -> Printer ()
context Context NodeInfo
ctx
Just PrintState
st -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st
prettyInternal Context NodeInfo
ctx = Context NodeInfo -> Printer ()
context Context NodeInfo
ctx
instance Pretty Pat where
prettyInternal :: Pat NodeInfo -> Printer ()
prettyInternal Pat NodeInfo
x =
case Pat NodeInfo
x of
PLit NodeInfo
_ Sign NodeInfo
sign Literal NodeInfo
l -> Sign NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Sign NodeInfo
sign Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Literal NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Literal NodeInfo
l
PNPlusK NodeInfo
_ Name NodeInfo
n Integer
k ->
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (do Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Name NodeInfo
n
String -> Printer ()
write String
"+")
(Integer -> Printer ()
int Integer
k)
PInfixApp NodeInfo
_ Pat NodeInfo
a QName NodeInfo
op Pat NodeInfo
b ->
case QName NodeInfo
op of
Special{} ->
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
a)
(Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (QName NodeInfo -> Printer ()
prettyInfixOp QName NodeInfo
op)
(Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
b))
QName NodeInfo
_ ->
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (do Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
a
Printer ()
space)
(Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (do QName NodeInfo -> Printer ()
prettyInfixOp QName NodeInfo
op
Printer ()
space)
(Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
b))
PApp NodeInfo
_ QName NodeInfo
f [Pat NodeInfo]
args ->
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (do QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
f
Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Pat NodeInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Pat NodeInfo]
args) Printer ()
space)
([Printer ()] -> Printer ()
spaced ((Pat NodeInfo -> Printer ()) -> [Pat NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Pat NodeInfo]
args))
PTuple NodeInfo
_ Boxed
boxed [Pat NodeInfo]
pats ->
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write (case Boxed
boxed of
Boxed
Unboxed -> String
"(# "
Boxed
Boxed -> String
"("))
(do [Printer ()] -> Printer ()
commas ((Pat NodeInfo -> Printer ()) -> [Pat NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Pat NodeInfo]
pats)
String -> Printer ()
write (case Boxed
boxed of
Boxed
Unboxed -> String
" #)"
Boxed
Boxed -> String
")"))
PList NodeInfo
_ [Pat NodeInfo]
ps ->
Printer () -> Printer ()
forall a. Printer a -> Printer a
brackets ([Printer ()] -> Printer ()
commas ((Pat NodeInfo -> Printer ()) -> [Pat NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Pat NodeInfo]
ps))
PParen NodeInfo
_ Pat NodeInfo
e -> Printer () -> Printer ()
forall a. Printer a -> Printer a
parens (Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
e)
PRec NodeInfo
_ QName NodeInfo
qname [PatField NodeInfo]
fields -> do
let horVariant :: Printer ()
horVariant = do
QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
qname
Printer ()
space
Printer () -> Printer ()
forall a. Printer a -> Printer a
braces (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ [Printer ()] -> Printer ()
commas ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (PatField NodeInfo -> Printer ())
-> [PatField NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map PatField NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [PatField NodeInfo]
fields
verVariant :: Printer ()
verVariant =
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
qname Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
case [PatField NodeInfo]
fields of
[] -> String -> Printer ()
write String
"{}"
[PatField NodeInfo
field] -> Printer () -> Printer ()
forall a. Printer a -> Printer a
braces (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ PatField NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty PatField NodeInfo
field
[PatField NodeInfo]
_ -> do
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"{") (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$
String -> [Printer ()] -> Printer ()
prefixedLined String
"," ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (PatField NodeInfo -> Printer ())
-> [PatField NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend Printer ()
space (Printer () -> Printer ())
-> (PatField NodeInfo -> Printer ())
-> PatField NodeInfo
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatField NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty) [PatField NodeInfo]
fields
Printer ()
newline
String -> Printer ()
write String
"}"
Printer ()
horVariant Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
`ifFitsOnOneLineOrElse` Printer ()
verVariant
PAsPat NodeInfo
_ Name NodeInfo
n Pat NodeInfo
p ->
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (do Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Name NodeInfo
n
String -> Printer ()
write String
"@")
(Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
p)
PWildCard NodeInfo
_ -> String -> Printer ()
write String
"_"
PIrrPat NodeInfo
_ Pat NodeInfo
p ->
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"~")
(Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
p)
PatTypeSig NodeInfo
_ Pat NodeInfo
p Type NodeInfo
ty ->
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (do Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
p
String -> Printer ()
write String
" :: ")
(Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty)
PViewPat NodeInfo
_ Exp NodeInfo
e Pat NodeInfo
p ->
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (do Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e
String -> Printer ()
write String
" -> ")
(Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
p)
PQuasiQuote NodeInfo
_ String
name String
str -> String -> Printer () -> Printer ()
quotation String
name (String -> Printer ()
string String
str)
PBangPat NodeInfo
_ Pat NodeInfo
p ->
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"!")
(Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
p)
PRPat{} -> Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Pat NodeInfo
x
PXTag{} -> Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Pat NodeInfo
x
PXETag{} -> Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Pat NodeInfo
x
PXPcdata{} -> Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Pat NodeInfo
x
PXPatTag{} -> Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Pat NodeInfo
x
PXRPats{} -> Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Pat NodeInfo
x
PVar{} -> Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Pat NodeInfo
x
PSplice NodeInfo
_ Splice NodeInfo
s -> Splice NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Splice NodeInfo
s
prettyInfixName :: Name NodeInfo -> Printer ()
prettyInfixName :: Name NodeInfo -> Printer ()
prettyInfixName (Ident NodeInfo
_ String
n) = do String -> Printer ()
write String
"`"; String -> Printer ()
string String
n; String -> Printer ()
write String
"`";
prettyInfixName (Symbol NodeInfo
_ String
s) = String -> Printer ()
string String
s
prettyInfixOp :: QName NodeInfo -> Printer ()
prettyInfixOp :: QName NodeInfo -> Printer ()
prettyInfixOp QName NodeInfo
x =
case QName NodeInfo
x of
Qual NodeInfo
_ ModuleName NodeInfo
mn Name NodeInfo
n ->
case Name NodeInfo
n of
Ident NodeInfo
_ String
i -> do String -> Printer ()
write String
"`"; ModuleName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ModuleName NodeInfo
mn; String -> Printer ()
write String
"."; String -> Printer ()
string String
i; String -> Printer ()
write String
"`";
Symbol NodeInfo
_ String
s -> do ModuleName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ModuleName NodeInfo
mn; String -> Printer ()
write String
"."; String -> Printer ()
string String
s;
UnQual NodeInfo
_ Name NodeInfo
n -> Name NodeInfo -> Printer ()
prettyInfixName Name NodeInfo
n
Special NodeInfo
_ SpecialCon NodeInfo
s -> SpecialCon NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty SpecialCon NodeInfo
s
prettyQuoteName :: Name NodeInfo -> Printer ()
prettyQuoteName :: Name NodeInfo -> Printer ()
prettyQuoteName Name NodeInfo
x =
case Name NodeInfo
x of
Ident NodeInfo
_ String
i -> String -> Printer ()
string String
i
Symbol NodeInfo
_ String
s -> String -> Printer ()
string (String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")")
instance Pretty Type where
prettyInternal :: Type NodeInfo -> Printer ()
prettyInternal = Type NodeInfo -> Printer ()
typ
instance Pretty Exp where
prettyInternal :: Exp NodeInfo -> Printer ()
prettyInternal = Exp NodeInfo -> Printer ()
exp
exp :: Exp NodeInfo -> Printer ()
exp :: Exp NodeInfo -> Printer ()
exp (Lambda NodeInfo
_ [Pat NodeInfo]
pats (Do NodeInfo
l [Stmt NodeInfo]
stmts)) =
do
Maybe PrintState
mst <-
Printer () -> Printer (Maybe PrintState)
forall a. Printer a -> Printer (Maybe PrintState)
fitsOnOneLine
(do String -> Printer ()
write String
"\\"
[Printer ()] -> Printer ()
spaced ((Pat NodeInfo -> Printer ()) -> [Pat NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Pat NodeInfo]
pats)
String -> Printer ()
write String
" -> "
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty (NodeInfo -> [Stmt NodeInfo] -> Exp NodeInfo
forall l. l -> [Stmt l] -> Exp l
Do NodeInfo
l [Stmt NodeInfo]
stmts))
case Maybe PrintState
mst of
Maybe PrintState
Nothing -> Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer ()
swing (do String -> Printer ()
write String
"\\"
[Printer ()] -> Printer ()
spaced ((Pat NodeInfo -> Printer ()) -> [Pat NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Pat NodeInfo]
pats)
String -> Printer ()
write String
" -> do")
([Printer ()] -> Printer ()
lined ((Stmt NodeInfo -> Printer ()) -> [Stmt NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Stmt NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Stmt NodeInfo]
stmts))
Just PrintState
st -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st
exp (Tuple NodeInfo
_ Boxed
boxed [Exp NodeInfo]
exps) = do
let horVariant :: Printer ()
horVariant = Boxed -> Printer () -> Printer ()
forall a. Boxed -> Printer a -> Printer a
parensHorB Boxed
boxed (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Printer () -> [Printer ()] -> Printer ()
inter (String -> Printer ()
write String
", ") ((Exp NodeInfo -> Printer ()) -> [Exp NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Exp NodeInfo]
exps)
verVariant :: Printer ()
verVariant = Boxed -> Printer () -> Printer ()
forall a. Boxed -> Printer a -> Printer a
parensVerB Boxed
boxed (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ String -> [Printer ()] -> Printer ()
prefixedLined String
"," ((Exp NodeInfo -> Printer ()) -> [Exp NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend Printer ()
space (Printer () -> Printer ())
-> (Exp NodeInfo -> Printer ()) -> Exp NodeInfo -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty) [Exp NodeInfo]
exps)
Maybe PrintState
mst <- Printer () -> Printer (Maybe PrintState)
forall a. Printer a -> Printer (Maybe PrintState)
fitsOnOneLine Printer ()
horVariant
case Maybe PrintState
mst of
Maybe PrintState
Nothing -> Printer ()
verVariant
Just PrintState
st -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st
where
parensHorB :: Boxed -> Printer a -> Printer a
parensHorB Boxed
Boxed = Printer a -> Printer a
forall a. Printer a -> Printer a
parens
parensHorB Boxed
Unboxed = String -> String -> Printer a -> Printer a
forall a. String -> String -> Printer a -> Printer a
wrap String
"(# " String
" #)"
parensVerB :: Boxed -> Printer a -> Printer a
parensVerB Boxed
Boxed = Printer a -> Printer a
forall a. Printer a -> Printer a
parens
parensVerB Boxed
Unboxed = String -> String -> Printer a -> Printer a
forall a. String -> String -> Printer a -> Printer a
wrap String
"(#" String
"#)"
exp (TupleSection NodeInfo
_ Boxed
boxed [Maybe (Exp NodeInfo)]
mexps) = do
let horVariant :: Printer ()
horVariant = Boxed -> Printer () -> Printer ()
forall a. Boxed -> Printer a -> Printer a
parensHorB Boxed
boxed (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Printer () -> [Printer ()] -> Printer ()
inter (String -> Printer ()
write String
", ") ((Maybe (Exp NodeInfo) -> Printer ())
-> [Maybe (Exp NodeInfo)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map (Printer ()
-> (Exp NodeInfo -> Printer ())
-> Maybe (Exp NodeInfo)
-> Printer ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty) [Maybe (Exp NodeInfo)]
mexps)
verVariant :: Printer ()
verVariant =
Boxed -> Printer () -> Printer ()
forall a. Boxed -> Printer a -> Printer a
parensVerB Boxed
boxed (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ String -> [Printer ()] -> Printer ()
prefixedLined String
"," ((Maybe (Exp NodeInfo) -> Printer ())
-> [Maybe (Exp NodeInfo)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map (Printer ()
-> (Exp NodeInfo -> Printer ())
-> Maybe (Exp NodeInfo)
-> Printer ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend Printer ()
space (Printer () -> Printer ())
-> (Exp NodeInfo -> Printer ()) -> Exp NodeInfo -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty)) [Maybe (Exp NodeInfo)]
mexps)
Maybe PrintState
mst <- Printer () -> Printer (Maybe PrintState)
forall a. Printer a -> Printer (Maybe PrintState)
fitsOnOneLine Printer ()
horVariant
case Maybe PrintState
mst of
Maybe PrintState
Nothing -> Printer ()
verVariant
Just PrintState
st -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st
where
parensHorB :: Boxed -> Printer a -> Printer a
parensHorB Boxed
Boxed = Printer a -> Printer a
forall a. Printer a -> Printer a
parens
parensHorB Boxed
Unboxed = String -> String -> Printer a -> Printer a
forall a. String -> String -> Printer a -> Printer a
wrap String
"(# " String
" #)"
parensVerB :: Boxed -> Printer a -> Printer a
parensVerB Boxed
Boxed = Printer a -> Printer a
forall a. Printer a -> Printer a
parens
parensVerB Boxed
Unboxed = String -> String -> Printer a -> Printer a
forall a. String -> String -> Printer a -> Printer a
wrap String
"(#" String
"#)"
exp (UnboxedSum{}) = String -> Printer ()
forall a. HasCallStack => String -> a
error String
"FIXME: No implementation for UnboxedSum."
exp e :: Exp NodeInfo
e@(InfixApp NodeInfo
_ Exp NodeInfo
a QOp NodeInfo
op Exp NodeInfo
b) =
Exp NodeInfo
-> Exp NodeInfo
-> QOp NodeInfo
-> Exp NodeInfo
-> Maybe Int64
-> Printer ()
infixApp Exp NodeInfo
e Exp NodeInfo
a QOp NodeInfo
op Exp NodeInfo
b Maybe Int64
forall a. Maybe a
Nothing
exp (If NodeInfo
_ Exp NodeInfo
if' Exp NodeInfo
then' Exp NodeInfo
else') =
do Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"if ")
(Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
if')
Printer ()
newline
Int64
indentSpaces <- Printer Int64
getIndentSpaces
Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indented Int64
indentSpaces
(do String -> Exp NodeInfo -> Printer ()
branch String
"then " Exp NodeInfo
then'
Printer ()
newline
String -> Exp NodeInfo -> Printer ()
branch String
"else " Exp NodeInfo
else')
where branch :: String -> Exp NodeInfo -> Printer ()
branch String
str Exp NodeInfo
e =
case Exp NodeInfo
e of
Do NodeInfo
_ [Stmt NodeInfo]
stmts ->
do String -> Printer ()
write String
str
String -> Printer ()
write String
"do"
Printer ()
newline
Int64
indentSpaces <- Printer Int64
getIndentSpaces
Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indented Int64
indentSpaces ([Printer ()] -> Printer ()
lined ((Stmt NodeInfo -> Printer ()) -> [Stmt NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Stmt NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Stmt NodeInfo]
stmts))
Exp NodeInfo
_ ->
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
str)
(Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e)
exp (App NodeInfo
_ Exp NodeInfo
op Exp NodeInfo
arg) = do
let flattened :: [Exp NodeInfo]
flattened = Exp NodeInfo -> [Exp NodeInfo]
flatten Exp NodeInfo
op [Exp NodeInfo] -> [Exp NodeInfo] -> [Exp NodeInfo]
forall a. [a] -> [a] -> [a]
++ [Exp NodeInfo
arg]
Maybe PrintState
mst <- Printer () -> Printer (Maybe PrintState)
forall a. Printer a -> Printer (Maybe PrintState)
fitsOnOneLine ([Printer ()] -> Printer ()
spaced ((Exp NodeInfo -> Printer ()) -> [Exp NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Exp NodeInfo]
flattened))
case Maybe PrintState
mst of
Maybe PrintState
Nothing -> do
let (Exp NodeInfo
f:[Exp NodeInfo]
args) = [Exp NodeInfo]
flattened
Int64
col <- (PrintState -> Int64) -> Printer Int64
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Int64
psColumn
Int64
spaces <- Printer Int64
getIndentSpaces
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
f
Int64
col' <- (PrintState -> Int64) -> Printer Int64
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Int64
psColumn
let diff :: Int64
diff = Int64
col' Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
col Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- if Int64
col Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0 then Int64
spaces else Int64
0
if Int64
diff Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
1 Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
spaces
then Printer ()
space
else Printer ()
newline
Int64
spaces' <- Printer Int64
getIndentSpaces
Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indented Int64
spaces' ([Printer ()] -> Printer ()
lined ((Exp NodeInfo -> Printer ()) -> [Exp NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Exp NodeInfo]
args))
Just PrintState
st -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st
where
flatten :: Exp NodeInfo -> [Exp NodeInfo]
flatten (App NodeInfo
label' Exp NodeInfo
op' Exp NodeInfo
arg') = Exp NodeInfo -> [Exp NodeInfo]
flatten Exp NodeInfo
op' [Exp NodeInfo] -> [Exp NodeInfo] -> [Exp NodeInfo]
forall a. [a] -> [a] -> [a]
++ [(NodeInfo -> NodeInfo) -> Exp NodeInfo -> Exp NodeInfo
forall (ast :: * -> *) l.
Annotated ast =>
(l -> l) -> ast l -> ast l
amap (NodeInfo -> NodeInfo -> NodeInfo
addComments NodeInfo
label') Exp NodeInfo
arg']
flatten Exp NodeInfo
x = [Exp NodeInfo
x]
addComments :: NodeInfo -> NodeInfo -> NodeInfo
addComments NodeInfo
n1 NodeInfo
n2 =
NodeInfo
n2
{ nodeInfoComments :: [NodeComment]
nodeInfoComments = [NodeComment] -> [NodeComment]
forall a. Eq a => [a] -> [a]
nub (NodeInfo -> [NodeComment]
nodeInfoComments NodeInfo
n2 [NodeComment] -> [NodeComment] -> [NodeComment]
forall a. [a] -> [a] -> [a]
++ NodeInfo -> [NodeComment]
nodeInfoComments NodeInfo
n1)
}
exp (List NodeInfo
_ [Exp NodeInfo]
es) =
do Maybe PrintState
mst <- Printer () -> Printer (Maybe PrintState)
forall a. Printer a -> Printer (Maybe PrintState)
fitsOnOneLine Printer ()
p
case Maybe PrintState
mst of
Maybe PrintState
Nothing -> do
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend
(String -> Printer ()
write String
"[")
(String -> [Printer ()] -> Printer ()
prefixedLined String
"," ((Exp NodeInfo -> Printer ()) -> [Exp NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend Printer ()
space (Printer () -> Printer ())
-> (Exp NodeInfo -> Printer ()) -> Exp NodeInfo -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty) [Exp NodeInfo]
es))
Printer ()
newline
String -> Printer ()
write String
"]"
Just PrintState
st -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st
where p :: Printer ()
p =
Printer () -> Printer ()
forall a. Printer a -> Printer a
brackets (Printer () -> [Printer ()] -> Printer ()
inter (String -> Printer ()
write String
", ")
((Exp NodeInfo -> Printer ()) -> [Exp NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Exp NodeInfo]
es))
exp (RecUpdate NodeInfo
_ Exp NodeInfo
exp' [FieldUpdate NodeInfo]
updates) = Printer () -> [FieldUpdate NodeInfo] -> Printer ()
recUpdateExpr (Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
exp') [FieldUpdate NodeInfo]
updates
exp (RecConstr NodeInfo
_ QName NodeInfo
qname [FieldUpdate NodeInfo]
updates) = Printer () -> [FieldUpdate NodeInfo] -> Printer ()
recUpdateExpr (QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
qname) [FieldUpdate NodeInfo]
updates
exp (Let NodeInfo
_ Binds NodeInfo
binds Exp NodeInfo
e) =
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"let ")
(do Binds NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Binds NodeInfo
binds
Printer ()
newline
Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indented (-Int64
3) (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"in ")
(Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e)))
exp (ListComp NodeInfo
_ Exp NodeInfo
e [QualStmt NodeInfo]
qstmt) = do
let horVariant :: Printer ()
horVariant = Printer () -> Printer ()
forall a. Printer a -> Printer a
brackets (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e
String -> Printer ()
write String
" | "
[Printer ()] -> Printer ()
commas ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (QualStmt NodeInfo -> Printer ())
-> [QualStmt NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map QualStmt NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [QualStmt NodeInfo]
qstmt
verVariant :: Printer ()
verVariant = do
String -> Printer ()
write String
"[ "
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e
Printer ()
newline
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"| ") (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ String -> [Printer ()] -> Printer ()
prefixedLined String
", " ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (QualStmt NodeInfo -> Printer ())
-> [QualStmt NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map QualStmt NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [QualStmt NodeInfo]
qstmt
Printer ()
newline
String -> Printer ()
write String
"]"
Printer ()
horVariant Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
`ifFitsOnOneLineOrElse` Printer ()
verVariant
exp (ParComp NodeInfo
_ Exp NodeInfo
e [[QualStmt NodeInfo]]
qstmts) = do
let horVariant :: Printer ()
horVariant = Printer () -> Printer ()
forall a. Printer a -> Printer a
brackets (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e
[[QualStmt NodeInfo]]
-> ([QualStmt NodeInfo] -> Printer ()) -> Printer ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [[QualStmt NodeInfo]]
qstmts (([QualStmt NodeInfo] -> Printer ()) -> Printer ())
-> ([QualStmt NodeInfo] -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \[QualStmt NodeInfo]
qstmt -> do
String -> Printer ()
write String
" | "
[Printer ()] -> Printer ()
commas ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (QualStmt NodeInfo -> Printer ())
-> [QualStmt NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map QualStmt NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [QualStmt NodeInfo]
qstmt
verVariant :: Printer ()
verVariant = do
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"[ ") (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e
Printer ()
newline
[[QualStmt NodeInfo]]
-> ([QualStmt NodeInfo] -> Printer ()) -> Printer ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [[QualStmt NodeInfo]]
qstmts (([QualStmt NodeInfo] -> Printer ()) -> Printer ())
-> ([QualStmt NodeInfo] -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \[QualStmt NodeInfo]
qstmt -> do
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"| ") (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ String -> [Printer ()] -> Printer ()
prefixedLined String
", " ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (QualStmt NodeInfo -> Printer ())
-> [QualStmt NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map QualStmt NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [QualStmt NodeInfo]
qstmt
Printer ()
newline
String -> Printer ()
write String
"]"
Printer ()
horVariant Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
`ifFitsOnOneLineOrElse` Printer ()
verVariant
exp (TypeApp NodeInfo
_ Type NodeInfo
t) = do
String -> Printer ()
write String
"@"
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
t
exp (NegApp NodeInfo
_ Exp NodeInfo
e) =
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"-")
(Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e)
exp (Lambda NodeInfo
_ [Pat NodeInfo]
ps Exp NodeInfo
e) = do
String -> Printer ()
write String
"\\"
[Printer ()] -> Printer ()
spaced [ do case (Int
i, Pat NodeInfo
x) of
(Int
0, PIrrPat {}) -> Printer ()
space
(Int
0, PBangPat {}) -> Printer ()
space
(Int, Pat NodeInfo)
_ -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
x
| (Int
i, Pat NodeInfo
x) <- [Int] -> [Pat NodeInfo] -> [(Int, Pat NodeInfo)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 :: Int ..] [Pat NodeInfo]
ps
]
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer ()
swing (String -> Printer ()
write String
" ->") (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e
exp (Paren NodeInfo
_ Exp NodeInfo
e) = Printer () -> Printer ()
forall a. Printer a -> Printer a
parens (Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e)
exp (Case NodeInfo
_ Exp NodeInfo
e [Alt NodeInfo]
alts) =
do Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"case ")
(do Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e
String -> Printer ()
write String
" of")
if [Alt NodeInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Alt NodeInfo]
alts
then String -> Printer ()
write String
" {}"
else do Printer ()
newline
Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock ([Printer ()] -> Printer ()
lined ((Alt NodeInfo -> Printer ()) -> [Alt NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Printer () -> Printer ()
forall a. Bool -> Printer a -> Printer a
withCaseContext Bool
True (Printer () -> Printer ())
-> (Alt NodeInfo -> Printer ()) -> Alt NodeInfo -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alt NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty) [Alt NodeInfo]
alts))
exp (Do NodeInfo
_ [Stmt NodeInfo]
stmts) =
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"do ")
([Printer ()] -> Printer ()
lined ((Stmt NodeInfo -> Printer ()) -> [Stmt NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Stmt NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Stmt NodeInfo]
stmts))
exp (MDo NodeInfo
_ [Stmt NodeInfo]
stmts) =
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"mdo ")
([Printer ()] -> Printer ()
lined ((Stmt NodeInfo -> Printer ()) -> [Stmt NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Stmt NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Stmt NodeInfo]
stmts))
exp (LeftSection NodeInfo
_ Exp NodeInfo
e QOp NodeInfo
op) =
Printer () -> Printer ()
forall a. Printer a -> Printer a
parens (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (do Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e
Printer ()
space)
(QOp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QOp NodeInfo
op))
exp (RightSection NodeInfo
_ QOp NodeInfo
e Exp NodeInfo
op) =
Printer () -> Printer ()
forall a. Printer a -> Printer a
parens (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (do QOp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QOp NodeInfo
e
Printer ()
space)
(Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
op))
exp (EnumFrom NodeInfo
_ Exp NodeInfo
e) =
Printer () -> Printer ()
forall a. Printer a -> Printer a
brackets (do Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e
String -> Printer ()
write String
" ..")
exp (EnumFromTo NodeInfo
_ Exp NodeInfo
e Exp NodeInfo
f) =
Printer () -> Printer ()
forall a. Printer a -> Printer a
brackets (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (do Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e
String -> Printer ()
write String
" .. ")
(Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
f))
exp (EnumFromThen NodeInfo
_ Exp NodeInfo
e Exp NodeInfo
t) =
Printer () -> Printer ()
forall a. Printer a -> Printer a
brackets (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (do Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e
String -> Printer ()
write String
",")
(do Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
t
String -> Printer ()
write String
" .."))
exp (EnumFromThenTo NodeInfo
_ Exp NodeInfo
e Exp NodeInfo
t Exp NodeInfo
f) =
Printer () -> Printer ()
forall a. Printer a -> Printer a
brackets (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (do Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e
String -> Printer ()
write String
",")
(Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (do Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
t
String -> Printer ()
write String
" .. ")
(Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
f)))
exp (ExpTypeSig NodeInfo
_ Exp NodeInfo
e Type NodeInfo
t) =
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (do Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e
String -> Printer ()
write String
" :: ")
(Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
t)
exp (VarQuote NodeInfo
_ QName NodeInfo
x) =
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"'")
(QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
x)
exp (TypQuote NodeInfo
_ QName NodeInfo
x) =
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"''")
(QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
x)
exp (BracketExp NodeInfo
_ Bracket NodeInfo
b) = Bracket NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Bracket NodeInfo
b
exp (SpliceExp NodeInfo
_ Splice NodeInfo
s) = Splice NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Splice NodeInfo
s
exp (QuasiQuote NodeInfo
_ String
n String
s) = String -> Printer () -> Printer ()
quotation String
n (String -> Printer ()
string String
s)
exp (LCase NodeInfo
_ [Alt NodeInfo]
alts) =
do String -> Printer ()
write String
"\\case"
if [Alt NodeInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Alt NodeInfo]
alts
then String -> Printer ()
write String
" {}"
else do Printer ()
newline
Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock ([Printer ()] -> Printer ()
lined ((Alt NodeInfo -> Printer ()) -> [Alt NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Printer () -> Printer ()
forall a. Bool -> Printer a -> Printer a
withCaseContext Bool
True (Printer () -> Printer ())
-> (Alt NodeInfo -> Printer ()) -> Alt NodeInfo -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alt NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty) [Alt NodeInfo]
alts))
exp (MultiIf NodeInfo
_ [GuardedRhs NodeInfo]
alts) =
Bool -> Printer () -> Printer ()
forall a. Bool -> Printer a -> Printer a
withCaseContext
Bool
True
(Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend
(String -> Printer ()
write String
"if ")
([Printer ()] -> Printer ()
lined
((GuardedRhs NodeInfo -> Printer ())
-> [GuardedRhs NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map
(\GuardedRhs NodeInfo
p -> do
String -> Printer ()
write String
"| "
GuardedRhs NodeInfo -> Printer ()
prettyG GuardedRhs NodeInfo
p)
[GuardedRhs NodeInfo]
alts)))
where
prettyG :: GuardedRhs NodeInfo -> Printer ()
prettyG (GuardedRhs NodeInfo
_ [Stmt NodeInfo]
stmts Exp NodeInfo
e) = do
Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indented
Int64
1
(do ([Printer ()] -> Printer ()
lined (((Int, Stmt NodeInfo) -> Printer ())
-> [(Int, Stmt NodeInfo)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map
(\(Int
i,Stmt NodeInfo
p) -> do
Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1)
Printer ()
space
Stmt NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Stmt NodeInfo
p
Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Stmt NodeInfo] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Stmt NodeInfo]
stmts)
(String -> Printer ()
write String
","))
([Int] -> [Stmt NodeInfo] -> [(Int, Stmt NodeInfo)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [Stmt NodeInfo]
stmts))))
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer ()
swing (String -> Printer ()
write String
" " Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
rhsSeparator) (Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e)
exp (Lit NodeInfo
_ Literal NodeInfo
lit) = Literal NodeInfo -> Printer ()
forall (ast :: * -> *). Pretty ast => ast NodeInfo -> Printer ()
prettyInternal Literal NodeInfo
lit
exp (Var NodeInfo
_ QName NodeInfo
q) = QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
q
exp (IPVar NodeInfo
_ IPName NodeInfo
q) = IPName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty IPName NodeInfo
q
exp (Con NodeInfo
_ QName NodeInfo
q) = QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
q
exp x :: Exp NodeInfo
x@XTag{} = Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Exp NodeInfo
x
exp x :: Exp NodeInfo
x@XETag{} = Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Exp NodeInfo
x
exp x :: Exp NodeInfo
x@XPcdata{} = Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Exp NodeInfo
x
exp x :: Exp NodeInfo
x@XExpTag{} = Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Exp NodeInfo
x
exp x :: Exp NodeInfo
x@XChildTag{} = Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Exp NodeInfo
x
exp x :: Exp NodeInfo
x@CorePragma{} = Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Exp NodeInfo
x
exp x :: Exp NodeInfo
x@SCCPragma{} = Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Exp NodeInfo
x
exp x :: Exp NodeInfo
x@GenPragma{} = Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Exp NodeInfo
x
exp x :: Exp NodeInfo
x@Proc{} = Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Exp NodeInfo
x
exp x :: Exp NodeInfo
x@LeftArrApp{} = Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Exp NodeInfo
x
exp x :: Exp NodeInfo
x@RightArrApp{} = Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Exp NodeInfo
x
exp x :: Exp NodeInfo
x@LeftArrHighApp{} = Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Exp NodeInfo
x
exp x :: Exp NodeInfo
x@RightArrHighApp{} = Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Exp NodeInfo
x
exp x :: Exp NodeInfo
x@ParArray{} = Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Exp NodeInfo
x
exp x :: Exp NodeInfo
x@ParArrayFromTo{} = Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Exp NodeInfo
x
exp x :: Exp NodeInfo
x@ParArrayFromThenTo{} = Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Exp NodeInfo
x
exp x :: Exp NodeInfo
x@ParArrayComp{} = Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Exp NodeInfo
x
exp (OverloadedLabel NodeInfo
_ String
label) = String -> Printer ()
string (Char
'#' Char -> String -> String
forall a. a -> [a] -> [a]
: String
label)
instance Pretty IPName where
prettyInternal :: IPName NodeInfo -> Printer ()
prettyInternal = IPName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty'
instance Pretty Stmt where
prettyInternal :: Stmt NodeInfo -> Printer ()
prettyInternal =
Stmt NodeInfo -> Printer ()
stmt
instance Pretty QualStmt where
prettyInternal :: QualStmt NodeInfo -> Printer ()
prettyInternal QualStmt NodeInfo
x =
case QualStmt NodeInfo
x of
QualStmt NodeInfo
_ Stmt NodeInfo
s -> Stmt NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Stmt NodeInfo
s
ThenTrans NodeInfo
_ Exp NodeInfo
s -> do
String -> Printer ()
write String
"then "
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
s
ThenBy NodeInfo
_ Exp NodeInfo
s Exp NodeInfo
t -> do
String -> Printer ()
write String
"then "
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
s
String -> Printer ()
write String
" by "
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
t
GroupBy NodeInfo
_ Exp NodeInfo
s -> do
String -> Printer ()
write String
"then group by "
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
s
GroupUsing NodeInfo
_ Exp NodeInfo
s -> do
String -> Printer ()
write String
"then group using "
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
s
GroupByUsing NodeInfo
_ Exp NodeInfo
s Exp NodeInfo
t -> do
String -> Printer ()
write String
"then group by "
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
s
String -> Printer ()
write String
" using "
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
t
instance Pretty Decl where
prettyInternal :: Decl NodeInfo -> Printer ()
prettyInternal = Decl NodeInfo -> Printer ()
decl'
decl :: Decl NodeInfo -> Printer ()
decl :: Decl NodeInfo -> Printer ()
decl (InstDecl NodeInfo
_ Maybe (Overlap NodeInfo)
moverlap InstRule NodeInfo
dhead Maybe [InstDecl NodeInfo]
decls) =
do Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"instance ")
(Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (Maybe (Overlap NodeInfo) -> Printer ()
maybeOverlap Maybe (Overlap NodeInfo)
moverlap)
(Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (InstRule NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty InstRule NodeInfo
dhead)
(Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([InstDecl NodeInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([InstDecl NodeInfo]
-> Maybe [InstDecl NodeInfo] -> [InstDecl NodeInfo]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [InstDecl NodeInfo]
decls))
(String -> Printer ()
write String
" where"))))
Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([InstDecl NodeInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([InstDecl NodeInfo]
-> Maybe [InstDecl NodeInfo] -> [InstDecl NodeInfo]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [InstDecl NodeInfo]
decls))
(do Printer ()
newline
Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock ([Printer ()] -> Printer ()
lined ((InstDecl NodeInfo -> Printer ())
-> [InstDecl NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map InstDecl NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ([InstDecl NodeInfo]
-> Maybe [InstDecl NodeInfo] -> [InstDecl NodeInfo]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [InstDecl NodeInfo]
decls))))
decl (SpliceDecl NodeInfo
_ Exp NodeInfo
e) = Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e
decl (TypeSig NodeInfo
_ [Name NodeInfo]
names Type NodeInfo
ty) =
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (do Printer () -> [Printer ()] -> Printer ()
inter (String -> Printer ()
write String
", ")
((Name NodeInfo -> Printer ()) -> [Name NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Name NodeInfo]
names)
String -> Printer ()
write String
" :: ")
(Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty)
decl (FunBind NodeInfo
_ [Match NodeInfo]
matches) =
[Printer ()] -> Printer ()
lined ((Match NodeInfo -> Printer ()) -> [Match NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Match NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Match NodeInfo]
matches)
decl (ClassDecl NodeInfo
_ Maybe (Context NodeInfo)
ctx DeclHead NodeInfo
dhead [FunDep NodeInfo]
fundeps Maybe [ClassDecl NodeInfo]
decls) =
do Maybe (Context NodeInfo)
-> DeclHead NodeInfo
-> [FunDep NodeInfo]
-> Maybe [ClassDecl NodeInfo]
-> Printer ()
classHead Maybe (Context NodeInfo)
ctx DeclHead NodeInfo
dhead [FunDep NodeInfo]
fundeps Maybe [ClassDecl NodeInfo]
decls
Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([ClassDecl NodeInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([ClassDecl NodeInfo]
-> Maybe [ClassDecl NodeInfo] -> [ClassDecl NodeInfo]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [ClassDecl NodeInfo]
decls))
(do Printer ()
newline
Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock ([Printer ()] -> Printer ()
lined ((ClassDecl NodeInfo -> Printer ())
-> [ClassDecl NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map ClassDecl NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ([ClassDecl NodeInfo]
-> Maybe [ClassDecl NodeInfo] -> [ClassDecl NodeInfo]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [ClassDecl NodeInfo]
decls))))
decl (TypeDecl NodeInfo
_ DeclHead NodeInfo
typehead Type NodeInfo
typ') = do
String -> Printer ()
write String
"type "
DeclHead NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty DeclHead NodeInfo
typehead
Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
ifFitsOnOneLineOrElse
(Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
" = ") (Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
typ'))
(do Printer ()
newline
Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
" = ") (Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
typ')))
decl (TypeFamDecl NodeInfo
_ DeclHead NodeInfo
declhead Maybe (ResultSig NodeInfo)
result Maybe (InjectivityInfo NodeInfo)
injectivity) = do
String -> Printer ()
write String
"type family "
DeclHead NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty DeclHead NodeInfo
declhead
case Maybe (ResultSig NodeInfo)
result of
Just ResultSig NodeInfo
r -> do
Printer ()
space
let sep :: String
sep = case ResultSig NodeInfo
r of
KindSig NodeInfo
_ Type NodeInfo
_ -> String
"::"
TyVarSig NodeInfo
_ TyVarBind NodeInfo
_ -> String
"="
String -> Printer ()
write String
sep
Printer ()
space
ResultSig NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ResultSig NodeInfo
r
Maybe (ResultSig NodeInfo)
Nothing -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
case Maybe (InjectivityInfo NodeInfo)
injectivity of
Just InjectivityInfo NodeInfo
i -> do
Printer ()
space
InjectivityInfo NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty InjectivityInfo NodeInfo
i
Maybe (InjectivityInfo NodeInfo)
Nothing -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
decl (ClosedTypeFamDecl NodeInfo
_ DeclHead NodeInfo
declhead Maybe (ResultSig NodeInfo)
result Maybe (InjectivityInfo NodeInfo)
injectivity [TypeEqn NodeInfo]
instances) = do
String -> Printer ()
write String
"type family "
DeclHead NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty DeclHead NodeInfo
declhead
Maybe (ResultSig NodeInfo)
-> (ResultSig NodeInfo -> Printer ()) -> Printer ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe (ResultSig NodeInfo)
result ((ResultSig NodeInfo -> Printer ()) -> Printer ())
-> (ResultSig NodeInfo -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \ResultSig NodeInfo
r -> do
Printer ()
space
let sep :: String
sep = case ResultSig NodeInfo
r of
KindSig NodeInfo
_ Type NodeInfo
_ -> String
"::"
TyVarSig NodeInfo
_ TyVarBind NodeInfo
_ -> String
"="
String -> Printer ()
write String
sep
Printer ()
space
ResultSig NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ResultSig NodeInfo
r
Maybe (InjectivityInfo NodeInfo)
-> (InjectivityInfo NodeInfo -> Printer ()) -> Printer ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe (InjectivityInfo NodeInfo)
injectivity ((InjectivityInfo NodeInfo -> Printer ()) -> Printer ())
-> (InjectivityInfo NodeInfo -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \InjectivityInfo NodeInfo
i -> do
Printer ()
space
InjectivityInfo NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty InjectivityInfo NodeInfo
i
Printer ()
space
String -> Printer ()
write String
"where"
Printer ()
newline
Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock ([Printer ()] -> Printer ()
lined ((TypeEqn NodeInfo -> Printer ())
-> [TypeEqn NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map TypeEqn NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [TypeEqn NodeInfo]
instances))
decl (DataDecl NodeInfo
_ DataOrNew NodeInfo
dataornew Maybe (Context NodeInfo)
ctx DeclHead NodeInfo
dhead [QualConDecl NodeInfo]
condecls [Deriving NodeInfo]
mderivs) =
do Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (do DataOrNew NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty DataOrNew NodeInfo
dataornew
Printer ()
space)
(Maybe (Context NodeInfo) -> Printer () -> Printer ()
forall (ast :: * -> *) b.
(Pretty ast, Show (ast NodeInfo)) =>
Maybe (ast NodeInfo) -> Printer b -> Printer b
withCtx Maybe (Context NodeInfo)
ctx
(do DeclHead NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty DeclHead NodeInfo
dhead
case [QualConDecl NodeInfo]
condecls of
[] -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
[QualConDecl NodeInfo
x] -> QualConDecl NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
singleCons QualConDecl NodeInfo
x
[QualConDecl NodeInfo]
xs -> [QualConDecl NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
[ast NodeInfo] -> Printer ()
multiCons [QualConDecl NodeInfo]
xs))
Int64
indentSpaces <- Printer Int64
getIndentSpaces
[Deriving NodeInfo]
-> (Deriving NodeInfo -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Deriving NodeInfo]
mderivs ((Deriving NodeInfo -> Printer ()) -> Printer ())
-> (Deriving NodeInfo -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \Deriving NodeInfo
deriv -> Printer ()
newline Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
column Int64
indentSpaces (Deriving NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Deriving NodeInfo
deriv)
where singleCons :: ast NodeInfo -> Printer ()
singleCons ast NodeInfo
x =
do String -> Printer ()
write String
" ="
Int64
indentSpaces <- Printer Int64
getIndentSpaces
Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
column Int64
indentSpaces
(do Printer ()
newline
ast NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ast NodeInfo
x)
multiCons :: [ast NodeInfo] -> Printer ()
multiCons [ast NodeInfo]
xs =
do Printer ()
newline
Int64
indentSpaces <- Printer Int64
getIndentSpaces
Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
column Int64
indentSpaces
(Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"=")
(String -> [Printer ()] -> Printer ()
prefixedLined String
"|"
((ast NodeInfo -> Printer ()) -> [ast NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend Printer ()
space (Printer () -> Printer ())
-> (ast NodeInfo -> Printer ()) -> ast NodeInfo -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ast NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty) [ast NodeInfo]
xs)))
decl (GDataDecl NodeInfo
_ DataOrNew NodeInfo
dataornew Maybe (Context NodeInfo)
ctx DeclHead NodeInfo
dhead Maybe (Type NodeInfo)
mkind [GadtDecl NodeInfo]
condecls [Deriving NodeInfo]
mderivs) =
do Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (DataOrNew NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty DataOrNew NodeInfo
dataornew Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space)
(Maybe (Context NodeInfo) -> Printer () -> Printer ()
forall (ast :: * -> *) b.
(Pretty ast, Show (ast NodeInfo)) =>
Maybe (ast NodeInfo) -> Printer b -> Printer b
withCtx Maybe (Context NodeInfo)
ctx
(do DeclHead NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty DeclHead NodeInfo
dhead
case Maybe (Type NodeInfo)
mkind of
Maybe (Type NodeInfo)
Nothing -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just Type NodeInfo
kind -> do String -> Printer ()
write String
" :: "
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
kind
String -> Printer ()
write String
" where"))
Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
case [GadtDecl NodeInfo]
condecls of
[] -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
[GadtDecl NodeInfo]
_ -> do
Printer ()
newline
[Printer ()] -> Printer ()
lined ((GadtDecl NodeInfo -> Printer ())
-> [GadtDecl NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map GadtDecl NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [GadtDecl NodeInfo]
condecls)
[Deriving NodeInfo]
-> (Deriving NodeInfo -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Deriving NodeInfo]
mderivs ((Deriving NodeInfo -> Printer ()) -> Printer ())
-> (Deriving NodeInfo -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \Deriving NodeInfo
deriv -> Printer ()
newline Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Deriving NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Deriving NodeInfo
deriv
decl (InlineSig NodeInfo
_ Bool
inline Maybe (Activation NodeInfo)
active QName NodeInfo
name) = do
String -> Printer ()
write String
"{-# "
Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
inline (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ String -> Printer ()
write String
"NO"
String -> Printer ()
write String
"INLINE "
case Maybe (Activation NodeInfo)
active of
Maybe (Activation NodeInfo)
Nothing -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just (ActiveFrom NodeInfo
_ Int
x) -> String -> Printer ()
write (String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"] ")
Just (ActiveUntil NodeInfo
_ Int
x) -> String -> Printer ()
write (String
"[~" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"] ")
QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
name
String -> Printer ()
write String
" #-}"
decl (MinimalPragma NodeInfo
_ (Just BooleanFormula NodeInfo
formula)) =
String -> String -> Printer () -> Printer ()
forall a. String -> String -> Printer a -> Printer a
wrap String
"{-# " String
" #-}" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"MINIMAL ") (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ BooleanFormula NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty BooleanFormula NodeInfo
formula
decl (ForImp NodeInfo
_ CallConv NodeInfo
callconv Maybe (Safety NodeInfo)
maybeSafety Maybe String
maybeName Name NodeInfo
name Type NodeInfo
ty) = do
String -> Printer ()
string String
"foreign import "
CallConv NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' CallConv NodeInfo
callconv Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space
case Maybe (Safety NodeInfo)
maybeSafety of
Just Safety NodeInfo
safety -> Safety NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Safety NodeInfo
safety Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space
Maybe (Safety NodeInfo)
Nothing -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
case Maybe String
maybeName of
Just String
namestr -> String -> Printer ()
string (String -> String
forall a. Show a => a -> String
show String
namestr) Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space
Maybe String
Nothing -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Name NodeInfo
name
Maybe PrintState
tyline <- Printer () -> Printer (Maybe PrintState)
forall a. Printer a -> Printer (Maybe PrintState)
fitsOnOneLine (Printer () -> Printer (Maybe PrintState))
-> Printer () -> Printer (Maybe PrintState)
forall a b. (a -> b) -> a -> b
$ do String -> Printer ()
string String
" :: "
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Type NodeInfo
ty
case Maybe PrintState
tyline of
Just PrintState
line -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
line
Maybe PrintState
Nothing -> do Printer ()
newline
Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do String -> Printer ()
string String
":: "
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Type NodeInfo
ty
decl (ForExp NodeInfo
_ CallConv NodeInfo
callconv Maybe String
maybeName Name NodeInfo
name Type NodeInfo
ty) = do
String -> Printer ()
string String
"foreign export "
CallConv NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' CallConv NodeInfo
callconv Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space
case Maybe String
maybeName of
Just String
namestr -> String -> Printer ()
string (String -> String
forall a. Show a => a -> String
show String
namestr) Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space
Maybe String
Nothing -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Name NodeInfo
name
Maybe PrintState
tyline <- Printer () -> Printer (Maybe PrintState)
forall a. Printer a -> Printer (Maybe PrintState)
fitsOnOneLine (Printer () -> Printer (Maybe PrintState))
-> Printer () -> Printer (Maybe PrintState)
forall a b. (a -> b) -> a -> b
$ do String -> Printer ()
string String
" :: "
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Type NodeInfo
ty
case Maybe PrintState
tyline of
Just PrintState
line -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
line
Maybe PrintState
Nothing -> do Printer ()
newline
Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do String -> Printer ()
string String
":: "
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Type NodeInfo
ty
decl Decl NodeInfo
x' = Decl NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Decl NodeInfo
x'
classHead
:: Maybe (Context NodeInfo)
-> DeclHead NodeInfo
-> [FunDep NodeInfo]
-> Maybe [ClassDecl NodeInfo]
-> Printer ()
classHead :: Maybe (Context NodeInfo)
-> DeclHead NodeInfo
-> [FunDep NodeInfo]
-> Maybe [ClassDecl NodeInfo]
-> Printer ()
classHead Maybe (Context NodeInfo)
ctx DeclHead NodeInfo
dhead [FunDep NodeInfo]
fundeps Maybe [ClassDecl NodeInfo]
decls = Printer ()
shortHead Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
`ifFitsOnOneLineOrElse` Printer ()
longHead
where
shortHead :: Printer ()
shortHead =
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend
(String -> Printer ()
write String
"class ")
(Maybe (Context NodeInfo) -> Printer () -> Printer ()
forall (ast :: * -> *) b.
(Pretty ast, Show (ast NodeInfo)) =>
Maybe (ast NodeInfo) -> Printer b -> Printer b
withCtx Maybe (Context NodeInfo)
ctx (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend
(DeclHead NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty DeclHead NodeInfo
dhead)
(Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([FunDep NodeInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FunDep NodeInfo]
fundeps) (String -> Printer ()
write String
" | " Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Printer ()] -> Printer ()
commas ((FunDep NodeInfo -> Printer ())
-> [FunDep NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map FunDep NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [FunDep NodeInfo]
fundeps)))
(Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([ClassDecl NodeInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([ClassDecl NodeInfo]
-> Maybe [ClassDecl NodeInfo] -> [ClassDecl NodeInfo]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [ClassDecl NodeInfo]
decls)) (String -> Printer ()
write String
" where"))))
longHead :: Printer ()
longHead = do
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"class ") (Maybe (Context NodeInfo) -> Printer () -> Printer ()
forall (ast :: * -> *) b.
(Pretty ast, Show (ast NodeInfo)) =>
Maybe (ast NodeInfo) -> Printer b -> Printer b
withCtx Maybe (Context NodeInfo)
ctx (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ DeclHead NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty DeclHead NodeInfo
dhead)
Printer ()
newline
Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([FunDep NodeInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FunDep NodeInfo]
fundeps) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"| ") (String -> [Printer ()] -> Printer ()
prefixedLined String
", " ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (FunDep NodeInfo -> Printer ())
-> [FunDep NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map FunDep NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [FunDep NodeInfo]
fundeps)
Printer ()
newline
Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([ClassDecl NodeInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([ClassDecl NodeInfo]
-> Maybe [ClassDecl NodeInfo] -> [ClassDecl NodeInfo]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [ClassDecl NodeInfo]
decls)) (String -> Printer ()
write String
"where")
instance Pretty TypeEqn where
prettyInternal :: TypeEqn NodeInfo -> Printer ()
prettyInternal (TypeEqn NodeInfo
_ Type NodeInfo
in_ Type NodeInfo
out_) = do
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
in_
String -> Printer ()
write String
" = "
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
out_
instance Pretty Deriving where
prettyInternal :: Deriving NodeInfo -> Printer ()
prettyInternal (Deriving NodeInfo
_ Maybe (DerivStrategy NodeInfo)
strategy [InstRule NodeInfo]
heads) =
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"deriving" Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
writeStrategy) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
let heads' :: [InstRule NodeInfo]
heads' =
if [InstRule NodeInfo] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [InstRule NodeInfo]
heads Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
then (InstRule NodeInfo -> InstRule NodeInfo)
-> [InstRule NodeInfo] -> [InstRule NodeInfo]
forall a b. (a -> b) -> [a] -> [b]
map InstRule NodeInfo -> InstRule NodeInfo
forall l. InstRule l -> InstRule l
stripParens [InstRule NodeInfo]
heads
else [InstRule NodeInfo]
heads
Maybe PrintState
maybeDerives <- Printer () -> Printer (Maybe PrintState)
forall a. Printer a -> Printer (Maybe PrintState)
fitsOnOneLine (Printer () -> Printer (Maybe PrintState))
-> Printer () -> Printer (Maybe PrintState)
forall a b. (a -> b) -> a -> b
$ Printer () -> Printer ()
forall a. Printer a -> Printer a
parens ([Printer ()] -> Printer ()
commas ((InstRule NodeInfo -> Printer ())
-> [InstRule NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map InstRule NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [InstRule NodeInfo]
heads'))
case Maybe PrintState
maybeDerives of
Maybe PrintState
Nothing -> [InstRule NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
[ast NodeInfo] -> Printer ()
formatMultiLine [InstRule NodeInfo]
heads'
Just PrintState
derives -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
derives
where
writeStrategy :: Printer ()
writeStrategy = case Maybe (DerivStrategy NodeInfo)
strategy of
Maybe (DerivStrategy NodeInfo)
Nothing -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just DerivStrategy NodeInfo
st -> DerivStrategy NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty DerivStrategy NodeInfo
st Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space
stripParens :: InstRule l -> InstRule l
stripParens (IParen l
_ InstRule l
iRule) = InstRule l -> InstRule l
stripParens InstRule l
iRule
stripParens InstRule l
x = InstRule l
x
formatMultiLine :: [ast NodeInfo] -> Printer ()
formatMultiLine [ast NodeInfo]
derives = do
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"( ") (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ String -> [Printer ()] -> Printer ()
prefixedLined String
", " ((ast NodeInfo -> Printer ()) -> [ast NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map ast NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [ast NodeInfo]
derives)
Printer ()
newline
String -> Printer ()
write String
")"
instance Pretty DerivStrategy where
prettyInternal :: DerivStrategy NodeInfo -> Printer ()
prettyInternal DerivStrategy NodeInfo
x =
case DerivStrategy NodeInfo
x of
DerivStock NodeInfo
_ -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
DerivAnyclass NodeInfo
_ -> String -> Printer ()
write String
"anyclass"
DerivNewtype NodeInfo
_ -> String -> Printer ()
write String
"newtype"
instance Pretty Alt where
prettyInternal :: Alt NodeInfo -> Printer ()
prettyInternal Alt NodeInfo
x =
case Alt NodeInfo
x of
Alt NodeInfo
_ Pat NodeInfo
p Rhs NodeInfo
galts Maybe (Binds NodeInfo)
mbinds ->
do Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
p
Rhs NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Rhs NodeInfo
galts
case Maybe (Binds NodeInfo)
mbinds of
Maybe (Binds NodeInfo)
Nothing -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just Binds NodeInfo
binds ->
do Printer ()
newline
Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"where ")
(Binds NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Binds NodeInfo
binds))
instance Pretty Asst where
prettyInternal :: Asst NodeInfo -> Printer ()
prettyInternal Asst NodeInfo
x =
case Asst NodeInfo
x of
IParam NodeInfo
_ IPName NodeInfo
name Type NodeInfo
ty -> do
IPName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty IPName NodeInfo
name
String -> Printer ()
write String
" :: "
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty
ParenA NodeInfo
_ Asst NodeInfo
asst -> Printer () -> Printer ()
forall a. Printer a -> Printer a
parens (Asst NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Asst NodeInfo
asst)
#if MIN_VERSION_haskell_src_exts(1,21,0)
TypeA NodeInfo
_ Type NodeInfo
ty -> Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty
#else
ClassA _ name types -> spaced (pretty name : map pretty types)
i@InfixA {} -> pretty' i
EqualP _ a b -> do
pretty a
write " ~ "
pretty b
AppA _ name tys ->
spaced (pretty name : map pretty tys)
WildCardA _ name ->
case name of
Nothing -> write "_"
Just n -> do
write "_"
pretty n
#endif
instance Pretty BangType where
prettyInternal :: BangType NodeInfo -> Printer ()
prettyInternal BangType NodeInfo
x =
case BangType NodeInfo
x of
BangedTy NodeInfo
_ -> String -> Printer ()
write String
"!"
LazyTy NodeInfo
_ -> String -> Printer ()
write String
"~"
NoStrictAnnot NodeInfo
_ -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
instance Pretty Unpackedness where
prettyInternal :: Unpackedness NodeInfo -> Printer ()
prettyInternal (Unpack NodeInfo
_) = String -> Printer ()
write String
"{-# UNPACK #-}"
prettyInternal (NoUnpack NodeInfo
_) = String -> Printer ()
write String
"{-# NOUNPACK #-}"
prettyInternal (NoUnpackPragma NodeInfo
_) = () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
instance Pretty Binds where
prettyInternal :: Binds NodeInfo -> Printer ()
prettyInternal Binds NodeInfo
x =
case Binds NodeInfo
x of
BDecls NodeInfo
_ [Decl NodeInfo]
ds -> [Printer ()] -> Printer ()
lined ((Decl NodeInfo -> Printer ()) -> [Decl NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Decl NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Decl NodeInfo]
ds)
IPBinds NodeInfo
_ [IPBind NodeInfo]
i -> [Printer ()] -> Printer ()
lined ((IPBind NodeInfo -> Printer ())
-> [IPBind NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map IPBind NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [IPBind NodeInfo]
i)
instance Pretty ClassDecl where
prettyInternal :: ClassDecl NodeInfo -> Printer ()
prettyInternal ClassDecl NodeInfo
x =
case ClassDecl NodeInfo
x of
ClsDecl NodeInfo
_ Decl NodeInfo
d -> Decl NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Decl NodeInfo
d
ClsDataFam NodeInfo
_ Maybe (Context NodeInfo)
ctx DeclHead NodeInfo
h Maybe (ResultSig NodeInfo)
mkind ->
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend
(String -> Printer ()
write String
"data ")
(Maybe (Context NodeInfo) -> Printer () -> Printer ()
forall (ast :: * -> *) b.
(Pretty ast, Show (ast NodeInfo)) =>
Maybe (ast NodeInfo) -> Printer b -> Printer b
withCtx
Maybe (Context NodeInfo)
ctx
(do DeclHead NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty DeclHead NodeInfo
h
(case Maybe (ResultSig NodeInfo)
mkind of
Maybe (ResultSig NodeInfo)
Nothing -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just ResultSig NodeInfo
kind -> do
String -> Printer ()
write String
" :: "
ResultSig NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ResultSig NodeInfo
kind)))
ClsTyFam NodeInfo
_ DeclHead NodeInfo
h Maybe (ResultSig NodeInfo)
msig Maybe (InjectivityInfo NodeInfo)
minj ->
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend
(String -> Printer ()
write String
"type ")
(Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend
(DeclHead NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty DeclHead NodeInfo
h)
(Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend
((ResultSig NodeInfo -> Printer ())
-> Maybe (ResultSig NodeInfo) -> Printer ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_
(\case
KindSig NodeInfo
_ Type NodeInfo
kind -> String -> Printer ()
write String
" :: " Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
kind
TyVarSig NodeInfo
_ TyVarBind NodeInfo
tyVarBind -> String -> Printer ()
write String
" = " Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TyVarBind NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty TyVarBind NodeInfo
tyVarBind)
Maybe (ResultSig NodeInfo)
msig)
((InjectivityInfo NodeInfo -> Printer ())
-> Maybe (InjectivityInfo NodeInfo) -> Printer ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (\InjectivityInfo NodeInfo
inj -> Printer ()
space Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> InjectivityInfo NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty InjectivityInfo NodeInfo
inj) Maybe (InjectivityInfo NodeInfo)
minj)))
ClsTyDef NodeInfo
_ (TypeEqn NodeInfo
_ Type NodeInfo
this Type NodeInfo
that) -> do
String -> Printer ()
write String
"type "
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
this
String -> Printer ()
write String
" = "
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
that
ClsDefSig NodeInfo
_ Name NodeInfo
name Type NodeInfo
ty -> do
String -> Printer ()
write String
"default "
Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Name NodeInfo
name
String -> Printer ()
write String
" :: "
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty
instance Pretty ConDecl where
prettyInternal :: ConDecl NodeInfo -> Printer ()
prettyInternal ConDecl NodeInfo
x =
ConDecl NodeInfo -> Printer ()
conDecl ConDecl NodeInfo
x
instance Pretty FieldDecl where
prettyInternal :: FieldDecl NodeInfo -> Printer ()
prettyInternal (FieldDecl NodeInfo
_ [Name NodeInfo]
names Type NodeInfo
ty) =
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (do [Printer ()] -> Printer ()
commas ((Name NodeInfo -> Printer ()) -> [Name NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Name NodeInfo]
names)
String -> Printer ()
write String
" :: ")
(Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty)
instance Pretty FieldUpdate where
prettyInternal :: FieldUpdate NodeInfo -> Printer ()
prettyInternal FieldUpdate NodeInfo
x =
case FieldUpdate NodeInfo
x of
FieldUpdate NodeInfo
_ QName NodeInfo
n Exp NodeInfo
e ->
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer ()
swing (do QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
n
String -> Printer ()
write String
" =")
(Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e)
FieldPun NodeInfo
_ QName NodeInfo
n -> QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
n
FieldWildcard NodeInfo
_ -> String -> Printer ()
write String
".."
instance Pretty GuardedRhs where
prettyInternal :: GuardedRhs NodeInfo -> Printer ()
prettyInternal =
GuardedRhs NodeInfo -> Printer ()
guardedRhs
instance Pretty InjectivityInfo where
prettyInternal :: InjectivityInfo NodeInfo -> Printer ()
prettyInternal InjectivityInfo NodeInfo
x = InjectivityInfo NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' InjectivityInfo NodeInfo
x
instance Pretty InstDecl where
prettyInternal :: InstDecl NodeInfo -> Printer ()
prettyInternal InstDecl NodeInfo
i =
case InstDecl NodeInfo
i of
InsDecl NodeInfo
_ Decl NodeInfo
d -> Decl NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Decl NodeInfo
d
InsType NodeInfo
_ Type NodeInfo
name Type NodeInfo
ty ->
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (do String -> Printer ()
write String
"type "
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
name
String -> Printer ()
write String
" = ")
(Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty)
InstDecl NodeInfo
_ -> InstDecl NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' InstDecl NodeInfo
i
instance Pretty Match where
prettyInternal :: Match NodeInfo -> Printer ()
prettyInternal = Match NodeInfo -> Printer ()
match
instance Pretty PatField where
prettyInternal :: PatField NodeInfo -> Printer ()
prettyInternal PatField NodeInfo
x =
case PatField NodeInfo
x of
PFieldPat NodeInfo
_ QName NodeInfo
n Pat NodeInfo
p ->
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (do QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
n
String -> Printer ()
write String
" = ")
(Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
p)
PFieldPun NodeInfo
_ QName NodeInfo
n -> QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
n
PFieldWildcard NodeInfo
_ -> String -> Printer ()
write String
".."
instance Pretty QualConDecl where
prettyInternal :: QualConDecl NodeInfo -> Printer ()
prettyInternal QualConDecl NodeInfo
x =
case QualConDecl NodeInfo
x of
QualConDecl NodeInfo
_ Maybe [TyVarBind NodeInfo]
tyvars Maybe (Context NodeInfo)
ctx ConDecl NodeInfo
d ->
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([TyVarBind NodeInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([TyVarBind NodeInfo]
-> Maybe [TyVarBind NodeInfo] -> [TyVarBind NodeInfo]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [TyVarBind NodeInfo]
tyvars))
(do String -> Printer ()
write String
"forall "
[Printer ()] -> Printer ()
spaced ((TyVarBind NodeInfo -> Printer ())
-> [TyVarBind NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map TyVarBind NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ([TyVarBind NodeInfo] -> [TyVarBind NodeInfo]
forall a. [a] -> [a]
reverse ([TyVarBind NodeInfo]
-> Maybe [TyVarBind NodeInfo] -> [TyVarBind NodeInfo]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [TyVarBind NodeInfo]
tyvars)))
String -> Printer ()
write String
". "))
(Maybe (Context NodeInfo) -> Printer () -> Printer ()
forall (ast :: * -> *) b.
(Pretty ast, Show (ast NodeInfo)) =>
Maybe (ast NodeInfo) -> Printer b -> Printer b
withCtx Maybe (Context NodeInfo)
ctx
(ConDecl NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ConDecl NodeInfo
d))
instance Pretty GadtDecl where
#if MIN_VERSION_haskell_src_exts(1,21,0)
prettyInternal :: GadtDecl NodeInfo -> Printer ()
prettyInternal (GadtDecl NodeInfo
_ Name NodeInfo
name Maybe [TyVarBind NodeInfo]
_ Maybe (Context NodeInfo)
_ Maybe [FieldDecl NodeInfo]
fields Type NodeInfo
t) =
#else
prettyInternal (GadtDecl _ name fields t) =
#endif
Printer ()
horVar Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
`ifFitsOnOneLineOrElse` Printer ()
verVar
where
fields' :: Printer () -> Printer ()
fields' Printer ()
p =
case [FieldDecl NodeInfo]
-> Maybe [FieldDecl NodeInfo] -> [FieldDecl NodeInfo]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [FieldDecl NodeInfo]
fields of
[] -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
[FieldDecl NodeInfo]
fs -> do
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"{") (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
String -> [Printer ()] -> Printer ()
prefixedLined String
"," ((FieldDecl NodeInfo -> Printer ())
-> [FieldDecl NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend Printer ()
space (Printer () -> Printer ())
-> (FieldDecl NodeInfo -> Printer ())
-> FieldDecl NodeInfo
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDecl NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty) [FieldDecl NodeInfo]
fs)
String -> Printer ()
write String
"}"
Printer ()
p
horVar :: Printer ()
horVar =
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Name NodeInfo
name Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Printer ()
write String
" :: ") (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
Printer () -> Printer ()
fields' (String -> Printer ()
write String
" -> ")
Type NodeInfo -> Printer ()
declTy Type NodeInfo
t
verVar :: Printer ()
verVar = do
Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Name NodeInfo
name
Printer ()
newline
Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
":: ") (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
Printer () -> Printer ()
fields' (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
Printer ()
newline
Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indented (-Int64
3) (String -> Printer ()
write String
"-> ")
Type NodeInfo -> Printer ()
declTy Type NodeInfo
t
instance Pretty Rhs where
prettyInternal :: Rhs NodeInfo -> Printer ()
prettyInternal =
Rhs NodeInfo -> Printer ()
rhs
instance Pretty Splice where
prettyInternal :: Splice NodeInfo -> Printer ()
prettyInternal Splice NodeInfo
x =
case Splice NodeInfo
x of
IdSplice NodeInfo
_ String
str ->
do String -> Printer ()
write String
"$"
String -> Printer ()
string String
str
ParenSplice NodeInfo
_ Exp NodeInfo
e ->
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"$")
(Printer () -> Printer ()
forall a. Printer a -> Printer a
parens (Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e))
instance Pretty InstRule where
prettyInternal :: InstRule NodeInfo -> Printer ()
prettyInternal (IParen NodeInfo
_ InstRule NodeInfo
rule) = Printer () -> Printer ()
forall a. Printer a -> Printer a
parens (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ InstRule NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty InstRule NodeInfo
rule
prettyInternal (IRule NodeInfo
_ Maybe [TyVarBind NodeInfo]
mvarbinds Maybe (Context NodeInfo)
mctx InstHead NodeInfo
ihead) =
do case Maybe [TyVarBind NodeInfo]
mvarbinds of
Maybe [TyVarBind NodeInfo]
Nothing -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just [TyVarBind NodeInfo]
xs -> do String -> Printer ()
write String
"forall "
[Printer ()] -> Printer ()
spaced ((TyVarBind NodeInfo -> Printer ())
-> [TyVarBind NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map TyVarBind NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [TyVarBind NodeInfo]
xs)
String -> Printer ()
write String
". "
case Maybe (Context NodeInfo)
mctx of
Maybe (Context NodeInfo)
Nothing -> InstHead NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty InstHead NodeInfo
ihead
Just Context NodeInfo
ctx -> do
Maybe PrintState
mst <- Printer () -> Printer (Maybe PrintState)
forall a. Printer a -> Printer (Maybe PrintState)
fitsOnOneLine (do Context NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Context NodeInfo
ctx
String -> Printer ()
write String
" => "
InstHead NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty InstHead NodeInfo
ihead
String -> Printer ()
write String
" where")
case Maybe PrintState
mst of
Maybe PrintState
Nothing -> Maybe (Context NodeInfo) -> Printer () -> Printer ()
forall (ast :: * -> *) b.
(Pretty ast, Show (ast NodeInfo)) =>
Maybe (ast NodeInfo) -> Printer b -> Printer b
withCtx Maybe (Context NodeInfo)
mctx (InstHead NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty InstHead NodeInfo
ihead)
Just {} -> do
Context NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Context NodeInfo
ctx
String -> Printer ()
write String
" => "
InstHead NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty InstHead NodeInfo
ihead
instance Pretty InstHead where
prettyInternal :: InstHead NodeInfo -> Printer ()
prettyInternal InstHead NodeInfo
x =
case InstHead NodeInfo
x of
IHCon NodeInfo
_ QName NodeInfo
name -> QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
name
IHInfix NodeInfo
_ Type NodeInfo
typ' QName NodeInfo
name ->
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
typ')
(do Printer ()
space
QName NodeInfo -> Printer ()
prettyInfixOp QName NodeInfo
name)
IHApp NodeInfo
_ InstHead NodeInfo
ihead Type NodeInfo
typ' ->
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (InstHead NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty InstHead NodeInfo
ihead)
(do Printer ()
space
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
typ')
IHParen NodeInfo
_ InstHead NodeInfo
h -> Printer () -> Printer ()
forall a. Printer a -> Printer a
parens (InstHead NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty InstHead NodeInfo
h)
instance Pretty DeclHead where
prettyInternal :: DeclHead NodeInfo -> Printer ()
prettyInternal DeclHead NodeInfo
x =
case DeclHead NodeInfo
x of
DHead NodeInfo
_ Name NodeInfo
name -> Name NodeInfo -> Printer ()
prettyQuoteName Name NodeInfo
name
DHParen NodeInfo
_ DeclHead NodeInfo
h -> Printer () -> Printer ()
forall a. Printer a -> Printer a
parens (DeclHead NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty DeclHead NodeInfo
h)
DHInfix NodeInfo
_ TyVarBind NodeInfo
var Name NodeInfo
name ->
do TyVarBind NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty TyVarBind NodeInfo
var
Printer ()
space
Name NodeInfo -> Printer ()
prettyInfixName Name NodeInfo
name
DHApp NodeInfo
_ DeclHead NodeInfo
dhead TyVarBind NodeInfo
var ->
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (DeclHead NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty DeclHead NodeInfo
dhead)
(do Printer ()
space
TyVarBind NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty TyVarBind NodeInfo
var)
instance Pretty Overlap where
prettyInternal :: Overlap NodeInfo -> Printer ()
prettyInternal (Overlap NodeInfo
_) = String -> Printer ()
write String
"{-# OVERLAP #-}"
prettyInternal (Overlapping NodeInfo
_) = String -> Printer ()
write String
"{-# OVERLAPPING #-}"
prettyInternal (Overlaps NodeInfo
_) = String -> Printer ()
write String
"{-# OVERLAPS #-}"
prettyInternal (Overlappable NodeInfo
_) = String -> Printer ()
write String
"{-# OVERLAPPABLE #-}"
prettyInternal (NoOverlap NodeInfo
_) = String -> Printer ()
write String
"{-# NO_OVERLAP #-}"
prettyInternal (Incoherent NodeInfo
_) = String -> Printer ()
write String
"{-# INCOHERENT #-}"
instance Pretty Sign where
prettyInternal :: Sign NodeInfo -> Printer ()
prettyInternal (Signless NodeInfo
_) = () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
prettyInternal (Negative NodeInfo
_) = String -> Printer ()
write String
"-"
instance Pretty CallConv where
prettyInternal :: CallConv NodeInfo -> Printer ()
prettyInternal = CallConv NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty'
instance Pretty Safety where
prettyInternal :: Safety NodeInfo -> Printer ()
prettyInternal = Safety NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty'
instance Pretty Module where
prettyInternal :: Module NodeInfo -> Printer ()
prettyInternal Module NodeInfo
x =
case Module NodeInfo
x of
Module NodeInfo
_ Maybe (ModuleHead NodeInfo)
mayModHead [ModulePragma NodeInfo]
pragmas [ImportDecl NodeInfo]
imps [Decl NodeInfo]
decls ->
do Printer () -> [Printer ()] -> Printer ()
inter (do Printer ()
newline
Printer ()
newline)
(((Bool, Printer ()) -> Maybe (Printer ()))
-> [(Bool, Printer ())] -> [Printer ()]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(Bool
isNull,Printer ()
r) ->
if Bool
isNull
then Maybe (Printer ())
forall a. Maybe a
Nothing
else Printer () -> Maybe (Printer ())
forall a. a -> Maybe a
Just Printer ()
r)
[([ModulePragma NodeInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ModulePragma NodeInfo]
pragmas,Printer () -> [Printer ()] -> Printer ()
inter Printer ()
newline ((ModulePragma NodeInfo -> Printer ())
-> [ModulePragma NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map ModulePragma NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [ModulePragma NodeInfo]
pragmas))
,(case Maybe (ModuleHead NodeInfo)
mayModHead of
Maybe (ModuleHead NodeInfo)
Nothing -> (Bool
True,() -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
Just ModuleHead NodeInfo
modHead -> (Bool
False,ModuleHead NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ModuleHead NodeInfo
modHead))
,([ImportDecl NodeInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ImportDecl NodeInfo]
imps,[ImportDecl NodeInfo] -> Printer ()
formatImports [ImportDecl NodeInfo]
imps)
,([Decl NodeInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Decl NodeInfo]
decls
,Printer () -> [(Int, Printer ())] -> Printer ()
forall (m :: * -> *) a. Monad m => m a -> [(Int, m ())] -> m ()
interOf Printer ()
newline
((Decl NodeInfo -> (Int, Printer ()))
-> [Decl NodeInfo] -> [(Int, Printer ())]
forall a b. (a -> b) -> [a] -> [b]
map (\case
r :: Decl NodeInfo
r@TypeSig{} -> (Int
1,Decl NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Decl NodeInfo
r)
r :: Decl NodeInfo
r@InlineSig{} -> (Int
1, Decl NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Decl NodeInfo
r)
Decl NodeInfo
r -> (Int
2,Decl NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Decl NodeInfo
r))
[Decl NodeInfo]
decls))])
Printer ()
newline
where interOf :: m a -> [(Int, m ())] -> m ()
interOf m a
i ((Int
c,m ()
p):[(Int, m ())]
ps) =
case [(Int, m ())]
ps of
[] -> m ()
p
[(Int, m ())]
_ ->
do m ()
p
Int -> m a -> m ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
c m a
i
m a -> [(Int, m ())] -> m ()
interOf m a
i [(Int, m ())]
ps
interOf m a
_ [] = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
XmlPage{} -> String -> Printer ()
forall a. HasCallStack => String -> a
error String
"FIXME: No implementation for XmlPage."
XmlHybrid{} -> String -> Printer ()
forall a. HasCallStack => String -> a
error String
"FIXME: No implementation for XmlHybrid."
formatImports :: [ImportDecl NodeInfo] -> Printer ()
formatImports :: [ImportDecl NodeInfo] -> Printer ()
formatImports =
[Printer ()] -> Printer ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([Printer ()] -> Printer ())
-> ([ImportDecl NodeInfo] -> [Printer ()])
-> [ImportDecl NodeInfo]
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Printer () -> [Printer ()] -> [Printer ()]
forall a. a -> [a] -> [a]
intersperse (Printer ()
newline Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
newline) ([Printer ()] -> [Printer ()])
-> ([ImportDecl NodeInfo] -> [Printer ()])
-> [ImportDecl NodeInfo]
-> [Printer ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
([ImportDecl NodeInfo] -> Printer ())
-> [[ImportDecl NodeInfo]] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map [ImportDecl NodeInfo] -> Printer ()
formatImportGroup ([[ImportDecl NodeInfo]] -> [Printer ()])
-> ([ImportDecl NodeInfo] -> [[ImportDecl NodeInfo]])
-> [ImportDecl NodeInfo]
-> [Printer ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ImportDecl NodeInfo -> ImportDecl NodeInfo -> Bool)
-> [ImportDecl NodeInfo] -> [[ImportDecl NodeInfo]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupAdjacentBy ImportDecl NodeInfo -> ImportDecl NodeInfo -> Bool
forall (ast :: * -> *) (ast :: * -> *).
(Annotated ast, Annotated ast) =>
ast NodeInfo -> ast NodeInfo -> Bool
atNextLine
where
atNextLine :: ast NodeInfo -> ast NodeInfo -> Bool
atNextLine ast NodeInfo
import1 ast NodeInfo
import2 =
let end1 :: Int
end1 = SrcSpan -> Int
srcSpanEndLine (SrcSpanInfo -> SrcSpan
srcInfoSpan (NodeInfo -> SrcSpanInfo
nodeInfoSpan (ast NodeInfo -> NodeInfo
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann ast NodeInfo
import1)))
start2 :: Int
start2 = SrcSpan -> Int
srcSpanStartLine (SrcSpanInfo -> SrcSpan
srcInfoSpan (NodeInfo -> SrcSpanInfo
nodeInfoSpan (ast NodeInfo -> NodeInfo
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann ast NodeInfo
import2)))
in Int
start2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
end1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1
formatImportGroup :: [ImportDecl NodeInfo] -> Printer ()
formatImportGroup [ImportDecl NodeInfo]
imps = do
Bool
shouldSortImports <- (PrintState -> Bool) -> Printer Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((PrintState -> Bool) -> Printer Bool)
-> (PrintState -> Bool) -> Printer Bool
forall a b. (a -> b) -> a -> b
$ Config -> Bool
configSortImports (Config -> Bool) -> (PrintState -> Config) -> PrintState -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrintState -> Config
psConfig
let imps1 :: [ImportDecl NodeInfo]
imps1 =
if Bool
shouldSortImports
then [ImportDecl NodeInfo] -> [ImportDecl NodeInfo]
forall l. [ImportDecl l] -> [ImportDecl l]
sortImports [ImportDecl NodeInfo]
imps
else [ImportDecl NodeInfo]
imps
[Printer ()] -> Printer ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([Printer ()] -> Printer ())
-> ([Printer ()] -> [Printer ()]) -> [Printer ()] -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Printer () -> [Printer ()] -> [Printer ()]
forall a. a -> [a] -> [a]
intersperse Printer ()
newline ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (ImportDecl NodeInfo -> Printer ())
-> [ImportDecl NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map ImportDecl NodeInfo -> Printer ()
formatImport [ImportDecl NodeInfo]
imps1
moduleVisibleName :: ImportDecl l -> String
moduleVisibleName ImportDecl l
idecl =
let ModuleName l
_ String
name = ImportDecl l -> ModuleName l
forall l. ImportDecl l -> ModuleName l
importModule ImportDecl l
idecl
in String
name
formatImport :: ImportDecl NodeInfo -> Printer ()
formatImport = ImportDecl NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty
sortImports :: [ImportDecl l] -> [ImportDecl l]
sortImports [ImportDecl l]
imps = (ImportDecl l -> String) -> [ImportDecl l] -> [ImportDecl l]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn ImportDecl l -> String
forall l. ImportDecl l -> String
moduleVisibleName ([ImportDecl l] -> [ImportDecl l])
-> ([ImportDecl l] -> [ImportDecl l])
-> [ImportDecl l]
-> [ImportDecl l]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ImportDecl l -> ImportDecl l) -> [ImportDecl l] -> [ImportDecl l]
forall a b. (a -> b) -> [a] -> [b]
map ImportDecl l -> ImportDecl l
forall l. ImportDecl l -> ImportDecl l
sortImportSpecsOnImport ([ImportDecl l] -> [ImportDecl l])
-> [ImportDecl l] -> [ImportDecl l]
forall a b. (a -> b) -> a -> b
$ [ImportDecl l]
imps
sortImportSpecsOnImport :: ImportDecl l -> ImportDecl l
sortImportSpecsOnImport ImportDecl l
imp = ImportDecl l
imp { importSpecs :: Maybe (ImportSpecList l)
importSpecs = (ImportSpecList l -> ImportSpecList l)
-> Maybe (ImportSpecList l) -> Maybe (ImportSpecList l)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ImportSpecList l -> ImportSpecList l
forall l. ImportSpecList l -> ImportSpecList l
sortImportSpecs (ImportDecl l -> Maybe (ImportSpecList l)
forall l. ImportDecl l -> Maybe (ImportSpecList l)
importSpecs ImportDecl l
imp) }
sortImportSpecs :: ImportSpecList l -> ImportSpecList l
sortImportSpecs (ImportSpecList l
l Bool
hiding [ImportSpec l]
specs) = l -> Bool -> [ImportSpec l] -> ImportSpecList l
forall l. l -> Bool -> [ImportSpec l] -> ImportSpecList l
ImportSpecList l
l Bool
hiding [ImportSpec l]
sortedSpecs
where
sortedSpecs :: [ImportSpec l]
sortedSpecs = (ImportSpec l -> ImportSpec l -> Ordering)
-> [ImportSpec l] -> [ImportSpec l]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ImportSpec l -> ImportSpec l -> Ordering
forall l. ImportSpec l -> ImportSpec l -> Ordering
importSpecCompare ([ImportSpec l] -> [ImportSpec l])
-> ([ImportSpec l] -> [ImportSpec l])
-> [ImportSpec l]
-> [ImportSpec l]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ImportSpec l -> ImportSpec l) -> [ImportSpec l] -> [ImportSpec l]
forall a b. (a -> b) -> [a] -> [b]
map ImportSpec l -> ImportSpec l
forall l. ImportSpec l -> ImportSpec l
sortCNames ([ImportSpec l] -> [ImportSpec l])
-> [ImportSpec l] -> [ImportSpec l]
forall a b. (a -> b) -> a -> b
$ [ImportSpec l]
specs
sortCNames :: ImportSpec l -> ImportSpec l
sortCNames (IThingWith l
l2 Name l
name [CName l]
cNames) = l -> Name l -> [CName l] -> ImportSpec l
forall l. l -> Name l -> [CName l] -> ImportSpec l
IThingWith l
l2 Name l
name ([CName l] -> ImportSpec l)
-> ([CName l] -> [CName l]) -> [CName l] -> ImportSpec l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CName l -> CName l -> Ordering) -> [CName l] -> [CName l]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy CName l -> CName l -> Ordering
forall l. CName l -> CName l -> Ordering
cNameCompare ([CName l] -> ImportSpec l) -> [CName l] -> ImportSpec l
forall a b. (a -> b) -> a -> b
$ [CName l]
cNames
sortCNames ImportSpec l
is = ImportSpec l
is
groupAdjacentBy :: (a -> a -> Bool) -> [a] -> [[a]]
groupAdjacentBy :: (a -> a -> Bool) -> [a] -> [[a]]
groupAdjacentBy a -> a -> Bool
_ [] = []
groupAdjacentBy a -> a -> Bool
adj [a]
items = [a]
xs [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: (a -> a -> Bool) -> [a] -> [[a]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupAdjacentBy a -> a -> Bool
adj [a]
rest
where
([a]
xs, [a]
rest) = (a -> a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> a -> Bool) -> [a] -> ([a], [a])
spanAdjacentBy a -> a -> Bool
adj [a]
items
spanAdjacentBy :: (a -> a -> Bool) -> [a] -> ([a], [a])
spanAdjacentBy :: (a -> a -> Bool) -> [a] -> ([a], [a])
spanAdjacentBy a -> a -> Bool
_ [] = ([], [])
spanAdjacentBy a -> a -> Bool
_ [a
x] = ([a
x], [])
spanAdjacentBy a -> a -> Bool
adj (a
x:xs :: [a]
xs@(a
y:[a]
_))
| a -> a -> Bool
adj a
x a
y =
let ([a]
xs', [a]
rest') = (a -> a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> a -> Bool) -> [a] -> ([a], [a])
spanAdjacentBy a -> a -> Bool
adj [a]
xs
in (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs', [a]
rest')
| Bool
otherwise = ([a
x], [a]
xs)
importSpecCompare :: ImportSpec l -> ImportSpec l -> Ordering
importSpecCompare :: ImportSpec l -> ImportSpec l -> Ordering
importSpecCompare (IAbs l
_ Namespace l
_ (Ident l
_ String
s1)) (IAbs l
_ Namespace l
_ (Ident l
_ String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IAbs l
_ Namespace l
_ (Ident l
_ String
_)) (IAbs l
_ Namespace l
_ (Symbol l
_ String
_)) = Ordering
GT
importSpecCompare (IAbs l
_ Namespace l
_ (Ident l
_ String
s1)) (IThingAll l
_ (Ident l
_ String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IAbs l
_ Namespace l
_ (Ident l
_ String
_)) (IThingAll l
_ (Symbol l
_ String
_)) = Ordering
GT
importSpecCompare (IAbs l
_ Namespace l
_ (Ident l
_ String
s1)) (IThingWith l
_ (Ident l
_ String
s2) [CName l]
_) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IAbs l
_ Namespace l
_ (Ident l
_ String
_)) (IThingWith l
_ (Symbol l
_ String
_) [CName l]
_) = Ordering
GT
importSpecCompare (IAbs l
_ Namespace l
_ (Symbol l
_ String
_)) (IAbs l
_ Namespace l
_ (Ident l
_ String
_)) = Ordering
LT
importSpecCompare (IAbs l
_ Namespace l
_ (Symbol l
_ String
s1)) (IAbs l
_ Namespace l
_ (Symbol l
_ String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IAbs l
_ Namespace l
_ (Symbol l
_ String
_)) (IThingAll l
_ (Ident l
_ String
_)) = Ordering
LT
importSpecCompare (IAbs l
_ Namespace l
_ (Symbol l
_ String
s1)) (IThingAll l
_ (Symbol l
_ String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IAbs l
_ Namespace l
_ (Symbol l
_ String
_)) (IThingWith l
_ (Ident l
_ String
_) [CName l]
_) = Ordering
LT
importSpecCompare (IAbs l
_ Namespace l
_ (Symbol l
_ String
s1)) (IThingWith l
_ (Symbol l
_ String
s2) [CName l]
_) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IAbs l
_ Namespace l
_ Name l
_) (IVar l
_ Name l
_) = Ordering
LT
importSpecCompare (IThingAll l
_ (Ident l
_ String
s1)) (IAbs l
_ Namespace l
_ (Ident l
_ String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IThingAll l
_ (Ident l
_ String
_)) (IAbs l
_ Namespace l
_ (Symbol l
_ String
_)) = Ordering
GT
importSpecCompare (IThingAll l
_ (Ident l
_ String
s1)) (IThingAll l
_ (Ident l
_ String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IThingAll l
_ (Ident l
_ String
_)) (IThingAll l
_ (Symbol l
_ String
_)) = Ordering
GT
importSpecCompare (IThingAll l
_ (Ident l
_ String
s1)) (IThingWith l
_ (Ident l
_ String
s2) [CName l]
_) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IThingAll l
_ (Ident l
_ String
_)) (IThingWith l
_ (Symbol l
_ String
_) [CName l]
_) = Ordering
GT
importSpecCompare (IThingAll l
_ (Symbol l
_ String
_)) (IAbs l
_ Namespace l
_ (Ident l
_ String
_)) = Ordering
LT
importSpecCompare (IThingAll l
_ (Symbol l
_ String
s1)) (IAbs l
_ Namespace l
_ (Symbol l
_ String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IThingAll l
_ (Symbol l
_ String
_)) (IThingAll l
_ (Ident l
_ String
_)) = Ordering
LT
importSpecCompare (IThingAll l
_ (Symbol l
_ String
s1)) (IThingAll l
_ (Symbol l
_ String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IThingAll l
_ (Symbol l
_ String
_)) (IThingWith l
_ (Ident l
_ String
_) [CName l]
_) = Ordering
LT
importSpecCompare (IThingAll l
_ (Symbol l
_ String
s1)) (IThingWith l
_ (Symbol l
_ String
s2) [CName l]
_) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IThingAll l
_ Name l
_) (IVar l
_ Name l
_) = Ordering
LT
importSpecCompare (IThingWith l
_ (Ident l
_ String
s1) [CName l]
_) (IAbs l
_ Namespace l
_ (Ident l
_ String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IThingWith l
_ (Ident l
_ String
_) [CName l]
_) (IAbs l
_ Namespace l
_ (Symbol l
_ String
_)) = Ordering
GT
importSpecCompare (IThingWith l
_ (Ident l
_ String
s1) [CName l]
_) (IThingAll l
_ (Ident l
_ String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IThingWith l
_ (Ident l
_ String
_) [CName l]
_) (IThingAll l
_ (Symbol l
_ String
_)) = Ordering
GT
importSpecCompare (IThingWith l
_ (Ident l
_ String
s1) [CName l]
_) (IThingWith l
_ (Ident l
_ String
s2) [CName l]
_) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IThingWith l
_ (Ident l
_ String
_) [CName l]
_) (IThingWith l
_ (Symbol l
_ String
_) [CName l]
_) = Ordering
GT
importSpecCompare (IThingWith l
_ (Symbol l
_ String
_) [CName l]
_) (IAbs l
_ Namespace l
_ (Ident l
_ String
_)) = Ordering
LT
importSpecCompare (IThingWith l
_ (Symbol l
_ String
s1) [CName l]
_) (IAbs l
_ Namespace l
_ (Symbol l
_ String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IThingWith l
_ (Symbol l
_ String
_) [CName l]
_) (IThingAll l
_ (Ident l
_ String
_)) = Ordering
LT
importSpecCompare (IThingWith l
_ (Symbol l
_ String
s1) [CName l]
_) (IThingAll l
_ (Symbol l
_ String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IThingWith l
_ (Symbol l
_ String
_) [CName l]
_) (IThingWith l
_ (Ident l
_ String
_) [CName l]
_) = Ordering
LT
importSpecCompare (IThingWith l
_ (Symbol l
_ String
s1) [CName l]
_) (IThingWith l
_ (Symbol l
_ String
s2) [CName l]
_) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IThingWith l
_ Name l
_ [CName l]
_) (IVar l
_ Name l
_) = Ordering
LT
importSpecCompare (IVar l
_ (Ident l
_ String
s1)) (IVar l
_ (Ident l
_ String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IVar l
_ (Ident l
_ String
_)) (IVar l
_ (Symbol l
_ String
_)) = Ordering
GT
importSpecCompare (IVar l
_ (Symbol l
_ String
_)) (IVar l
_ (Ident l
_ String
_)) = Ordering
LT
importSpecCompare (IVar l
_ (Symbol l
_ String
s1)) (IVar l
_ (Symbol l
_ String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IVar l
_ Name l
_) ImportSpec l
_ = Ordering
GT
cNameCompare :: CName l -> CName l -> Ordering
cNameCompare :: CName l -> CName l -> Ordering
cNameCompare (VarName l
_ (Ident l
_ String
s1)) (VarName l
_ (Ident l
_ String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
cNameCompare (VarName l
_ (Ident l
_ String
_)) (VarName l
_ (Symbol l
_ String
_)) = Ordering
GT
cNameCompare (VarName l
_ (Ident l
_ String
s1)) (ConName l
_ (Ident l
_ String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
cNameCompare (VarName l
_ (Ident l
_ String
_)) (ConName l
_ (Symbol l
_ String
_)) = Ordering
GT
cNameCompare (VarName l
_ (Symbol l
_ String
_)) (VarName l
_ (Ident l
_ String
_)) = Ordering
LT
cNameCompare (VarName l
_ (Symbol l
_ String
s1)) (VarName l
_ (Symbol l
_ String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
cNameCompare (VarName l
_ (Symbol l
_ String
_)) (ConName l
_ (Ident l
_ String
_)) = Ordering
LT
cNameCompare (VarName l
_ (Symbol l
_ String
s1)) (ConName l
_ (Symbol l
_ String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
cNameCompare (ConName l
_ (Ident l
_ String
s1)) (VarName l
_ (Ident l
_ String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
cNameCompare (ConName l
_ (Ident l
_ String
_)) (VarName l
_ (Symbol l
_ String
_)) = Ordering
GT
cNameCompare (ConName l
_ (Ident l
_ String
s1)) (ConName l
_ (Ident l
_ String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
cNameCompare (ConName l
_ (Ident l
_ String
_)) (ConName l
_ (Symbol l
_ String
_)) = Ordering
GT
cNameCompare (ConName l
_ (Symbol l
_ String
_)) (VarName l
_ (Ident l
_ String
_)) = Ordering
LT
cNameCompare (ConName l
_ (Symbol l
_ String
s1)) (VarName l
_ (Symbol l
_ String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
cNameCompare (ConName l
_ (Symbol l
_ String
_)) (ConName l
_ (Ident l
_ String
_)) = Ordering
LT
cNameCompare (ConName l
_ (Symbol l
_ String
s1)) (ConName l
_ (Symbol l
_ String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
instance Pretty Bracket where
prettyInternal :: Bracket NodeInfo -> Printer ()
prettyInternal Bracket NodeInfo
x =
case Bracket NodeInfo
x of
ExpBracket NodeInfo
_ Exp NodeInfo
p -> String -> Printer () -> Printer ()
quotation String
"" (Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
p)
PatBracket NodeInfo
_ Pat NodeInfo
p -> String -> Printer () -> Printer ()
quotation String
"p" (Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
p)
TypeBracket NodeInfo
_ Type NodeInfo
ty -> String -> Printer () -> Printer ()
quotation String
"t" (Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty)
d :: Bracket NodeInfo
d@(DeclBracket NodeInfo
_ [Decl NodeInfo]
_) -> Bracket NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Bracket NodeInfo
d
instance Pretty IPBind where
prettyInternal :: IPBind NodeInfo -> Printer ()
prettyInternal IPBind NodeInfo
x =
case IPBind NodeInfo
x of
IPBind NodeInfo
_ IPName NodeInfo
name Exp NodeInfo
expr -> do
IPName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty IPName NodeInfo
name
Printer ()
space
String -> Printer ()
write String
"="
Printer ()
space
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr
instance Pretty BooleanFormula where
prettyInternal :: BooleanFormula NodeInfo -> Printer ()
prettyInternal (VarFormula NodeInfo
_ i :: Name NodeInfo
i@(Ident NodeInfo
_ String
_)) = Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Name NodeInfo
i
prettyInternal (VarFormula NodeInfo
_ (Symbol NodeInfo
_ String
s)) = String -> Printer ()
write String
"(" Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Printer ()
string String
s Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Printer ()
write String
")"
prettyInternal (AndFormula NodeInfo
_ [BooleanFormula NodeInfo]
fs) = do
Maybe PrintState
maybeFormulas <- Printer () -> Printer (Maybe PrintState)
forall a. Printer a -> Printer (Maybe PrintState)
fitsOnOneLine (Printer () -> Printer (Maybe PrintState))
-> Printer () -> Printer (Maybe PrintState)
forall a b. (a -> b) -> a -> b
$ Printer () -> [Printer ()] -> Printer ()
inter (String -> Printer ()
write String
", ") ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (BooleanFormula NodeInfo -> Printer ())
-> [BooleanFormula NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map BooleanFormula NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [BooleanFormula NodeInfo]
fs
case Maybe PrintState
maybeFormulas of
Maybe PrintState
Nothing -> String -> [Printer ()] -> Printer ()
prefixedLined String
", " ((BooleanFormula NodeInfo -> Printer ())
-> [BooleanFormula NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map BooleanFormula NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [BooleanFormula NodeInfo]
fs)
Just PrintState
formulas -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
formulas
prettyInternal (OrFormula NodeInfo
_ [BooleanFormula NodeInfo]
fs) = do
Maybe PrintState
maybeFormulas <- Printer () -> Printer (Maybe PrintState)
forall a. Printer a -> Printer (Maybe PrintState)
fitsOnOneLine (Printer () -> Printer (Maybe PrintState))
-> Printer () -> Printer (Maybe PrintState)
forall a b. (a -> b) -> a -> b
$ Printer () -> [Printer ()] -> Printer ()
inter (String -> Printer ()
write String
" | ") ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (BooleanFormula NodeInfo -> Printer ())
-> [BooleanFormula NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map BooleanFormula NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [BooleanFormula NodeInfo]
fs
case Maybe PrintState
maybeFormulas of
Maybe PrintState
Nothing -> String -> [Printer ()] -> Printer ()
prefixedLined String
"| " ((BooleanFormula NodeInfo -> Printer ())
-> [BooleanFormula NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map BooleanFormula NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [BooleanFormula NodeInfo]
fs)
Just PrintState
formulas -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
formulas
prettyInternal (ParenFormula NodeInfo
_ BooleanFormula NodeInfo
f) = Printer () -> Printer ()
forall a. Printer a -> Printer a
parens (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ BooleanFormula NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty BooleanFormula NodeInfo
f
instance Pretty DataOrNew where
prettyInternal :: DataOrNew NodeInfo -> Printer ()
prettyInternal = DataOrNew NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty'
instance Pretty FunDep where
prettyInternal :: FunDep NodeInfo -> Printer ()
prettyInternal = FunDep NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty'
#if !MIN_VERSION_haskell_src_exts(1,21,0)
instance Pretty Kind where
prettyInternal = pretty'
#endif
instance Pretty ResultSig where
prettyInternal :: ResultSig NodeInfo -> Printer ()
prettyInternal (KindSig NodeInfo
_ Type NodeInfo
kind) = Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
kind
prettyInternal (TyVarSig NodeInfo
_ TyVarBind NodeInfo
tyVarBind) = TyVarBind NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty TyVarBind NodeInfo
tyVarBind
instance Pretty Literal where
prettyInternal :: Literal NodeInfo -> Printer ()
prettyInternal (String NodeInfo
_ String
_ String
rep) = do
String -> Printer ()
write String
"\""
String -> Printer ()
string String
rep
String -> Printer ()
write String
"\""
prettyInternal (Char NodeInfo
_ Char
_ String
rep) = do
String -> Printer ()
write String
"'"
String -> Printer ()
string String
rep
String -> Printer ()
write String
"'"
prettyInternal (PrimString NodeInfo
_ String
_ String
rep) = do
String -> Printer ()
write String
"\""
String -> Printer ()
string String
rep
String -> Printer ()
write String
"\"#"
prettyInternal (PrimChar NodeInfo
_ Char
_ String
rep) = do
String -> Printer ()
write String
"'"
String -> Printer ()
string String
rep
String -> Printer ()
write String
"'#"
prettyInternal (Int NodeInfo
_l Integer
_i String
originalString) =
String -> Printer ()
string String
originalString
prettyInternal (Frac NodeInfo
_l Rational
_r String
originalString) =
String -> Printer ()
string String
originalString
prettyInternal Literal NodeInfo
x = Literal NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Literal NodeInfo
x
instance Pretty Name where
prettyInternal :: Name NodeInfo -> Printer ()
prettyInternal Name NodeInfo
x = case Name NodeInfo
x of
Ident NodeInfo
_ String
_ -> Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Name NodeInfo
x
Symbol NodeInfo
_ String
s -> String -> Printer ()
string String
s
instance Pretty QName where
prettyInternal :: QName NodeInfo -> Printer ()
prettyInternal =
\case
Qual NodeInfo
_ ModuleName NodeInfo
mn Name NodeInfo
n ->
case Name NodeInfo
n of
Ident NodeInfo
_ String
i -> do ModuleName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ModuleName NodeInfo
mn; String -> Printer ()
write String
"."; String -> Printer ()
string String
i;
Symbol NodeInfo
_ String
s -> do String -> Printer ()
write String
"("; ModuleName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ModuleName NodeInfo
mn; String -> Printer ()
write String
"."; String -> Printer ()
string String
s; String -> Printer ()
write String
")";
UnQual NodeInfo
_ Name NodeInfo
n ->
case Name NodeInfo
n of
Ident NodeInfo
_ String
i -> String -> Printer ()
string String
i
Symbol NodeInfo
_ String
s -> do String -> Printer ()
write String
"("; String -> Printer ()
string String
s; String -> Printer ()
write String
")";
Special NodeInfo
_ s :: SpecialCon NodeInfo
s@Cons{} -> Printer () -> Printer ()
forall a. Printer a -> Printer a
parens (SpecialCon NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty SpecialCon NodeInfo
s)
Special NodeInfo
_ s :: SpecialCon NodeInfo
s@FunCon{} -> Printer () -> Printer ()
forall a. Printer a -> Printer a
parens (SpecialCon NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty SpecialCon NodeInfo
s)
Special NodeInfo
_ SpecialCon NodeInfo
s -> SpecialCon NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty SpecialCon NodeInfo
s
instance Pretty SpecialCon where
prettyInternal :: SpecialCon NodeInfo -> Printer ()
prettyInternal SpecialCon NodeInfo
s =
case SpecialCon NodeInfo
s of
UnitCon NodeInfo
_ -> String -> Printer ()
write String
"()"
ListCon NodeInfo
_ -> String -> Printer ()
write String
"[]"
FunCon NodeInfo
_ -> String -> Printer ()
write String
"->"
TupleCon NodeInfo
_ Boxed
Boxed Int
i ->
String -> Printer ()
string (String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++
Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Char
',' String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
")")
TupleCon NodeInfo
_ Boxed
Unboxed Int
i ->
String -> Printer ()
string (String
"(# " String -> String -> String
forall a. [a] -> [a] -> [a]
++
Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Char
',' String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" #)")
Cons NodeInfo
_ -> String -> Printer ()
write String
":"
UnboxedSingleCon NodeInfo
_ -> String -> Printer ()
write String
"(##)"
ExprHole NodeInfo
_ -> String -> Printer ()
write String
"_"
instance Pretty QOp where
prettyInternal :: QOp NodeInfo -> Printer ()
prettyInternal = QOp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty'
instance Pretty TyVarBind where
prettyInternal :: TyVarBind NodeInfo -> Printer ()
prettyInternal = TyVarBind NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty'
instance Pretty ModuleHead where
prettyInternal :: ModuleHead NodeInfo -> Printer ()
prettyInternal (ModuleHead NodeInfo
_ ModuleName NodeInfo
name Maybe (WarningText NodeInfo)
mwarnings Maybe (ExportSpecList NodeInfo)
mexports) =
do String -> Printer ()
write String
"module "
ModuleName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ModuleName NodeInfo
name
Printer ()
-> (WarningText NodeInfo -> Printer ())
-> Maybe (WarningText NodeInfo)
-> Printer ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) WarningText NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Maybe (WarningText NodeInfo)
mwarnings
Printer ()
-> (ExportSpecList NodeInfo -> Printer ())
-> Maybe (ExportSpecList NodeInfo)
-> Printer ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
(\ExportSpecList NodeInfo
exports ->
do Printer ()
newline
Int64
indentSpaces <- Printer Int64
getIndentSpaces
Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indented Int64
indentSpaces (ExportSpecList NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ExportSpecList NodeInfo
exports))
Maybe (ExportSpecList NodeInfo)
mexports
String -> Printer ()
write String
" where"
instance Pretty ModulePragma where
prettyInternal :: ModulePragma NodeInfo -> Printer ()
prettyInternal = ModulePragma NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty'
instance Pretty ImportDecl where
prettyInternal :: ImportDecl NodeInfo -> Printer ()
prettyInternal (ImportDecl NodeInfo
_ ModuleName NodeInfo
name Bool
qualified Bool
source Bool
safe Maybe String
mpkg Maybe (ModuleName NodeInfo)
mas Maybe (ImportSpecList NodeInfo)
mspec) = do
String -> Printer ()
write String
"import"
Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
source (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ String -> Printer ()
write String
" {-# SOURCE #-}"
Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
safe (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ String -> Printer ()
write String
" safe"
Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
qualified (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ String -> Printer ()
write String
" qualified"
case Maybe String
mpkg of
Maybe String
Nothing -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just String
pkg -> Printer ()
space Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Printer ()
write (String
"\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pkg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\"")
Printer ()
space
ModuleName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ModuleName NodeInfo
name
case Maybe (ModuleName NodeInfo)
mas of
Maybe (ModuleName NodeInfo)
Nothing -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just ModuleName NodeInfo
asName -> do
Printer ()
space
String -> Printer ()
write String
"as "
ModuleName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ModuleName NodeInfo
asName
case Maybe (ImportSpecList NodeInfo)
mspec of
Maybe (ImportSpecList NodeInfo)
Nothing -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just ImportSpecList NodeInfo
spec -> ImportSpecList NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ImportSpecList NodeInfo
spec
instance Pretty ModuleName where
prettyInternal :: ModuleName NodeInfo -> Printer ()
prettyInternal (ModuleName NodeInfo
_ String
name) =
String -> Printer ()
write String
name
instance Pretty ImportSpecList where
prettyInternal :: ImportSpecList NodeInfo -> Printer ()
prettyInternal (ImportSpecList NodeInfo
_ Bool
hiding [ImportSpec NodeInfo]
spec) = do
Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
hiding (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ String -> Printer ()
write String
" hiding"
let verVar :: Printer ()
verVar = do
Printer ()
space
Printer () -> Printer ()
forall a. Printer a -> Printer a
parens ([Printer ()] -> Printer ()
commas ((ImportSpec NodeInfo -> Printer ())
-> [ImportSpec NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map ImportSpec NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [ImportSpec NodeInfo]
spec))
let horVar :: Printer ()
horVar = do
Printer ()
newline
Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock
(do Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"( ") (String -> [Printer ()] -> Printer ()
prefixedLined String
", " ((ImportSpec NodeInfo -> Printer ())
-> [ImportSpec NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map ImportSpec NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [ImportSpec NodeInfo]
spec))
Printer ()
newline
String -> Printer ()
write String
")")
Printer ()
verVar Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
`ifFitsOnOneLineOrElse` Printer ()
horVar
instance Pretty ImportSpec where
prettyInternal :: ImportSpec NodeInfo -> Printer ()
prettyInternal = ImportSpec NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty'
instance Pretty WarningText where
prettyInternal :: WarningText NodeInfo -> Printer ()
prettyInternal (DeprText NodeInfo
_ String
s) =
String -> Printer ()
write String
"{-# DEPRECATED " Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Printer ()
string String
s Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Printer ()
write String
" #-}"
prettyInternal (WarnText NodeInfo
_ String
s) =
String -> Printer ()
write String
"{-# WARNING " Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Printer ()
string String
s Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Printer ()
write String
" #-}"
instance Pretty ExportSpecList where
prettyInternal :: ExportSpecList NodeInfo -> Printer ()
prettyInternal (ExportSpecList NodeInfo
_ [ExportSpec NodeInfo]
es) = do
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"(")
(String -> [Printer ()] -> Printer ()
prefixedLined String
"," ((ExportSpec NodeInfo -> Printer ())
-> [ExportSpec NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map ExportSpec NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [ExportSpec NodeInfo]
es))
Printer ()
newline
String -> Printer ()
write String
")"
instance Pretty ExportSpec where
prettyInternal :: ExportSpec NodeInfo -> Printer ()
prettyInternal ExportSpec NodeInfo
x = String -> Printer ()
string String
" " Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ExportSpec NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' ExportSpec NodeInfo
x
stmt :: Stmt NodeInfo -> Printer ()
stmt :: Stmt NodeInfo -> Printer ()
stmt (Qualifier NodeInfo
_ e :: Exp NodeInfo
e@(InfixApp NodeInfo
_ Exp NodeInfo
a QOp NodeInfo
op Exp NodeInfo
b)) =
do Int64
col <- (((), PrintState) -> Int64)
-> Printer ((), PrintState) -> Printer Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PrintState -> Int64
psColumn (PrintState -> Int64)
-> (((), PrintState) -> PrintState) -> ((), PrintState) -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((), PrintState) -> PrintState
forall a b. (a, b) -> b
snd)
(Printer () -> Printer ((), PrintState)
forall a. Printer a -> Printer (a, PrintState)
sandbox (String -> Printer ()
write String
""))
Exp NodeInfo
-> Exp NodeInfo
-> QOp NodeInfo
-> Exp NodeInfo
-> Maybe Int64
-> Printer ()
infixApp Exp NodeInfo
e Exp NodeInfo
a QOp NodeInfo
op Exp NodeInfo
b (Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
col)
stmt (Generator NodeInfo
_ Pat NodeInfo
p Exp NodeInfo
e) =
do Int64
indentSpaces <- Printer Int64
getIndentSpaces
Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
p
Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indented Int64
indentSpaces
(Printer ()
-> Printer ()
-> Exp NodeInfo
-> (Exp NodeInfo -> Printer ())
-> Printer ()
dependOrNewline
(String -> Printer ()
write String
" <-")
Printer ()
space
Exp NodeInfo
e
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty)
stmt Stmt NodeInfo
x = case Stmt NodeInfo
x of
Generator NodeInfo
_ Pat NodeInfo
p Exp NodeInfo
e ->
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (do Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
p
String -> Printer ()
write String
" <- ")
(Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e)
Qualifier NodeInfo
_ Exp NodeInfo
e -> Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e
LetStmt NodeInfo
_ Binds NodeInfo
binds ->
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"let ")
(Binds NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Binds NodeInfo
binds)
RecStmt NodeInfo
_ [Stmt NodeInfo]
es ->
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"rec ")
([Printer ()] -> Printer ()
lined ((Stmt NodeInfo -> Printer ()) -> [Stmt NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Stmt NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Stmt NodeInfo]
es))
dependOrNewline
:: Printer ()
-> Printer ()
-> Exp NodeInfo
-> (Exp NodeInfo -> Printer ())
-> Printer ()
dependOrNewline :: Printer ()
-> Printer ()
-> Exp NodeInfo
-> (Exp NodeInfo -> Printer ())
-> Printer ()
dependOrNewline Printer ()
left Printer ()
prefix Exp NodeInfo
right Exp NodeInfo -> Printer ()
f =
do Maybe PrintState
msg <- Printer () -> Printer (Maybe PrintState)
forall a. Printer a -> Printer (Maybe PrintState)
fitsOnOneLine Printer ()
renderDependent
case Maybe PrintState
msg of
Maybe PrintState
Nothing -> do Printer ()
left
Printer ()
newline
(Exp NodeInfo -> Printer ()
f Exp NodeInfo
right)
Just PrintState
st -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st
where renderDependent :: Printer ()
renderDependent = Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend Printer ()
left (do Printer ()
prefix; Exp NodeInfo -> Printer ()
f Exp NodeInfo
right)
rhs :: Rhs NodeInfo -> Printer ()
rhs :: Rhs NodeInfo -> Printer ()
rhs (UnGuardedRhs NodeInfo
_ (Do NodeInfo
_ [Stmt NodeInfo]
dos)) =
do Bool
inCase <- (PrintState -> Bool) -> Printer Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Bool
psInsideCase
String -> Printer ()
write (if Bool
inCase then String
" -> " else String
" = ")
Int64
indentSpaces <- Printer Int64
getIndentSpaces
let indentation :: Int64
indentation | Bool
inCase = Int64
indentSpaces
| Bool
otherwise = Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
max Int64
2 Int64
indentSpaces
Int64 -> Printer () -> Printer () -> Printer ()
forall b. Int64 -> Printer () -> Printer b -> Printer b
swingBy Int64
indentation
(String -> Printer ()
write String
"do")
([Printer ()] -> Printer ()
lined ((Stmt NodeInfo -> Printer ()) -> [Stmt NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Stmt NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Stmt NodeInfo]
dos))
rhs (UnGuardedRhs NodeInfo
_ Exp NodeInfo
e) = do
Maybe PrintState
msg <-
Printer () -> Printer (Maybe PrintState)
forall a. Printer a -> Printer (Maybe PrintState)
fitsOnOneLine
(do String -> Printer ()
write String
" "
Printer ()
rhsSeparator
String -> Printer ()
write String
" "
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e)
case Maybe PrintState
msg of
Maybe PrintState
Nothing -> Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer ()
swing (String -> Printer ()
write String
" " Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
rhsSeparator) (Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e)
Just PrintState
st -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st
rhs (GuardedRhss NodeInfo
_ [GuardedRhs NodeInfo]
gas) =
do Printer ()
newline
Int64
n <- Printer Int64
getIndentSpaces
Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indented Int64
n
([Printer ()] -> Printer ()
lined ((GuardedRhs NodeInfo -> Printer ())
-> [GuardedRhs NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map (\GuardedRhs NodeInfo
p ->
do String -> Printer ()
write String
"|"
GuardedRhs NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty GuardedRhs NodeInfo
p)
[GuardedRhs NodeInfo]
gas))
guardedRhs :: GuardedRhs NodeInfo -> Printer ()
guardedRhs :: GuardedRhs NodeInfo -> Printer ()
guardedRhs (GuardedRhs NodeInfo
_ [Stmt NodeInfo]
stmts (Do NodeInfo
_ [Stmt NodeInfo]
dos)) =
do Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indented Int64
1
(do String -> [Printer ()] -> Printer ()
prefixedLined
String
","
((Stmt NodeInfo -> Printer ()) -> [Stmt NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map (\Stmt NodeInfo
p ->
do Printer ()
space
Stmt NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Stmt NodeInfo
p)
[Stmt NodeInfo]
stmts))
Bool
inCase <- (PrintState -> Bool) -> Printer Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Bool
psInsideCase
String -> Printer ()
write (if Bool
inCase then String
" -> " else String
" = ")
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer ()
swing (String -> Printer ()
write String
"do")
([Printer ()] -> Printer ()
lined ((Stmt NodeInfo -> Printer ()) -> [Stmt NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Stmt NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Stmt NodeInfo]
dos))
guardedRhs (GuardedRhs NodeInfo
_ [Stmt NodeInfo]
stmts Exp NodeInfo
e) = do
Maybe PrintState
mst <- Printer () -> Printer (Maybe PrintState)
forall a. Printer a -> Printer (Maybe PrintState)
fitsOnOneLine Printer ()
printStmts
case Maybe PrintState
mst of
Just PrintState
st -> do
PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st
Maybe PrintState
mst' <-
Printer () -> Printer (Maybe PrintState)
forall a. Printer a -> Printer (Maybe PrintState)
fitsOnOneLine
(do String -> Printer ()
write String
" "
Printer ()
rhsSeparator
String -> Printer ()
write String
" "
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e)
case Maybe PrintState
mst' of
Just PrintState
st' -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st'
Maybe PrintState
Nothing -> Printer ()
swingIt
Maybe PrintState
Nothing -> do
Printer ()
printStmts
Printer ()
swingIt
where
printStmts :: Printer ()
printStmts =
Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indented
Int64
1
(do String -> [Printer ()] -> Printer ()
prefixedLined
String
","
((Stmt NodeInfo -> Printer ()) -> [Stmt NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map
(\Stmt NodeInfo
p -> do
Printer ()
space
Stmt NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Stmt NodeInfo
p)
[Stmt NodeInfo]
stmts))
swingIt :: Printer ()
swingIt = Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer ()
swing (String -> Printer ()
write String
" " Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
rhsSeparator) (Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e)
match :: Match NodeInfo -> Printer ()
match :: Match NodeInfo -> Printer ()
match (Match NodeInfo
_ Name NodeInfo
name [Pat NodeInfo]
pats Rhs NodeInfo
rhs' Maybe (Binds NodeInfo)
mbinds) =
do Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (do case Name NodeInfo
name of
Ident NodeInfo
_ String
_ ->
Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Name NodeInfo
name
Symbol NodeInfo
_ String
_ ->
do String -> Printer ()
write String
"("
Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Name NodeInfo
name
String -> Printer ()
write String
")"
Printer ()
space)
([Printer ()] -> Printer ()
spaced ((Pat NodeInfo -> Printer ()) -> [Pat NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Pat NodeInfo]
pats))
Bool -> Printer () -> Printer ()
forall a. Bool -> Printer a -> Printer a
withCaseContext Bool
False (Rhs NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Rhs NodeInfo
rhs')
Maybe (Binds NodeInfo)
-> (Binds NodeInfo -> Printer ()) -> Printer ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe (Binds NodeInfo)
mbinds Binds NodeInfo -> Printer ()
bindingGroup
match (InfixMatch NodeInfo
_ Pat NodeInfo
pat1 Name NodeInfo
name [Pat NodeInfo]
pats Rhs NodeInfo
rhs' Maybe (Binds NodeInfo)
mbinds) =
do Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (do Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
pat1
Printer ()
space
Name NodeInfo -> Printer ()
prettyInfixName Name NodeInfo
name)
(do Printer ()
space
[Printer ()] -> Printer ()
spaced ((Pat NodeInfo -> Printer ()) -> [Pat NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Pat NodeInfo]
pats))
Bool -> Printer () -> Printer ()
forall a. Bool -> Printer a -> Printer a
withCaseContext Bool
False (Rhs NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Rhs NodeInfo
rhs')
Maybe (Binds NodeInfo)
-> (Binds NodeInfo -> Printer ()) -> Printer ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe (Binds NodeInfo)
mbinds Binds NodeInfo -> Printer ()
bindingGroup
context :: Context NodeInfo -> Printer ()
context :: Context NodeInfo -> Printer ()
context Context NodeInfo
ctx =
case Context NodeInfo
ctx of
CxSingle NodeInfo
_ Asst NodeInfo
a -> Asst NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Asst NodeInfo
a
CxTuple NodeInfo
_ [Asst NodeInfo]
as -> do
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"( ") (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ String -> [Printer ()] -> Printer ()
prefixedLined String
", " ((Asst NodeInfo -> Printer ()) -> [Asst NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Asst NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Asst NodeInfo]
as)
Printer ()
newline
String -> Printer ()
write String
")"
CxEmpty NodeInfo
_ -> Printer () -> Printer ()
forall a. Printer a -> Printer a
parens (() -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
typ :: Type NodeInfo -> Printer ()
typ :: Type NodeInfo -> Printer ()
typ (TyTuple NodeInfo
_ Boxed
Boxed [Type NodeInfo]
types) = do
let horVar :: Printer ()
horVar = Printer () -> Printer ()
forall a. Printer a -> Printer a
parens (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Printer () -> [Printer ()] -> Printer ()
inter (String -> Printer ()
write String
", ") ((Type NodeInfo -> Printer ()) -> [Type NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Type NodeInfo]
types)
let verVar :: Printer ()
verVar = Printer () -> Printer ()
forall a. Printer a -> Printer a
parens (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ String -> [Printer ()] -> Printer ()
prefixedLined String
"," ((Type NodeInfo -> Printer ()) -> [Type NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend Printer ()
space (Printer () -> Printer ())
-> (Type NodeInfo -> Printer ()) -> Type NodeInfo -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty) [Type NodeInfo]
types)
Printer ()
horVar Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
`ifFitsOnOneLineOrElse` Printer ()
verVar
typ (TyTuple NodeInfo
_ Boxed
Unboxed [Type NodeInfo]
types) = do
let horVar :: Printer ()
horVar = String -> String -> Printer () -> Printer ()
forall a. String -> String -> Printer a -> Printer a
wrap String
"(# " String
" #)" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Printer () -> [Printer ()] -> Printer ()
inter (String -> Printer ()
write String
", ") ((Type NodeInfo -> Printer ()) -> [Type NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Type NodeInfo]
types)
let verVar :: Printer ()
verVar = String -> String -> Printer () -> Printer ()
forall a. String -> String -> Printer a -> Printer a
wrap String
"(#" String
" #)" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ String -> [Printer ()] -> Printer ()
prefixedLined String
"," ((Type NodeInfo -> Printer ()) -> [Type NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend Printer ()
space (Printer () -> Printer ())
-> (Type NodeInfo -> Printer ()) -> Type NodeInfo -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty) [Type NodeInfo]
types)
Printer ()
horVar Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
`ifFitsOnOneLineOrElse` Printer ()
verVar
typ (TyForall NodeInfo
_ Maybe [TyVarBind NodeInfo]
mbinds Maybe (Context NodeInfo)
ctx Type NodeInfo
ty) =
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (case Maybe [TyVarBind NodeInfo]
mbinds of
Maybe [TyVarBind NodeInfo]
Nothing -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just [TyVarBind NodeInfo]
ts ->
do String -> Printer ()
write String
"forall "
[Printer ()] -> Printer ()
spaced ((TyVarBind NodeInfo -> Printer ())
-> [TyVarBind NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map TyVarBind NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [TyVarBind NodeInfo]
ts)
String -> Printer ()
write String
". ")
(do Int64
indentSpaces <- Printer Int64
getIndentSpaces
Maybe (Context NodeInfo) -> Printer () -> Printer ()
forall (ast :: * -> *) b.
(Pretty ast, Show (ast NodeInfo)) =>
Maybe (ast NodeInfo) -> Printer b -> Printer b
withCtx Maybe (Context NodeInfo)
ctx (Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indented Int64
indentSpaces (Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty)))
typ (TyFun NodeInfo
_ Type NodeInfo
a Type NodeInfo
b) =
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (do Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
a
String -> Printer ()
write String
" -> ")
(Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
b)
typ (TyList NodeInfo
_ Type NodeInfo
t) = Printer () -> Printer ()
forall a. Printer a -> Printer a
brackets (Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
t)
typ (TyParArray NodeInfo
_ Type NodeInfo
t) =
Printer () -> Printer ()
forall a. Printer a -> Printer a
brackets (do String -> Printer ()
write String
":"
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
t
String -> Printer ()
write String
":")
typ (TyApp NodeInfo
_ Type NodeInfo
f Type NodeInfo
a) = [Printer ()] -> Printer ()
spaced [Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
f, Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
a]
typ (TyVar NodeInfo
_ Name NodeInfo
n) = Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Name NodeInfo
n
typ (TyCon NodeInfo
_ QName NodeInfo
p) = QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
p
typ (TyParen NodeInfo
_ Type NodeInfo
e) = Printer () -> Printer ()
forall a. Printer a -> Printer a
parens (Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
e)
typ (TyInfix NodeInfo
_ Type NodeInfo
a MaybePromotedName NodeInfo
promotedop Type NodeInfo
b) = do
let isLineBreak' :: MaybePromotedName NodeInfo -> Printer Bool
isLineBreak' MaybePromotedName NodeInfo
op =
case MaybePromotedName NodeInfo
op of
PromotedName NodeInfo
_ QName NodeInfo
op' -> QName NodeInfo -> Printer Bool
isLineBreak QName NodeInfo
op'
UnpromotedName NodeInfo
_ QName NodeInfo
op' -> QName NodeInfo -> Printer Bool
isLineBreak QName NodeInfo
op'
prettyInfixOp' :: MaybePromotedName NodeInfo -> Printer ()
prettyInfixOp' MaybePromotedName NodeInfo
op =
case MaybePromotedName NodeInfo
op of
PromotedName NodeInfo
_ QName NodeInfo
op' -> String -> Printer ()
write String
"'" Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> QName NodeInfo -> Printer ()
prettyInfixOp QName NodeInfo
op'
UnpromotedName NodeInfo
_ QName NodeInfo
op' -> QName NodeInfo -> Printer ()
prettyInfixOp QName NodeInfo
op'
Bool
linebreak <- MaybePromotedName NodeInfo -> Printer Bool
isLineBreak' MaybePromotedName NodeInfo
promotedop
if Bool
linebreak
then do Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
a
Printer ()
newline
MaybePromotedName NodeInfo -> Printer ()
prettyInfixOp' MaybePromotedName NodeInfo
promotedop
Printer ()
space
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
b
else do Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
a
Printer ()
space
MaybePromotedName NodeInfo -> Printer ()
prettyInfixOp' MaybePromotedName NodeInfo
promotedop
Printer ()
space
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
b
typ (TyKind NodeInfo
_ Type NodeInfo
ty Type NodeInfo
k) =
Printer () -> Printer ()
forall a. Printer a -> Printer a
parens (do Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty
String -> Printer ()
write String
" :: "
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
k)
typ (TyBang NodeInfo
_ BangType NodeInfo
bangty Unpackedness NodeInfo
unpackty Type NodeInfo
right) =
do Unpackedness NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Unpackedness NodeInfo
unpackty
BangType NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty BangType NodeInfo
bangty
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
right
typ (TyEquals NodeInfo
_ Type NodeInfo
left Type NodeInfo
right) =
do Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
left
String -> Printer ()
write String
" ~ "
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
right
typ (TyPromoted NodeInfo
_ (PromotedList NodeInfo
_ Bool
_ [Type NodeInfo]
ts)) =
do String -> Printer ()
write String
"'["
Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Type NodeInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Type NodeInfo]
ts) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ String -> Printer ()
write String
" "
[Printer ()] -> Printer ()
commas ((Type NodeInfo -> Printer ()) -> [Type NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Type NodeInfo]
ts)
String -> Printer ()
write String
"]"
typ (TyPromoted NodeInfo
_ (PromotedTuple NodeInfo
_ [Type NodeInfo]
ts)) =
do String -> Printer ()
write String
"'("
Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Type NodeInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Type NodeInfo]
ts) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ String -> Printer ()
write String
" "
[Printer ()] -> Printer ()
commas ((Type NodeInfo -> Printer ()) -> [Type NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Type NodeInfo]
ts)
String -> Printer ()
write String
")"
typ (TyPromoted NodeInfo
_ (PromotedCon NodeInfo
_ Bool
_ QName NodeInfo
tname)) =
do String -> Printer ()
write String
"'"
QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
tname
typ (TyPromoted NodeInfo
_ (PromotedString NodeInfo
_ String
_ String
raw)) = do
do String -> Printer ()
write String
"\""
String -> Printer ()
string String
raw
String -> Printer ()
write String
"\""
typ ty :: Type NodeInfo
ty@TyPromoted{} = Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Type NodeInfo
ty
typ (TySplice NodeInfo
_ Splice NodeInfo
splice) = Splice NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Splice NodeInfo
splice
typ (TyWildCard NodeInfo
_ Maybe (Name NodeInfo)
name) =
case Maybe (Name NodeInfo)
name of
Maybe (Name NodeInfo)
Nothing -> String -> Printer ()
write String
"_"
Just Name NodeInfo
n ->
do String -> Printer ()
write String
"_"
Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Name NodeInfo
n
typ (TyQuasiQuote NodeInfo
_ String
n String
s) = String -> Printer () -> Printer ()
quotation String
n (String -> Printer ()
string String
s)
typ (TyUnboxedSum{}) = String -> Printer ()
forall a. HasCallStack => String -> a
error String
"FIXME: No implementation for TyUnboxedSum."
#if MIN_VERSION_haskell_src_exts(1,21,0)
typ (TyStar NodeInfo
_) = String -> Printer ()
write String
"*"
#endif
prettyTopName :: Name NodeInfo -> Printer ()
prettyTopName :: Name NodeInfo -> Printer ()
prettyTopName x :: Name NodeInfo
x@Ident{} = Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Name NodeInfo
x
prettyTopName x :: Name NodeInfo
x@Symbol{} = Printer () -> Printer ()
forall a. Printer a -> Printer a
parens (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Name NodeInfo
x
decl' :: Decl NodeInfo -> Printer ()
decl' :: Decl NodeInfo -> Printer ()
decl' (TypeSig NodeInfo
_ [Name NodeInfo]
names Type NodeInfo
ty') = do
Maybe PrintState
mst <- Printer () -> Printer (Maybe PrintState)
forall a. Printer a -> Printer (Maybe PrintState)
fitsOnOneLine (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (do [Printer ()] -> Printer ()
commas ((Name NodeInfo -> Printer ()) -> [Name NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Name NodeInfo -> Printer ()
prettyTopName [Name NodeInfo]
names)
String -> Printer ()
write String
" :: ")
(Type NodeInfo -> Printer ()
declTy Type NodeInfo
ty'))
case Maybe PrintState
mst of
Maybe PrintState
Nothing -> do
[Printer ()] -> Printer ()
commas ((Name NodeInfo -> Printer ()) -> [Name NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Name NodeInfo -> Printer ()
prettyTopName [Name NodeInfo]
names)
Int64
indentSpaces <- Printer Int64
getIndentSpaces
if Int64
allNamesLength Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
indentSpaces
then do String -> Printer ()
write String
" ::"
Printer ()
newline
Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indented Int64
indentSpaces (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
" ") (Type NodeInfo -> Printer ()
declTy Type NodeInfo
ty'))
else (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
" :: ") (Type NodeInfo -> Printer ()
declTy Type NodeInfo
ty'))
Just PrintState
st -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st
where
nameLength :: Name l -> Int
nameLength (Ident l
_ String
s) = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s
nameLength (Symbol l
_ String
s) = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2
allNamesLength :: Int64
allNamesLength = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int64) -> Int -> Int64
forall a b. (a -> b) -> a -> b
$ [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((Name NodeInfo -> Int) -> [Name NodeInfo] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Name NodeInfo -> Int
forall l. Name l -> Int
nameLength [Name NodeInfo]
names) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* ([Name NodeInfo] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Name NodeInfo]
names Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
decl' (PatBind NodeInfo
_ Pat NodeInfo
pat Rhs NodeInfo
rhs' Maybe (Binds NodeInfo)
mbinds) =
Bool -> Printer () -> Printer ()
forall a. Bool -> Printer a -> Printer a
withCaseContext Bool
False (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$
do Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
pat
Rhs NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Rhs NodeInfo
rhs'
Maybe (Binds NodeInfo)
-> (Binds NodeInfo -> Printer ()) -> Printer ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe (Binds NodeInfo)
mbinds Binds NodeInfo -> Printer ()
bindingGroup
decl' Decl NodeInfo
e = Decl NodeInfo -> Printer ()
decl Decl NodeInfo
e
declTy :: Type NodeInfo -> Printer ()
declTy :: Type NodeInfo -> Printer ()
declTy Type NodeInfo
dty =
case Type NodeInfo
dty of
TyForall NodeInfo
_ Maybe [TyVarBind NodeInfo]
mbinds Maybe (Context NodeInfo)
mctx Type NodeInfo
ty ->
case Maybe [TyVarBind NodeInfo]
mbinds of
Maybe [TyVarBind NodeInfo]
Nothing -> do
case Maybe (Context NodeInfo)
mctx of
Maybe (Context NodeInfo)
Nothing -> Bool -> Type NodeInfo -> Printer ()
prettyTy Bool
False Type NodeInfo
ty
Just Context NodeInfo
ctx -> do
Maybe PrintState
mst <- Printer () -> Printer (Maybe PrintState)
forall a. Printer a -> Printer (Maybe PrintState)
fitsOnOneLine (do Context NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Context NodeInfo
ctx
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
" => ") (Bool -> Type NodeInfo -> Printer ()
prettyTy Bool
False Type NodeInfo
ty))
case Maybe PrintState
mst of
Maybe PrintState
Nothing -> do
Context NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Context NodeInfo
ctx
Printer ()
newline
Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indented (-Int64
3) (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"=> ") (Bool -> Type NodeInfo -> Printer ()
prettyTy Bool
True Type NodeInfo
ty))
Just PrintState
st -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st
Just [TyVarBind NodeInfo]
ts -> do
String -> Printer ()
write String
"forall "
[Printer ()] -> Printer ()
spaced ((TyVarBind NodeInfo -> Printer ())
-> [TyVarBind NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map TyVarBind NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [TyVarBind NodeInfo]
ts)
String -> Printer ()
write String
"."
case Maybe (Context NodeInfo)
mctx of
Maybe (Context NodeInfo)
Nothing -> do
Maybe PrintState
mst <- Printer () -> Printer (Maybe PrintState)
forall a. Printer a -> Printer (Maybe PrintState)
fitsOnOneLine (Printer ()
space Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Type NodeInfo -> Printer ()
prettyTy Bool
False Type NodeInfo
ty)
case Maybe PrintState
mst of
Maybe PrintState
Nothing -> do
Printer ()
newline
Bool -> Type NodeInfo -> Printer ()
prettyTy Bool
True Type NodeInfo
ty
Just PrintState
st -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st
Just Context NodeInfo
ctx -> do
Maybe PrintState
mst <- Printer () -> Printer (Maybe PrintState)
forall a. Printer a -> Printer (Maybe PrintState)
fitsOnOneLine (Printer ()
space Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Context NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Context NodeInfo
ctx)
case Maybe PrintState
mst of
Maybe PrintState
Nothing -> do
Printer ()
newline
Context NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Context NodeInfo
ctx
Printer ()
newline
Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indented (-Int64
3) (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"=> ") (Bool -> Type NodeInfo -> Printer ()
prettyTy Bool
True Type NodeInfo
ty))
Just PrintState
st -> do
PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st
Printer ()
newline
Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indented (-Int64
3) (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"=> ") (Bool -> Type NodeInfo -> Printer ()
prettyTy Bool
True Type NodeInfo
ty))
Type NodeInfo
_ -> Bool -> Type NodeInfo -> Printer ()
prettyTy Bool
False Type NodeInfo
dty
where
collapseFaps :: Type l -> [Type l]
collapseFaps (TyFun l
_ Type l
arg Type l
result) = Type l
arg Type l -> [Type l] -> [Type l]
forall a. a -> [a] -> [a]
: Type l -> [Type l]
collapseFaps Type l
result
collapseFaps Type l
e = [Type l
e]
prettyTy :: Bool -> Type NodeInfo -> Printer ()
prettyTy Bool
breakLine Type NodeInfo
ty = do
if Bool
breakLine
then
case Type NodeInfo -> [Type NodeInfo]
forall l. Type l -> [Type l]
collapseFaps Type NodeInfo
ty of
[] -> Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty
[Type NodeInfo]
tys -> String -> [Printer ()] -> Printer ()
prefixedLined String
"-> " ((Type NodeInfo -> Printer ()) -> [Type NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Type NodeInfo]
tys)
else do
Maybe PrintState
mst <- Printer () -> Printer (Maybe PrintState)
forall a. Printer a -> Printer (Maybe PrintState)
fitsOnOneLine (Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty)
case Maybe PrintState
mst of
Maybe PrintState
Nothing ->
case Type NodeInfo -> [Type NodeInfo]
forall l. Type l -> [Type l]
collapseFaps Type NodeInfo
ty of
[] -> Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty
[Type NodeInfo]
tys -> String -> [Printer ()] -> Printer ()
prefixedLined String
"-> " ((Type NodeInfo -> Printer ()) -> [Type NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Type NodeInfo]
tys)
Just PrintState
st -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st
qualConDecl :: QualConDecl NodeInfo -> Printer ()
qualConDecl :: QualConDecl NodeInfo -> Printer ()
qualConDecl (QualConDecl NodeInfo
_ Maybe [TyVarBind NodeInfo]
tyvars Maybe (Context NodeInfo)
ctx ConDecl NodeInfo
d) =
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([TyVarBind NodeInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([TyVarBind NodeInfo]
-> Maybe [TyVarBind NodeInfo] -> [TyVarBind NodeInfo]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [TyVarBind NodeInfo]
tyvars))
(do String -> Printer ()
write String
"forall "
[Printer ()] -> Printer ()
spaced ((TyVarBind NodeInfo -> Printer ())
-> [TyVarBind NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map TyVarBind NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ([TyVarBind NodeInfo]
-> Maybe [TyVarBind NodeInfo] -> [TyVarBind NodeInfo]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [TyVarBind NodeInfo]
tyvars))
String -> Printer ()
write String
". "))
(Maybe (Context NodeInfo) -> Printer () -> Printer ()
forall (ast :: * -> *) b.
(Pretty ast, Show (ast NodeInfo)) =>
Maybe (ast NodeInfo) -> Printer b -> Printer b
withCtx Maybe (Context NodeInfo)
ctx (ConDecl NodeInfo -> Printer ()
recDecl ConDecl NodeInfo
d))
conDecl :: ConDecl NodeInfo -> Printer ()
conDecl :: ConDecl NodeInfo -> Printer ()
conDecl (RecDecl NodeInfo
_ Name NodeInfo
name [FieldDecl NodeInfo]
fields) = do
Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Name NodeInfo
name
Printer ()
newline
Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock
(do Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"{")
(String -> [Printer ()] -> Printer ()
prefixedLined String
","
((FieldDecl NodeInfo -> Printer ())
-> [FieldDecl NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend Printer ()
space (Printer () -> Printer ())
-> (FieldDecl NodeInfo -> Printer ())
-> FieldDecl NodeInfo
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDecl NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty) [FieldDecl NodeInfo]
fields))
Printer ()
newline
String -> Printer ()
write String
"}"
)
conDecl (ConDecl NodeInfo
_ Name NodeInfo
name [Type NodeInfo]
bangty) = do
Name NodeInfo -> Printer ()
prettyQuoteName Name NodeInfo
name
Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless
([Type NodeInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Type NodeInfo]
bangty)
(Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
ifFitsOnOneLineOrElse
(do Printer ()
space
[Printer ()] -> Printer ()
spaced ((Type NodeInfo -> Printer ()) -> [Type NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Type NodeInfo]
bangty))
(do Printer ()
newline
Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock ([Printer ()] -> Printer ()
lined ((Type NodeInfo -> Printer ()) -> [Type NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Type NodeInfo]
bangty))))
conDecl (InfixConDecl NodeInfo
_ Type NodeInfo
a Name NodeInfo
f Type NodeInfo
b) =
Printer () -> [Printer ()] -> Printer ()
inter Printer ()
space [Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
a, Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Name NodeInfo
f, Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
b]
recDecl :: ConDecl NodeInfo -> Printer ()
recDecl :: ConDecl NodeInfo -> Printer ()
recDecl (RecDecl NodeInfo
_ Name NodeInfo
name [FieldDecl NodeInfo]
fields) =
do Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Name NodeInfo
name
Int64
indentSpaces <- Printer Int64
getIndentSpaces
Printer ()
newline
Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
column Int64
indentSpaces
(do Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"{!")
(String -> [Printer ()] -> Printer ()
prefixedLined String
","
((FieldDecl NodeInfo -> Printer ())
-> [FieldDecl NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend Printer ()
space (Printer () -> Printer ())
-> (FieldDecl NodeInfo -> Printer ())
-> FieldDecl NodeInfo
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDecl NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty) [FieldDecl NodeInfo]
fields))
Printer ()
newline
String -> Printer ()
write String
"}")
recDecl ConDecl NodeInfo
r = ConDecl NodeInfo -> Printer ()
forall (ast :: * -> *). Pretty ast => ast NodeInfo -> Printer ()
prettyInternal ConDecl NodeInfo
r
recUpdateExpr :: Printer () -> [FieldUpdate NodeInfo] -> Printer ()
recUpdateExpr :: Printer () -> [FieldUpdate NodeInfo] -> Printer ()
recUpdateExpr Printer ()
expWriter [FieldUpdate NodeInfo]
updates = do
Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
ifFitsOnOneLineOrElse Printer ()
hor (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
Printer ()
expWriter
Printer ()
newline
Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (Printer ()
updatesHor Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
`ifFitsOnOneLineOrElse` Printer ()
updatesVer)
where
hor :: Printer ()
hor = do
Printer ()
expWriter
Printer ()
space
Printer ()
updatesHor
updatesHor :: Printer ()
updatesHor = Printer () -> Printer ()
forall a. Printer a -> Printer a
braces (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ [Printer ()] -> Printer ()
commas ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (FieldUpdate NodeInfo -> Printer ())
-> [FieldUpdate NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map FieldUpdate NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [FieldUpdate NodeInfo]
updates
updatesVer :: Printer ()
updatesVer = do
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"{ ") (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ String -> [Printer ()] -> Printer ()
prefixedLined String
", " ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (FieldUpdate NodeInfo -> Printer ())
-> [FieldUpdate NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map FieldUpdate NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [FieldUpdate NodeInfo]
updates
Printer ()
newline
String -> Printer ()
write String
"}"
isRecord :: QualConDecl t -> Bool
isRecord :: QualConDecl t -> Bool
isRecord (QualConDecl t
_ Maybe [TyVarBind t]
_ Maybe (Context t)
_ RecDecl{}) = Bool
True
isRecord QualConDecl t
_ = Bool
False
isLineBreak :: QName NodeInfo -> Printer Bool
isLineBreak :: QName NodeInfo -> Printer Bool
isLineBreak (UnQual NodeInfo
_ (Symbol NodeInfo
_ String
s)) = do
[String]
breaks <- (PrintState -> [String]) -> Printer [String]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Config -> [String]
configLineBreaks (Config -> [String])
-> (PrintState -> Config) -> PrintState -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrintState -> Config
psConfig)
Bool -> Printer Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Printer Bool) -> Bool -> Printer Bool
forall a b. (a -> b) -> a -> b
$ String
s String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
breaks
isLineBreak QName NodeInfo
_ = Bool -> Printer Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
fitsOnOneLine :: Printer a -> Printer (Maybe PrintState)
fitsOnOneLine :: Printer a -> Printer (Maybe PrintState)
fitsOnOneLine Printer a
p =
do PrintState
st <- Printer PrintState
forall s (m :: * -> *). MonadState s m => m s
get
PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st { psFitOnOneLine :: Bool
psFitOnOneLine = Bool
True}
Bool
ok <- (a -> Bool) -> Printer a -> Printer Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> a -> Bool
forall a b. a -> b -> a
const Bool
True) Printer a
p Printer Bool -> Printer Bool -> Printer Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Printer Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
PrintState
st' <- Printer PrintState
forall s (m :: * -> *). MonadState s m => m s
get
PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st
Bool -> Printer ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Printer ()) -> Bool -> Printer ()
forall a b. (a -> b) -> a -> b
$ Bool
ok Bool -> Bool -> Bool
|| Bool -> Bool
not (PrintState -> Bool
psFitOnOneLine PrintState
st)
Maybe PrintState -> Printer (Maybe PrintState)
forall (m :: * -> *) a. Monad m => a -> m a
return (if Bool
ok
then PrintState -> Maybe PrintState
forall a. a -> Maybe a
Just PrintState
st' { psFitOnOneLine :: Bool
psFitOnOneLine = PrintState -> Bool
psFitOnOneLine PrintState
st }
else Maybe PrintState
forall a. Maybe a
Nothing)
ifFitsOnOneLineOrElse :: Printer a -> Printer a -> Printer a
ifFitsOnOneLineOrElse :: Printer a -> Printer a -> Printer a
ifFitsOnOneLineOrElse Printer a
a Printer a
b = do
PrintState
stOrig <- Printer PrintState
forall s (m :: * -> *). MonadState s m => m s
get
PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
stOrig{psFitOnOneLine :: Bool
psFitOnOneLine = Bool
True}
Maybe a
res <- (a -> Maybe a) -> Printer a -> Printer (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just Printer a
a Printer (Maybe a) -> Printer (Maybe a) -> Printer (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe a -> Printer (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
case Maybe a
res of
Just a
r -> do
(PrintState -> PrintState) -> Printer ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((PrintState -> PrintState) -> Printer ())
-> (PrintState -> PrintState) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \PrintState
st -> PrintState
st{psFitOnOneLine :: Bool
psFitOnOneLine = PrintState -> Bool
psFitOnOneLine PrintState
stOrig}
a -> Printer a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r
Maybe a
Nothing -> do
PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
stOrig
Bool -> Printer ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Printer ()) -> Bool -> Printer ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (PrintState -> Bool
psFitOnOneLine PrintState
stOrig)
Printer a
b
bindingGroup :: Binds NodeInfo -> Printer ()
bindingGroup :: Binds NodeInfo -> Printer ()
bindingGroup Binds NodeInfo
binds =
do Printer ()
newline
Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indented Int64
2
(do String -> Printer ()
write String
"where"
Printer ()
newline
Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indented Int64
2 (Binds NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Binds NodeInfo
binds))
infixApp :: Exp NodeInfo
-> Exp NodeInfo
-> QOp NodeInfo
-> Exp NodeInfo
-> Maybe Int64
-> Printer ()
infixApp :: Exp NodeInfo
-> Exp NodeInfo
-> QOp NodeInfo
-> Exp NodeInfo
-> Maybe Int64
-> Printer ()
infixApp Exp NodeInfo
e Exp NodeInfo
a QOp NodeInfo
op Exp NodeInfo
b Maybe Int64
indent =
Printer ()
hor Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
`ifFitsOnOneLineOrElse` Printer ()
ver
where
hor :: Printer ()
hor =
[Printer ()] -> Printer ()
spaced
[ case OpChainLink NodeInfo
link of
OpChainExp Exp NodeInfo
e' -> Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e'
OpChainLink QOp NodeInfo
qop -> QOp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QOp NodeInfo
qop
| OpChainLink NodeInfo
link <- Exp NodeInfo -> [OpChainLink NodeInfo]
forall l. Exp l -> [OpChainLink l]
flattenOpChain Exp NodeInfo
e
]
ver :: Printer ()
ver = do
Exp NodeInfo -> Printer ()
prettyWithIndent Exp NodeInfo
a
Printer ()
beforeRhs <- case Exp NodeInfo
a of
Do NodeInfo
_ [Stmt NodeInfo]
_ -> do
Int64
indentSpaces <- Printer Int64
getIndentSpaces
Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
column (Int64 -> Maybe Int64 -> Int64
forall a. a -> Maybe a -> a
fromMaybe Int64
0 Maybe Int64
indent Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
indentSpaces Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
3) (Printer ()
newline Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> QOp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QOp NodeInfo
op)
Printer () -> Printer (Printer ())
forall (m :: * -> *) a. Monad m => a -> m a
return Printer ()
space
Exp NodeInfo
_ -> Printer ()
space Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> QOp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QOp NodeInfo
op Printer () -> Printer (Printer ()) -> Printer (Printer ())
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer () -> Printer (Printer ())
forall (m :: * -> *) a. Monad m => a -> m a
return Printer ()
newline
case Exp NodeInfo
b of
Lambda{} -> Printer ()
space Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
b
LCase{} -> Printer ()
space Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
b
Do NodeInfo
_ [Stmt NodeInfo]
stmts -> Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer ()
swing (String -> Printer ()
write String
" do") (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ [Printer ()] -> Printer ()
lined ((Stmt NodeInfo -> Printer ()) -> [Stmt NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Stmt NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Stmt NodeInfo]
stmts)
Exp NodeInfo
_ -> do
Printer ()
beforeRhs
case Maybe Int64
indent of
Maybe Int64
Nothing -> do
Int64
col <- (((), PrintState) -> Int64)
-> Printer ((), PrintState) -> Printer Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PrintState -> Int64
psColumn (PrintState -> Int64)
-> (((), PrintState) -> PrintState) -> ((), PrintState) -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((), PrintState) -> PrintState
forall a b. (a, b) -> b
snd)
(Printer () -> Printer ((), PrintState)
forall a. Printer a -> Printer (a, PrintState)
sandbox (String -> Printer ()
write String
""))
if Int64
col Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0
then do Int64
indentSpaces <- Printer Int64
getIndentSpaces
Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
column Int64
indentSpaces (Exp NodeInfo -> Printer ()
prettyWithIndent Exp NodeInfo
b)
else Exp NodeInfo -> Printer ()
prettyWithIndent Exp NodeInfo
b
Just Int64
col -> do
Int64
indentSpaces <- Printer Int64
getIndentSpaces
Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
column (Int64
col Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
indentSpaces) (Exp NodeInfo -> Printer ()
prettyWithIndent Exp NodeInfo
b)
prettyWithIndent :: Exp NodeInfo -> Printer ()
prettyWithIndent Exp NodeInfo
e' =
case Exp NodeInfo
e' of
InfixApp NodeInfo
_ Exp NodeInfo
a' QOp NodeInfo
op' Exp NodeInfo
b' -> Exp NodeInfo
-> Exp NodeInfo
-> QOp NodeInfo
-> Exp NodeInfo
-> Maybe Int64
-> Printer ()
infixApp Exp NodeInfo
e' Exp NodeInfo
a' QOp NodeInfo
op' Exp NodeInfo
b' Maybe Int64
indent
Exp NodeInfo
_ -> Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e'
data OpChainLink l
= OpChainExp (Exp l)
| OpChainLink (QOp l)
deriving (Int -> OpChainLink l -> String -> String
[OpChainLink l] -> String -> String
OpChainLink l -> String
(Int -> OpChainLink l -> String -> String)
-> (OpChainLink l -> String)
-> ([OpChainLink l] -> String -> String)
-> Show (OpChainLink l)
forall l. Show l => Int -> OpChainLink l -> String -> String
forall l. Show l => [OpChainLink l] -> String -> String
forall l. Show l => OpChainLink l -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [OpChainLink l] -> String -> String
$cshowList :: forall l. Show l => [OpChainLink l] -> String -> String
show :: OpChainLink l -> String
$cshow :: forall l. Show l => OpChainLink l -> String
showsPrec :: Int -> OpChainLink l -> String -> String
$cshowsPrec :: forall l. Show l => Int -> OpChainLink l -> String -> String
Show)
flattenOpChain :: Exp l -> [OpChainLink l]
flattenOpChain :: Exp l -> [OpChainLink l]
flattenOpChain (InfixApp l
_ Exp l
left QOp l
op Exp l
right) =
Exp l -> [OpChainLink l]
forall l. Exp l -> [OpChainLink l]
flattenOpChain Exp l
left [OpChainLink l] -> [OpChainLink l] -> [OpChainLink l]
forall a. Semigroup a => a -> a -> a
<>
[QOp l -> OpChainLink l
forall l. QOp l -> OpChainLink l
OpChainLink QOp l
op] [OpChainLink l] -> [OpChainLink l] -> [OpChainLink l]
forall a. Semigroup a => a -> a -> a
<>
Exp l -> [OpChainLink l]
forall l. Exp l -> [OpChainLink l]
flattenOpChain Exp l
right
flattenOpChain Exp l
e = [Exp l -> OpChainLink l
forall l. Exp l -> OpChainLink l
OpChainExp Exp l
e]
quotation :: String -> Printer () -> Printer ()
quotation :: String -> Printer () -> Printer ()
quotation String
quoter Printer ()
body =
Printer () -> Printer ()
forall a. Printer a -> Printer a
brackets
(Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend
(do String -> Printer ()
string String
quoter
String -> Printer ()
write String
"|")
(do Printer ()
body
String -> Printer ()
write String
"|"))