{-# 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_, traverse_)
import Data.Int
import Data.List
import Data.Monoid ((<>))
import Data.Maybe
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 a :: ast NodeInfo
a = do
(NodeComment -> Printer ()) -> [NodeComment] -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
(\c' :: NodeComment
c' -> do
case NodeComment
c' of
CommentBeforeLine _ c :: SomeComment
c -> do
case SomeComment
c of
EndOfLine s :: String
s -> String -> Printer ()
write ("--" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s)
MultiLine s :: String
s -> String -> Printer ()
write ("{-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ "-}")
Printer ()
newline
_ -> () -> 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_
(\(i :: Int
i, c' :: NodeComment
c') -> do
case NodeComment
c' of
CommentSameLine spn :: SrcSpan
spn c :: 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
== 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
- 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 spn :: SrcSpan
spn c :: 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
== 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
- 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
_ -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
([Int] -> [NodeComment] -> [(Int, NodeComment)]
forall a b. [a] -> [b] -> [(a, b)]
zip [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 cs :: String
cs -> do
String -> Printer ()
write ("--" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cs)
(PrintState -> PrintState) -> Printer ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify
(\s :: PrintState
s ->
PrintState
s
{ psEolComment :: Bool
psEolComment = Bool
True
})
MultiLine cs :: String
cs -> do
String -> Printer ()
write ("{-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cs String -> String -> String
forall a. [a] -> [a] -> [a]
++ "-}")
(PrintState -> PrintState) -> Printer ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify
(\s :: 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 i :: Int64
i p :: 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 (\s :: 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 (\s :: 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 p :: 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 ", ")
inter :: Printer () -> [Printer ()] -> Printer ()
inter :: Printer () -> [Printer ()] -> Printer ()
inter sep :: Printer ()
sep ps :: [Printer ()]
ps =
((Int, Printer ()) -> Printer () -> Printer ())
-> Printer () -> [(Int, Printer ())] -> Printer ()
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
(\(i :: Int
i,p :: Printer ()
p) next :: 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 [1 ..] [Printer ()]
ps)
lined :: [Printer ()] -> Printer ()
lined :: [Printer ()] -> Printer ()
lined ps :: [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 pref :: String
pref ps' :: [Printer ()]
ps' =
case [Printer ()]
ps' of
[] -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
(p :: Printer ()
p:ps :: [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
*
(-1)))
((Printer () -> Printer ()) -> [Printer ()] -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\p' :: 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 i :: Int64
i p :: 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 (\s :: 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 (\s :: 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 "\n"
(PrintState -> PrintState) -> Printer ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\s :: PrintState
s -> PrintState
s {psNewline :: Bool
psNewline = Bool
True})
withCaseContext :: Bool -> Printer a -> Printer a
withCaseContext :: Bool -> Printer a -> Printer a
withCaseContext bool :: Bool
bool pr :: 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 (\s :: 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 (\s :: 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 "->"
else String -> Printer ()
write "="
depend :: Printer () -> Printer b -> Printer b
depend :: Printer () -> Printer b -> Printer b
depend maker :: Printer ()
maker dependent :: 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 open :: String
open close :: String
close p :: 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 "(" ")"
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 "{" "}"
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 "[" "]"
space :: Printer ()
space :: Printer ()
space = String -> Printer ()
write " "
comma :: Printer ()
comma :: Printer ()
comma = String -> Printer ()
write ","
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 x :: 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
/= "\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
== "\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))
' ') 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
> 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 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
== 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 (\s :: 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
== '\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 p :: 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 Nothing m :: Printer b
m = Printer b
m
withCtx (Just ctx :: ast NodeInfo
ctx) m :: Printer b
m =
do ast NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ast NodeInfo
ctx
String -> Printer ()
write " =>"
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 ())
(\p :: 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 a :: Printer ()
a b :: 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 st :: PrintState
st -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st
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 i :: Int64
i a :: Printer ()
a b :: 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 _ asserts :: [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
Nothing -> Context NodeInfo -> Printer ()
context Context NodeInfo
ctx
Just st :: PrintState
st -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st
prettyInternal ctx :: Context NodeInfo
ctx = Context NodeInfo -> Printer ()
context Context NodeInfo
ctx
instance Pretty Pat where
prettyInternal :: Pat NodeInfo -> Printer ()
prettyInternal x :: Pat NodeInfo
x =
case Pat NodeInfo
x of
PLit _ sign :: Sign NodeInfo
sign l :: 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 _ n :: Name NodeInfo
n k :: 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 "+")
(Integer -> Printer ()
int Integer
k)
PInfixApp _ a :: Pat NodeInfo
a op :: QName NodeInfo
op b :: 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))
_ ->
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 _ f :: QName NodeInfo
f args :: [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 _ boxed :: Boxed
boxed pats :: [Pat NodeInfo]
pats ->
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write (case Boxed
boxed of
Unboxed -> "(# "
Boxed -> "("))
(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
Unboxed -> " #)"
Boxed -> ")"))
PList _ ps :: [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 _ e :: 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 _ qname :: QName NodeInfo
qname fields :: [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 "{}"
[field :: 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
_ -> do
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "{") (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$
String -> [Printer ()] -> Printer ()
prefixedLined "," ([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 "}"
Printer ()
horVariant Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
`ifFitsOnOneLineOrElse` Printer ()
verVariant
PAsPat _ n :: Name NodeInfo
n p :: 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 "@")
(Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
p)
PWildCard _ -> String -> Printer ()
write "_"
PIrrPat _ p :: Pat NodeInfo
p ->
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "~")
(Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
p)
PatTypeSig _ p :: Pat NodeInfo
p ty :: 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 " :: ")
(Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty)
PViewPat _ e :: Exp NodeInfo
e p :: 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 " -> ")
(Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
p)
PQuasiQuote _ name :: String
name str :: String
str -> String -> Printer () -> Printer ()
quotation String
name (String -> Printer ()
string String
str)
PBangPat _ p :: Pat NodeInfo
p ->
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "!")
(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 _ s :: Splice NodeInfo
s -> Splice NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Splice NodeInfo
s
#if MIN_VERSION_haskell_src_exts(1,20,0)
(PUnboxedSum _ nLeft :: Int
nLeft nRight :: Int
nRight p :: Pat NodeInfo
p) -> Int -> Int -> Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
Int -> Int -> ast NodeInfo -> Printer ()
unboxedSumValuePattern Int
nLeft Int
nRight Pat NodeInfo
p
#endif
prettyInfixName :: Name NodeInfo -> Printer ()
prettyInfixName :: Name NodeInfo -> Printer ()
prettyInfixName (Ident _ n :: String
n) = do String -> Printer ()
write "`"; String -> Printer ()
string String
n; String -> Printer ()
write "`";
prettyInfixName (Symbol _ s :: String
s) = String -> Printer ()
string String
s
prettyInfixOp :: QName NodeInfo -> Printer ()
prettyInfixOp :: QName NodeInfo -> Printer ()
prettyInfixOp x :: QName NodeInfo
x =
case QName NodeInfo
x of
Qual _ mn :: ModuleName NodeInfo
mn n :: Name NodeInfo
n ->
case Name NodeInfo
n of
Ident _ i :: String
i -> do String -> Printer ()
write "`"; ModuleName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ModuleName NodeInfo
mn; String -> Printer ()
write "."; String -> Printer ()
string String
i; String -> Printer ()
write "`";
Symbol _ s :: String
s -> do ModuleName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ModuleName NodeInfo
mn; String -> Printer ()
write "."; String -> Printer ()
string String
s;
UnQual _ n :: Name NodeInfo
n -> Name NodeInfo -> Printer ()
prettyInfixName Name NodeInfo
n
Special _ s :: 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 x :: Name NodeInfo
x =
case Name NodeInfo
x of
Ident _ i :: String
i -> String -> Printer ()
string String
i
Symbol _ s :: String
s -> String -> Printer ()
string ("(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ ")")
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 _ pats :: [Pat NodeInfo]
pats (Do l :: NodeInfo
l stmts :: [Stmt NodeInfo]
stmts)) =
do
Maybe PrintState
mst <-
Printer () -> Printer (Maybe PrintState)
forall a. Printer a -> Printer (Maybe PrintState)
fitsOnOneLine
(do String -> Printer ()
write "\\"
[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 " -> "
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
Nothing -> Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer ()
swing (do String -> Printer ()
write "\\"
[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 " -> 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 st :: PrintState
st -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st
exp (Tuple _ boxed :: Boxed
boxed exps :: [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 ", ") ((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 "," ((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
Nothing -> Printer ()
verVariant
Just st :: PrintState
st -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st
where
parensHorB :: Boxed -> Printer a -> Printer a
parensHorB Boxed = Printer a -> Printer a
forall a. Printer a -> Printer a
parens
parensHorB Unboxed = String -> String -> Printer a -> Printer a
forall a. String -> String -> Printer a -> Printer a
wrap "(# " " #)"
parensVerB :: Boxed -> Printer a -> Printer a
parensVerB Boxed = Printer a -> Printer a
forall a. Printer a -> Printer a
parens
parensVerB Unboxed = String -> String -> Printer a -> Printer a
forall a. String -> String -> Printer a -> Printer a
wrap "(#" "#)"
exp (TupleSection _ boxed :: Boxed
boxed mexps :: [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 ", ") ((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 "," ((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
Nothing -> Printer ()
verVariant
Just st :: PrintState
st -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st
where
parensHorB :: Boxed -> Printer a -> Printer a
parensHorB Boxed = Printer a -> Printer a
forall a. Printer a -> Printer a
parens
parensHorB Unboxed = String -> String -> Printer a -> Printer a
forall a. String -> String -> Printer a -> Printer a
wrap "(# " " #)"
parensVerB :: Boxed -> Printer a -> Printer a
parensVerB Boxed = Printer a -> Printer a
forall a. Printer a -> Printer a
parens
parensVerB Unboxed = String -> String -> Printer a -> Printer a
forall a. String -> String -> Printer a -> Printer a
wrap "(#" "#)"
#if MIN_VERSION_haskell_src_exts(1,20,0)
exp (UnboxedSum _ nLeft :: Int
nLeft nRight :: Int
nRight e :: Exp NodeInfo
e) = Int -> Int -> Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
Int -> Int -> ast NodeInfo -> Printer ()
unboxedSumValuePattern Int
nLeft Int
nRight Exp NodeInfo
e
#endif
exp e :: Exp NodeInfo
e@(InfixApp _ a :: Exp NodeInfo
a op :: QOp NodeInfo
op b :: 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 _ if' :: Exp NodeInfo
if' then' :: Exp NodeInfo
then' else' :: Exp NodeInfo
else') =
do Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "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 "then " Exp NodeInfo
then'
Printer ()
newline
String -> Exp NodeInfo -> Printer ()
branch "else " Exp NodeInfo
else')
where branch :: String -> Exp NodeInfo -> Printer ()
branch str :: String
str e :: Exp NodeInfo
e =
case Exp NodeInfo
e of
Do _ stmts :: [Stmt NodeInfo]
stmts ->
do String -> Printer ()
write String
str
String -> Printer ()
write "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))
_ ->
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 _ op :: Exp NodeInfo
op arg :: 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
Nothing -> do
let (f :: Exp NodeInfo
f:args :: [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
== 0 then Int64
spaces else 0
if Int64
diff Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ 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 st :: PrintState
st -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st
where
flatten :: Exp NodeInfo -> [Exp NodeInfo]
flatten (App label' :: NodeInfo
label' op' :: Exp NodeInfo
op' arg' :: 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 x :: Exp NodeInfo
x = [Exp NodeInfo
x]
addComments :: NodeInfo -> NodeInfo -> NodeInfo
addComments n1 :: NodeInfo
n1 n2 :: 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 _ es :: [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
Nothing -> do
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend
(String -> Printer ()
write "[")
(String -> [Printer ()] -> Printer ()
prefixedLined "," ((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 "]"
Just st :: 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 ", ")
((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 _ exp' :: Exp NodeInfo
exp' updates :: [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 _ qname :: QName NodeInfo
qname updates :: [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 _ binds :: Binds NodeInfo
binds e :: Exp NodeInfo
e) =
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "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 (-3) (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "in ")
(Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e)))
exp (ListComp _ e :: Exp NodeInfo
e qstmt :: [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 " | "
[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 "[ "
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 "| ") (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ String -> [Printer ()] -> Printer ()
prefixedLined ", " ([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 "]"
Printer ()
horVariant Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
`ifFitsOnOneLineOrElse` Printer ()
verVariant
exp (ParComp _ e :: Exp NodeInfo
e qstmts :: [[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
$ \qstmt :: [QualStmt NodeInfo]
qstmt -> do
String -> Printer ()
write " | "
[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 "[ ") (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
$ \qstmt :: [QualStmt NodeInfo]
qstmt -> do
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "| ") (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ String -> [Printer ()] -> Printer ()
prefixedLined ", " ([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 "]"
Printer ()
horVariant Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
`ifFitsOnOneLineOrElse` Printer ()
verVariant
exp (TypeApp _ t :: Type NodeInfo
t) = do
String -> Printer ()
write "@"
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
t
exp (NegApp _ e :: Exp NodeInfo
e) =
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "-")
(Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e)
exp (Lambda _ ps :: [Pat NodeInfo]
ps e :: Exp NodeInfo
e) = do
String -> Printer ()
write "\\"
[Printer ()] -> Printer ()
spaced [ do case (Int
i, Pat NodeInfo
x) of
(0, PIrrPat {}) -> Printer ()
space
(0, PBangPat {}) -> Printer ()
space
_ -> () -> 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
| (i :: Int
i, x :: Pat NodeInfo
x) <- [Int] -> [Pat NodeInfo] -> [(Int, Pat NodeInfo)]
forall a b. [a] -> [b] -> [(a, b)]
zip [0 :: Int ..] [Pat NodeInfo]
ps
]
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer ()
swing (String -> Printer ()
write " ->") (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 _ e :: 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 _ e :: Exp NodeInfo
e alts :: [Alt NodeInfo]
alts) =
do Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "case ")
(do Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e
String -> Printer ()
write " of")
if [Alt NodeInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Alt NodeInfo]
alts
then String -> Printer ()
write " {}"
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 _ stmts :: [Stmt NodeInfo]
stmts) =
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "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 _ stmts :: [Stmt NodeInfo]
stmts) =
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "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 _ e :: Exp NodeInfo
e op :: 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 _ e :: QOp NodeInfo
e op :: 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 _ e :: 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 " ..")
exp (EnumFromTo _ e :: Exp NodeInfo
e f :: 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 " .. ")
(Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
f))
exp (EnumFromThen _ e :: Exp NodeInfo
e t :: 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 ",")
(do Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
t
String -> Printer ()
write " .."))
exp (EnumFromThenTo _ e :: Exp NodeInfo
e t :: Exp NodeInfo
t f :: 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 ",")
(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 " .. ")
(Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
f)))
exp (ExpTypeSig _ e :: Exp NodeInfo
e t :: 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 " :: ")
(Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
t)
exp (VarQuote _ x :: QName NodeInfo
x) =
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "'")
(QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
x)
exp (TypQuote _ x :: QName NodeInfo
x) =
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "''")
(QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
x)
exp (BracketExp _ b :: Bracket NodeInfo
b) = Bracket NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Bracket NodeInfo
b
exp (SpliceExp _ s :: Splice NodeInfo
s) = Splice NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Splice NodeInfo
s
exp (QuasiQuote _ n :: String
n s :: String
s) = String -> Printer () -> Printer ()
quotation String
n (String -> Printer ()
string String
s)
exp (LCase _ alts :: [Alt NodeInfo]
alts) =
do String -> Printer ()
write "\\case"
if [Alt NodeInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Alt NodeInfo]
alts
then String -> Printer ()
write " {}"
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 _ alts :: [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 "if ")
([Printer ()] -> Printer ()
lined
((GuardedRhs NodeInfo -> Printer ())
-> [GuardedRhs NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map
(\p :: GuardedRhs NodeInfo
p -> do
String -> Printer ()
write "| "
GuardedRhs NodeInfo -> Printer ()
prettyG GuardedRhs NodeInfo
p)
[GuardedRhs NodeInfo]
alts)))
where
prettyG :: GuardedRhs NodeInfo -> Printer ()
prettyG (GuardedRhs _ stmts :: [Stmt NodeInfo]
stmts e :: Exp NodeInfo
e) = do
Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indented
1
(do ([Printer ()] -> Printer ()
lined (((Int, Stmt NodeInfo) -> Printer ())
-> [(Int, Stmt NodeInfo)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map
(\(i :: Int
i,p :: 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
== 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 ","))
([Int] -> [Stmt NodeInfo] -> [(Int, Stmt NodeInfo)]
forall a b. [a] -> [b] -> [(a, b)]
zip [1..] [Stmt NodeInfo]
stmts))))
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer ()
swing (String -> Printer ()
write " " 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 _ lit :: Literal NodeInfo
lit) = Literal NodeInfo -> Printer ()
forall (ast :: * -> *). Pretty ast => ast NodeInfo -> Printer ()
prettyInternal Literal NodeInfo
lit
exp (Var _ q :: QName NodeInfo
q) = QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
q
exp (IPVar _ q :: IPName NodeInfo
q) = IPName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty IPName NodeInfo
q
exp (Con _ q :: 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 _ label :: String
label) = String -> Printer ()
string ('#' 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 x :: QualStmt NodeInfo
x =
case QualStmt NodeInfo
x of
QualStmt _ s :: Stmt NodeInfo
s -> Stmt NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Stmt NodeInfo
s
ThenTrans _ s :: Exp NodeInfo
s -> do
String -> Printer ()
write "then "
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
s
ThenBy _ s :: Exp NodeInfo
s t :: Exp NodeInfo
t -> do
String -> Printer ()
write "then "
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
s
String -> Printer ()
write " by "
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
t
GroupBy _ s :: Exp NodeInfo
s -> do
String -> Printer ()
write "then group by "
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
s
GroupUsing _ s :: Exp NodeInfo
s -> do
String -> Printer ()
write "then group using "
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
s
GroupByUsing _ s :: Exp NodeInfo
s t :: Exp NodeInfo
t -> do
String -> Printer ()
write "then group by "
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
s
String -> Printer ()
write " 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 _ moverlap :: Maybe (Overlap NodeInfo)
moverlap dhead :: InstRule NodeInfo
dhead decls :: Maybe [InstDecl NodeInfo]
decls) =
do Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "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 " 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 _ e :: Exp NodeInfo
e) = Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e
decl (TypeSig _ names :: [Name NodeInfo]
names ty :: Type NodeInfo
ty) =
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (do Printer () -> [Printer ()] -> Printer ()
inter (String -> Printer ()
write ", ")
((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 " :: ")
(Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty)
decl (FunBind _ matches :: [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 _ ctx :: Maybe (Context NodeInfo)
ctx dhead :: DeclHead NodeInfo
dhead fundeps :: [FunDep NodeInfo]
fundeps decls :: 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 _ typehead :: DeclHead NodeInfo
typehead typ' :: Type NodeInfo
typ') = do
String -> Printer ()
write "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 " = ") (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 " = ") (Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
typ')))
decl (TypeFamDecl _ declhead :: DeclHead NodeInfo
declhead result :: Maybe (ResultSig NodeInfo)
result injectivity :: Maybe (InjectivityInfo NodeInfo)
injectivity) = do
String -> Printer ()
write "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 r :: ResultSig NodeInfo
r -> do
Printer ()
space
let sep :: String
sep = case ResultSig NodeInfo
r of
KindSig _ _ -> "::"
TyVarSig _ _ -> "="
String -> Printer ()
write String
sep
Printer ()
space
ResultSig NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ResultSig NodeInfo
r
Nothing -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
case Maybe (InjectivityInfo NodeInfo)
injectivity of
Just i :: InjectivityInfo NodeInfo
i -> do
Printer ()
space
InjectivityInfo NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty InjectivityInfo NodeInfo
i
Nothing -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
decl (ClosedTypeFamDecl _ declhead :: DeclHead NodeInfo
declhead result :: Maybe (ResultSig NodeInfo)
result injectivity :: Maybe (InjectivityInfo NodeInfo)
injectivity instances :: [TypeEqn NodeInfo]
instances) = do
String -> Printer ()
write "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
$ \r :: ResultSig NodeInfo
r -> do
Printer ()
space
let sep :: String
sep = case ResultSig NodeInfo
r of
KindSig _ _ -> "::"
TyVarSig _ _ -> "="
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
$ \i :: 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 "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 _ dataornew :: DataOrNew NodeInfo
dataornew ctx :: Maybe (Context NodeInfo)
ctx dhead :: DeclHead NodeInfo
dhead condecls :: [QualConDecl NodeInfo]
condecls mderivs :: [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 ()
[x :: QualConDecl NodeInfo
x] -> QualConDecl NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
singleCons QualConDecl NodeInfo
x
xs :: [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
$ \deriv :: 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 x :: ast NodeInfo
x =
do String -> Printer ()
write " ="
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 xs :: [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 -> [Printer ()] -> Printer ()
prefixedLined "|"
((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 _ dataornew :: DataOrNew NodeInfo
dataornew ctx :: Maybe (Context NodeInfo)
ctx dhead :: DeclHead NodeInfo
dhead mkind :: Maybe (Type NodeInfo)
mkind condecls :: [GadtDecl NodeInfo]
condecls mderivs :: [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
Nothing -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just kind :: Type NodeInfo
kind -> do String -> Printer ()
write " :: "
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
kind
String -> Printer ()
write " 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 ()
_ -> 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
$ \deriv :: 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 _ inline :: Bool
inline active :: Maybe (Activation NodeInfo)
active name :: QName NodeInfo
name) = do
String -> Printer ()
write "{-# "
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 "NO"
String -> Printer ()
write "INLINE "
case Maybe (Activation NodeInfo)
active of
Nothing -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just (ActiveFrom _ x :: Int
x) -> String -> Printer ()
write ("[" 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]
++ "] ")
Just (ActiveUntil _ x :: Int
x) -> String -> Printer ()
write ("[~" 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]
++ "] ")
QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
name
String -> Printer ()
write " #-}"
decl (MinimalPragma _ (Just formula :: BooleanFormula NodeInfo
formula)) =
String -> String -> Printer () -> Printer ()
forall a. String -> String -> Printer a -> Printer a
wrap "{-# " " #-}" (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 "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 _ callconv :: CallConv NodeInfo
callconv maybeSafety :: Maybe (Safety NodeInfo)
maybeSafety maybeName :: Maybe String
maybeName name :: Name NodeInfo
name ty :: Type NodeInfo
ty) = do
String -> Printer ()
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 :: 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
Nothing -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
case Maybe String
maybeName of
Just namestr :: 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
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 " :: "
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Type NodeInfo
ty
case Maybe PrintState
tyline of
Just line :: PrintState
line -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
line
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 ":: "
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Type NodeInfo
ty
decl (ForExp _ callconv :: CallConv NodeInfo
callconv maybeName :: Maybe String
maybeName name :: Name NodeInfo
name ty :: Type NodeInfo
ty) = do
String -> Printer ()
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 namestr :: 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
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 " :: "
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Type NodeInfo
ty
case Maybe PrintState
tyline of
Just line :: PrintState
line -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
line
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 ":: "
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Type NodeInfo
ty
decl x' :: 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 ctx :: Maybe (Context NodeInfo)
ctx dhead :: DeclHead NodeInfo
dhead fundeps :: [FunDep NodeInfo]
fundeps decls :: 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 "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 " | " 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 " where"))))
longHead :: Printer ()
longHead = do
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "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 -> [Printer ()] -> Printer ()
prefixedLined ", " ([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 "where")
instance Pretty TypeEqn where
prettyInternal :: TypeEqn NodeInfo -> Printer ()
prettyInternal (TypeEqn _ in_ :: Type NodeInfo
in_ out_ :: Type NodeInfo
out_) = do
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
in_
String -> Printer ()
write " = "
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 _ strategy :: Maybe (DerivStrategy NodeInfo)
strategy heads :: [InstRule NodeInfo]
heads) =
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "deriving" 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
$
case Maybe (DerivStrategy NodeInfo)
strategy of
Nothing -> Printer ()
printHeads
#if MIN_VERSION_haskell_src_exts(1,21,0)
Just st :: DerivStrategy NodeInfo
st@(DerivVia _ _) -> Printer ()
printHeads 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
>> DerivStrategy NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty DerivStrategy NodeInfo
st
#endif
Just st :: DerivStrategy NodeInfo
st -> Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (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) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Printer ()
printHeads
where
printHeads :: Printer ()
printHeads = 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
== 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
Nothing -> [InstRule NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
[ast NodeInfo] -> Printer ()
formatMultiLine [InstRule NodeInfo]
heads'
Just derives :: PrintState
derives -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
derives
stripParens :: InstRule l -> InstRule l
stripParens (IParen _ iRule :: InstRule l
iRule) = InstRule l -> InstRule l
stripParens InstRule l
iRule
stripParens x :: InstRule l
x = InstRule l
x
formatMultiLine :: [ast NodeInfo] -> Printer ()
formatMultiLine derives :: [ast NodeInfo]
derives = do
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "( ") (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ String -> [Printer ()] -> Printer ()
prefixedLined ", " ((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 ")"
instance Pretty DerivStrategy where
prettyInternal :: DerivStrategy NodeInfo -> Printer ()
prettyInternal x :: DerivStrategy NodeInfo
x =
case DerivStrategy NodeInfo
x of
DerivStock _ -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
DerivAnyclass _ -> String -> Printer ()
write "anyclass"
DerivNewtype _ -> String -> Printer ()
write "newtype"
#if MIN_VERSION_haskell_src_exts(1,21,0)
DerivVia _ t :: Type NodeInfo
t -> Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "via" 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
$ Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
t
#endif
instance Pretty Alt where
prettyInternal :: Alt NodeInfo -> Printer ()
prettyInternal x :: Alt NodeInfo
x =
case Alt NodeInfo
x of
Alt _ p :: Pat NodeInfo
p galts :: Rhs NodeInfo
galts mbinds :: 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
Nothing -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just binds :: 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 "where ")
(Binds NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Binds NodeInfo
binds))
#if MIN_VERSION_haskell_src_exts(1,22,0)
instance Pretty Asst where
prettyInternal :: Asst NodeInfo -> Printer ()
prettyInternal x :: Asst NodeInfo
x =
case Asst NodeInfo
x of
ParenA _ asst :: Asst NodeInfo
asst -> Printer () -> Printer ()
forall a. Printer a -> Printer a
parens (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Asst NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Asst NodeInfo
asst
IParam _ name :: IPName NodeInfo
name ty :: Type NodeInfo
ty -> IPName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty IPName NodeInfo
name Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Printer ()
write " :: " 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
ty
TypeA _ ty :: Type NodeInfo
ty -> Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty
#else
instance Pretty Asst where
prettyInternal x =
case x of
ClassA _ name types -> spaced (pretty name : map pretty types)
i@InfixA {} -> pretty' i
IParam _ name ty -> do
pretty name
write " :: "
pretty ty
EqualP _ a b -> do
pretty a
write " ~ "
pretty b
ParenA _ asst -> parens (pretty asst)
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 x :: BangType NodeInfo
x =
case BangType NodeInfo
x of
BangedTy _ -> String -> Printer ()
write "!"
LazyTy _ -> String -> Printer ()
write "~"
NoStrictAnnot _ -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
instance Pretty Unpackedness where
prettyInternal :: Unpackedness NodeInfo -> Printer ()
prettyInternal (Unpack _) = String -> Printer ()
write "{-# UNPACK #-}"
prettyInternal (NoUnpack _) = String -> Printer ()
write "{-# NOUNPACK #-}"
prettyInternal (NoUnpackPragma _) = () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
instance Pretty Binds where
prettyInternal :: Binds NodeInfo -> Printer ()
prettyInternal x :: Binds NodeInfo
x =
case Binds NodeInfo
x of
BDecls _ ds :: [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 _ i :: [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 x :: ClassDecl NodeInfo
x =
case ClassDecl NodeInfo
x of
ClsDecl _ d :: Decl NodeInfo
d -> Decl NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Decl NodeInfo
d
ClsDataFam _ ctx :: Maybe (Context NodeInfo)
ctx h :: DeclHead NodeInfo
h mkind :: Maybe (ResultSig NodeInfo)
mkind ->
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend
(String -> Printer ()
write "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
Nothing -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just kind :: ResultSig NodeInfo
kind -> do
String -> Printer ()
write " :: "
ResultSig NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ResultSig NodeInfo
kind)))
ClsTyFam _ h :: DeclHead NodeInfo
h msig :: Maybe (ResultSig NodeInfo)
msig minj :: Maybe (InjectivityInfo NodeInfo)
minj ->
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend
(String -> Printer ()
write "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 _ kind :: Type NodeInfo
kind -> String -> Printer ()
write " :: " 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 _ tyVarBind :: TyVarBind NodeInfo
tyVarBind -> String -> Printer ()
write " = " 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_ (\inj :: 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 _ (TypeEqn _ this :: Type NodeInfo
this that :: Type NodeInfo
that) -> do
String -> Printer ()
write "type "
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
this
String -> Printer ()
write " = "
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
that
ClsDefSig _ name :: Name NodeInfo
name ty :: Type NodeInfo
ty -> do
String -> Printer ()
write "default "
Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Name NodeInfo
name
String -> Printer ()
write " :: "
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 x :: ConDecl NodeInfo
x =
ConDecl NodeInfo -> Printer ()
conDecl ConDecl NodeInfo
x
instance Pretty FieldDecl where
prettyInternal :: FieldDecl NodeInfo -> Printer ()
prettyInternal (FieldDecl _ names :: [Name NodeInfo]
names ty :: 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 " :: ")
(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 x :: FieldUpdate NodeInfo
x =
case FieldUpdate NodeInfo
x of
FieldUpdate _ n :: QName NodeInfo
n e :: 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 " =")
(Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e)
FieldPun _ n :: QName NodeInfo
n -> QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
n
FieldWildcard _ -> String -> Printer ()
write ".."
instance Pretty GuardedRhs where
prettyInternal :: GuardedRhs NodeInfo -> Printer ()
prettyInternal =
GuardedRhs NodeInfo -> Printer ()
guardedRhs
instance Pretty InjectivityInfo where
prettyInternal :: InjectivityInfo NodeInfo -> Printer ()
prettyInternal x :: 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 i :: InstDecl NodeInfo
i =
case InstDecl NodeInfo
i of
InsDecl _ d :: Decl NodeInfo
d -> Decl NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Decl NodeInfo
d
InsType _ name :: Type NodeInfo
name ty :: Type NodeInfo
ty ->
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (do String -> Printer ()
write "type "
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
name
String -> Printer ()
write " = ")
(Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty)
_ -> 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 x :: PatField NodeInfo
x =
case PatField NodeInfo
x of
PFieldPat _ n :: QName NodeInfo
n p :: 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 " = ")
(Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
p)
PFieldPun _ n :: QName NodeInfo
n -> QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
n
PFieldWildcard _ -> String -> Printer ()
write ".."
instance Pretty QualConDecl where
prettyInternal :: QualConDecl NodeInfo -> Printer ()
prettyInternal x :: QualConDecl NodeInfo
x =
case QualConDecl NodeInfo
x of
QualConDecl _ tyvars :: Maybe [TyVarBind NodeInfo]
tyvars ctx :: Maybe (Context NodeInfo)
ctx d :: 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 "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 ". "))
(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 _ name :: Name NodeInfo
name _ _ fields :: Maybe [FieldDecl NodeInfo]
fields t :: 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' p :: 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 ()
fs :: [FieldDecl NodeInfo]
fs -> do
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "{") (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
String -> [Printer ()] -> Printer ()
prefixedLined "," ((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 "}"
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 " :: ") (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
Printer () -> Printer ()
fields' (String -> Printer ()
write " -> ")
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 ":: ") (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 (-3) (String -> Printer ()
write "-> ")
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 x :: Splice NodeInfo
x =
case Splice NodeInfo
x of
IdSplice _ str :: String
str ->
do String -> Printer ()
write "$"
String -> Printer ()
string String
str
#if MIN_VERSION_haskell_src_exts(1,22,0)
TIdSplice _ str :: String
str ->
do String -> Printer ()
write "$$"
String -> Printer ()
string String
str
#endif
ParenSplice _ e :: Exp NodeInfo
e ->
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "$")
(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))
#if MIN_VERSION_haskell_src_exts(1,22,0)
TParenSplice _ e :: Exp NodeInfo
e ->
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "$$")
(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))
#endif
instance Pretty InstRule where
prettyInternal :: InstRule NodeInfo -> Printer ()
prettyInternal (IParen _ rule :: 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 _ mvarbinds :: Maybe [TyVarBind NodeInfo]
mvarbinds mctx :: Maybe (Context NodeInfo)
mctx ihead :: InstHead NodeInfo
ihead) =
do case Maybe [TyVarBind NodeInfo]
mvarbinds of
Nothing -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just xs :: [TyVarBind NodeInfo]
xs -> do String -> Printer ()
write "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 ". "
case Maybe (Context NodeInfo)
mctx of
Nothing -> InstHead NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty InstHead NodeInfo
ihead
Just ctx :: 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 " => "
InstHead NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty InstHead NodeInfo
ihead
String -> Printer ()
write " where")
case Maybe PrintState
mst of
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 " => "
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 x :: InstHead NodeInfo
x =
case InstHead NodeInfo
x of
IHCon _ name :: QName NodeInfo
name -> QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
name
IHInfix _ typ' :: Type NodeInfo
typ' name :: 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 _ ihead :: InstHead NodeInfo
ihead typ' :: 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 _ h :: 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 x :: DeclHead NodeInfo
x =
case DeclHead NodeInfo
x of
DHead _ name :: Name NodeInfo
name -> Name NodeInfo -> Printer ()
prettyQuoteName Name NodeInfo
name
DHParen _ h :: 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 _ var :: TyVarBind NodeInfo
var name :: 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 _ dhead :: DeclHead NodeInfo
dhead var :: 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 _) = String -> Printer ()
write "{-# OVERLAP #-}"
prettyInternal (Overlapping _) = String -> Printer ()
write "{-# OVERLAPPING #-}"
prettyInternal (Overlaps _) = String -> Printer ()
write "{-# OVERLAPS #-}"
prettyInternal (Overlappable _) = String -> Printer ()
write "{-# OVERLAPPABLE #-}"
prettyInternal (NoOverlap _) = String -> Printer ()
write "{-# NO_OVERLAP #-}"
prettyInternal (Incoherent _) = String -> Printer ()
write "{-# INCOHERENT #-}"
instance Pretty Sign where
prettyInternal :: Sign NodeInfo -> Printer ()
prettyInternal (Signless _) = () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
prettyInternal (Negative _) = String -> Printer ()
write "-"
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 x :: Module NodeInfo
x =
case Module NodeInfo
x of
Module _ mayModHead :: Maybe (ModuleHead NodeInfo)
mayModHead pragmas :: [ModulePragma NodeInfo]
pragmas imps :: [ImportDecl NodeInfo]
imps decls :: [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 (\(isNull :: Bool
isNull,r :: 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
Nothing -> (Bool
True,() -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
Just modHead :: 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{} -> (1,Decl NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Decl NodeInfo
r)
r :: Decl NodeInfo
r@InlineSig{} -> (1, Decl NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Decl NodeInfo
r)
r :: Decl NodeInfo
r -> (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 i :: m a
i ((c :: Int
c,p :: m ()
p):ps :: [(Int, m ())]
ps) =
case [(Int, m ())]
ps of
[] -> m ()
p
_ ->
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 ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
XmlPage{} -> String -> Printer ()
forall a. HasCallStack => String -> a
error "FIXME: No implementation for XmlPage."
XmlHybrid{} -> String -> Printer ()
forall a. HasCallStack => String -> a
error "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 import1 :: ast NodeInfo
import1 import2 :: 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
<= 1
formatImportGroup :: [ImportDecl NodeInfo] -> Printer ()
formatImportGroup imps :: [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 idecl :: ImportDecl l
idecl =
let ModuleName _ name :: 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 imps :: [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 imp :: 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
l hiding :: Bool
hiding specs :: [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 l2 :: l
l2 name :: Name l
name cNames :: [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 is :: ImportSpec l
is = ImportSpec l
is
groupAdjacentBy :: (a -> a -> Bool) -> [a] -> [[a]]
groupAdjacentBy :: (a -> a -> Bool) -> [a] -> [[a]]
groupAdjacentBy _ [] = []
groupAdjacentBy adj :: a -> a -> Bool
adj items :: [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
(xs :: [a]
xs, rest :: [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 _ [] = ([], [])
spanAdjacentBy _ [x :: a
x] = ([a
x], [])
spanAdjacentBy adj :: a -> a -> Bool
adj (x :: a
x:xs :: [a]
xs@(y :: a
y:_))
| a -> a -> Bool
adj a
x a
y =
let (xs' :: [a]
xs', rest' :: [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 _ _ (Ident _ s1 :: String
s1)) (IAbs _ _ (Ident _ s2 :: String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IAbs _ _ (Ident _ _)) (IAbs _ _ (Symbol _ _)) = Ordering
GT
importSpecCompare (IAbs _ _ (Ident _ s1 :: String
s1)) (IThingAll _ (Ident _ s2 :: String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IAbs _ _ (Ident _ _)) (IThingAll _ (Symbol _ _)) = Ordering
GT
importSpecCompare (IAbs _ _ (Ident _ s1 :: String
s1)) (IThingWith _ (Ident _ s2 :: String
s2) _) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IAbs _ _ (Ident _ _)) (IThingWith _ (Symbol _ _) _) = Ordering
GT
importSpecCompare (IAbs _ _ (Symbol _ _)) (IAbs _ _ (Ident _ _)) = Ordering
LT
importSpecCompare (IAbs _ _ (Symbol _ s1 :: String
s1)) (IAbs _ _ (Symbol _ s2 :: String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IAbs _ _ (Symbol _ _)) (IThingAll _ (Ident _ _)) = Ordering
LT
importSpecCompare (IAbs _ _ (Symbol _ s1 :: String
s1)) (IThingAll _ (Symbol _ s2 :: String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IAbs _ _ (Symbol _ _)) (IThingWith _ (Ident _ _) _) = Ordering
LT
importSpecCompare (IAbs _ _ (Symbol _ s1 :: String
s1)) (IThingWith _ (Symbol _ s2 :: String
s2) _) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IAbs _ _ _) (IVar _ _) = Ordering
LT
importSpecCompare (IThingAll _ (Ident _ s1 :: String
s1)) (IAbs _ _ (Ident _ s2 :: String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IThingAll _ (Ident _ _)) (IAbs _ _ (Symbol _ _)) = Ordering
GT
importSpecCompare (IThingAll _ (Ident _ s1 :: String
s1)) (IThingAll _ (Ident _ s2 :: String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IThingAll _ (Ident _ _)) (IThingAll _ (Symbol _ _)) = Ordering
GT
importSpecCompare (IThingAll _ (Ident _ s1 :: String
s1)) (IThingWith _ (Ident _ s2 :: String
s2) _) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IThingAll _ (Ident _ _)) (IThingWith _ (Symbol _ _) _) = Ordering
GT
importSpecCompare (IThingAll _ (Symbol _ _)) (IAbs _ _ (Ident _ _)) = Ordering
LT
importSpecCompare (IThingAll _ (Symbol _ s1 :: String
s1)) (IAbs _ _ (Symbol _ s2 :: String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IThingAll _ (Symbol _ _)) (IThingAll _ (Ident _ _)) = Ordering
LT
importSpecCompare (IThingAll _ (Symbol _ s1 :: String
s1)) (IThingAll _ (Symbol _ s2 :: String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IThingAll _ (Symbol _ _)) (IThingWith _ (Ident _ _) _) = Ordering
LT
importSpecCompare (IThingAll _ (Symbol _ s1 :: String
s1)) (IThingWith _ (Symbol _ s2 :: String
s2) _) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IThingAll _ _) (IVar _ _) = Ordering
LT
importSpecCompare (IThingWith _ (Ident _ s1 :: String
s1) _) (IAbs _ _ (Ident _ s2 :: String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IThingWith _ (Ident _ _) _) (IAbs _ _ (Symbol _ _)) = Ordering
GT
importSpecCompare (IThingWith _ (Ident _ s1 :: String
s1) _) (IThingAll _ (Ident _ s2 :: String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IThingWith _ (Ident _ _) _) (IThingAll _ (Symbol _ _)) = Ordering
GT
importSpecCompare (IThingWith _ (Ident _ s1 :: String
s1) _) (IThingWith _ (Ident _ s2 :: String
s2) _) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IThingWith _ (Ident _ _) _) (IThingWith _ (Symbol _ _) _) = Ordering
GT
importSpecCompare (IThingWith _ (Symbol _ _) _) (IAbs _ _ (Ident _ _)) = Ordering
LT
importSpecCompare (IThingWith _ (Symbol _ s1 :: String
s1) _) (IAbs _ _ (Symbol _ s2 :: String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IThingWith _ (Symbol _ _) _) (IThingAll _ (Ident _ _)) = Ordering
LT
importSpecCompare (IThingWith _ (Symbol _ s1 :: String
s1) _) (IThingAll _ (Symbol _ s2 :: String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IThingWith _ (Symbol _ _) _) (IThingWith _ (Ident _ _) _) = Ordering
LT
importSpecCompare (IThingWith _ (Symbol _ s1 :: String
s1) _) (IThingWith _ (Symbol _ s2 :: String
s2) _) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IThingWith _ _ _) (IVar _ _) = Ordering
LT
importSpecCompare (IVar _ (Ident _ s1 :: String
s1)) (IVar _ (Ident _ s2 :: String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IVar _ (Ident _ _)) (IVar _ (Symbol _ _)) = Ordering
GT
importSpecCompare (IVar _ (Symbol _ _)) (IVar _ (Ident _ _)) = Ordering
LT
importSpecCompare (IVar _ (Symbol _ s1 :: String
s1)) (IVar _ (Symbol _ s2 :: String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IVar _ _) _ = Ordering
GT
cNameCompare :: CName l -> CName l -> Ordering
cNameCompare :: CName l -> CName l -> Ordering
cNameCompare (VarName _ (Ident _ s1 :: String
s1)) (VarName _ (Ident _ s2 :: String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
cNameCompare (VarName _ (Ident _ _)) (VarName _ (Symbol _ _)) = Ordering
GT
cNameCompare (VarName _ (Ident _ s1 :: String
s1)) (ConName _ (Ident _ s2 :: String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
cNameCompare (VarName _ (Ident _ _)) (ConName _ (Symbol _ _)) = Ordering
GT
cNameCompare (VarName _ (Symbol _ _)) (VarName _ (Ident _ _)) = Ordering
LT
cNameCompare (VarName _ (Symbol _ s1 :: String
s1)) (VarName _ (Symbol _ s2 :: String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
cNameCompare (VarName _ (Symbol _ _)) (ConName _ (Ident _ _)) = Ordering
LT
cNameCompare (VarName _ (Symbol _ s1 :: String
s1)) (ConName _ (Symbol _ s2 :: String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
cNameCompare (ConName _ (Ident _ s1 :: String
s1)) (VarName _ (Ident _ s2 :: String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
cNameCompare (ConName _ (Ident _ _)) (VarName _ (Symbol _ _)) = Ordering
GT
cNameCompare (ConName _ (Ident _ s1 :: String
s1)) (ConName _ (Ident _ s2 :: String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
cNameCompare (ConName _ (Ident _ _)) (ConName _ (Symbol _ _)) = Ordering
GT
cNameCompare (ConName _ (Symbol _ _)) (VarName _ (Ident _ _)) = Ordering
LT
cNameCompare (ConName _ (Symbol _ s1 :: String
s1)) (VarName _ (Symbol _ s2 :: String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
cNameCompare (ConName _ (Symbol _ _)) (ConName _ (Ident _ _)) = Ordering
LT
cNameCompare (ConName _ (Symbol _ s1 :: String
s1)) (ConName _ (Symbol _ s2 :: 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 x :: Bracket NodeInfo
x =
case Bracket NodeInfo
x of
ExpBracket _ p :: Exp NodeInfo
p -> String -> Printer () -> Printer ()
quotation "" (Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
p)
#if MIN_VERSION_haskell_src_exts(1,22,0)
TExpBracket _ p :: Exp NodeInfo
p ->
Printer () -> Printer ()
forall a. Printer a -> Printer a
brackets
(Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend
(String -> Printer ()
write "||")
(do Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
p
String -> Printer ()
write "||"))
#endif
PatBracket _ p :: Pat NodeInfo
p -> String -> Printer () -> Printer ()
quotation "p" (Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
p)
TypeBracket _ ty :: Type NodeInfo
ty -> String -> Printer () -> Printer ()
quotation "t" (Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty)
d :: Bracket NodeInfo
d@(DeclBracket _ _) -> 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 x :: IPBind NodeInfo
x =
case IPBind NodeInfo
x of
IPBind _ name :: IPName NodeInfo
name expr :: 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 "="
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 _ i :: Name NodeInfo
i@(Ident _ _)) = Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Name NodeInfo
i
prettyInternal (VarFormula _ (Symbol _ s :: String
s)) = String -> Printer ()
write "(" 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 ")"
prettyInternal (AndFormula _ fs :: [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 ", ") ([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
Nothing -> String -> [Printer ()] -> Printer ()
prefixedLined ", " ((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 formulas :: PrintState
formulas -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
formulas
prettyInternal (OrFormula _ fs :: [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 " | ") ([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
Nothing -> String -> [Printer ()] -> Printer ()
prefixedLined "| " ((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 formulas :: PrintState
formulas -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
formulas
prettyInternal (ParenFormula _ f :: 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 _ kind :: Type NodeInfo
kind) = Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
kind
prettyInternal (TyVarSig _ tyVarBind :: 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 _ _ rep :: String
rep) = do
String -> Printer ()
write "\""
String -> Printer ()
string String
rep
String -> Printer ()
write "\""
prettyInternal (Char _ _ rep :: String
rep) = do
String -> Printer ()
write "'"
String -> Printer ()
string String
rep
String -> Printer ()
write "'"
prettyInternal (PrimString _ _ rep :: String
rep) = do
String -> Printer ()
write "\""
String -> Printer ()
string String
rep
String -> Printer ()
write "\"#"
prettyInternal (PrimChar _ _ rep :: String
rep) = do
String -> Printer ()
write "'"
String -> Printer ()
string String
rep
String -> Printer ()
write "'#"
prettyInternal (Int _l :: NodeInfo
_l _i :: Integer
_i originalString :: String
originalString) =
String -> Printer ()
string String
originalString
prettyInternal (Frac _l :: NodeInfo
_l _r :: Rational
_r originalString :: String
originalString) =
String -> Printer ()
string String
originalString
prettyInternal x :: 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 x :: Name NodeInfo
x = case Name NodeInfo
x of
Ident _ _ -> Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Name NodeInfo
x
Symbol _ s :: String
s -> String -> Printer ()
string String
s
instance Pretty QName where
prettyInternal :: QName NodeInfo -> Printer ()
prettyInternal =
\case
Qual _ mn :: ModuleName NodeInfo
mn n :: Name NodeInfo
n ->
case Name NodeInfo
n of
Ident _ i :: String
i -> do ModuleName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ModuleName NodeInfo
mn; String -> Printer ()
write "."; String -> Printer ()
string String
i;
Symbol _ s :: String
s -> do String -> Printer ()
write "("; ModuleName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ModuleName NodeInfo
mn; String -> Printer ()
write "."; String -> Printer ()
string String
s; String -> Printer ()
write ")";
UnQual _ n :: Name NodeInfo
n ->
case Name NodeInfo
n of
Ident _ i :: String
i -> String -> Printer ()
string String
i
Symbol _ s :: String
s -> do String -> Printer ()
write "("; String -> Printer ()
string String
s; String -> Printer ()
write ")";
Special _ 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 _ 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 _ s :: 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 s :: SpecialCon NodeInfo
s =
case SpecialCon NodeInfo
s of
UnitCon _ -> String -> Printer ()
write "()"
ListCon _ -> String -> Printer ()
write "[]"
FunCon _ -> String -> Printer ()
write "->"
TupleCon _ Boxed i :: Int
i ->
String -> Printer ()
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
- 1) ',' String -> String -> String
forall a. [a] -> [a] -> [a]
++
")")
TupleCon _ Unboxed i :: Int
i ->
String -> Printer ()
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
- 1) ',' String -> String -> String
forall a. [a] -> [a] -> [a]
++
" #)")
Cons _ -> String -> Printer ()
write ":"
UnboxedSingleCon _ -> String -> Printer ()
write "(##)"
ExprHole _ -> String -> Printer ()
write "_"
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 _ name :: ModuleName NodeInfo
name mwarnings :: Maybe (WarningText NodeInfo)
mwarnings mexports :: Maybe (ExportSpecList NodeInfo)
mexports) =
do String -> Printer ()
write "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 ())
(\exports :: 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 " 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 _ name :: ModuleName NodeInfo
name qualified :: Bool
qualified source :: Bool
source safe :: Bool
safe mpkg :: Maybe String
mpkg mas :: Maybe (ModuleName NodeInfo)
mas mspec :: Maybe (ImportSpecList NodeInfo)
mspec) = do
String -> Printer ()
write "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 " {-# 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 " 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 " qualified"
case Maybe String
mpkg of
Nothing -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just pkg :: 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
forall a. [a] -> [a] -> [a]
++ String
pkg String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\"")
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
Nothing -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just asName :: ModuleName NodeInfo
asName -> do
Printer ()
space
String -> Printer ()
write "as "
ModuleName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ModuleName NodeInfo
asName
case Maybe (ImportSpecList NodeInfo)
mspec of
Nothing -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just spec :: 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 _ name :: String
name) =
String -> Printer ()
write String
name
instance Pretty ImportSpecList where
prettyInternal :: ImportSpecList NodeInfo -> Printer ()
prettyInternal (ImportSpecList _ hiding :: Bool
hiding spec :: [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 " 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 -> [Printer ()] -> Printer ()
prefixedLined ", " ((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 ")")
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 _ s :: String
s) =
String -> Printer ()
write "{-# 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 " #-}"
prettyInternal (WarnText _ s :: String
s) =
String -> Printer ()
write "{-# 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 " #-}"
instance Pretty ExportSpecList where
prettyInternal :: ExportSpecList NodeInfo -> Printer ()
prettyInternal (ExportSpecList _ es :: [ExportSpec NodeInfo]
es) = do
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "(")
(String -> [Printer ()] -> Printer ()
prefixedLined "," ((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 ")"
instance Pretty ExportSpec where
prettyInternal :: ExportSpec NodeInfo -> Printer ()
prettyInternal x :: ExportSpec NodeInfo
x = String -> Printer ()
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 _ e :: Exp NodeInfo
e@(InfixApp _ a :: Exp NodeInfo
a op :: QOp NodeInfo
op b :: 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 ""))
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 _ p :: Pat NodeInfo
p e :: 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 " <-")
Printer ()
space
Exp NodeInfo
e
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty)
stmt x :: Stmt NodeInfo
x = case Stmt NodeInfo
x of
Generator _ p :: Pat NodeInfo
p e :: 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 " <- ")
(Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e)
Qualifier _ e :: Exp NodeInfo
e -> Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e
LetStmt _ binds :: Binds NodeInfo
binds ->
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "let ")
(Binds NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Binds NodeInfo
binds)
RecStmt _ es :: [Stmt NodeInfo]
es ->
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "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 left :: Printer ()
left prefix :: Printer ()
prefix right :: Exp NodeInfo
right f :: 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
Nothing -> do Printer ()
left
Printer ()
newline
(Exp NodeInfo -> Printer ()
f Exp NodeInfo
right)
Just st :: 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 _ (Do _ dos :: [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 " -> " else " = ")
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 2 Int64
indentSpaces
Int64 -> Printer () -> Printer () -> Printer ()
forall b. Int64 -> Printer () -> Printer b -> Printer b
swingBy Int64
indentation
(String -> Printer ()
write "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 _ e :: Exp NodeInfo
e) = do
Maybe PrintState
msg <-
Printer () -> Printer (Maybe PrintState)
forall a. Printer a -> Printer (Maybe PrintState)
fitsOnOneLine
(do String -> Printer ()
write " "
Printer ()
rhsSeparator
String -> Printer ()
write " "
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e)
case Maybe PrintState
msg of
Nothing -> Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer ()
swing (String -> Printer ()
write " " 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 st :: PrintState
st -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st
rhs (GuardedRhss _ gas :: [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 (\p :: GuardedRhs NodeInfo
p ->
do String -> Printer ()
write "|"
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 _ stmts :: [Stmt NodeInfo]
stmts (Do _ dos :: [Stmt NodeInfo]
dos)) =
do Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indented 1
(do String -> [Printer ()] -> Printer ()
prefixedLined
","
((Stmt NodeInfo -> Printer ()) -> [Stmt NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map (\p :: 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 " -> " else " = ")
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer ()
swing (String -> Printer ()
write "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 _ stmts :: [Stmt NodeInfo]
stmts e :: 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 st :: 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 " "
Printer ()
rhsSeparator
String -> Printer ()
write " "
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e)
case Maybe PrintState
mst' of
Just st' :: PrintState
st' -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st'
Nothing -> Printer ()
swingIt
Nothing -> do
Printer ()
printStmts
Printer ()
swingIt
where
printStmts :: Printer ()
printStmts =
Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indented
1
(do String -> [Printer ()] -> Printer ()
prefixedLined
","
((Stmt NodeInfo -> Printer ()) -> [Stmt NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map
(\p :: 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 " " 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 _ name :: Name NodeInfo
name pats :: [Pat NodeInfo]
pats rhs' :: Rhs NodeInfo
rhs' mbinds :: Maybe (Binds NodeInfo)
mbinds) =
do Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (do case Name NodeInfo
name of
Ident _ _ ->
Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Name NodeInfo
name
Symbol _ _ ->
do String -> Printer ()
write "("
Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Name NodeInfo
name
String -> Printer ()
write ")"
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 _ pat1 :: Pat NodeInfo
pat1 name :: Name NodeInfo
name pats :: [Pat NodeInfo]
pats rhs' :: Rhs NodeInfo
rhs' mbinds :: 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 ctx :: Context NodeInfo
ctx =
case Context NodeInfo
ctx of
CxSingle _ a :: Asst NodeInfo
a -> Asst NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Asst NodeInfo
a
CxTuple _ as :: [Asst NodeInfo]
as -> do
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "( ") (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ String -> [Printer ()] -> Printer ()
prefixedLined ", " ((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 ")"
CxEmpty _ -> 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 _ Boxed types :: [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 ", ") ((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 "," ((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 _ Unboxed types :: [Type NodeInfo]
types) = do
let horVar :: Printer ()
horVar = String -> String -> Printer () -> Printer ()
forall a. String -> String -> Printer a -> Printer a
wrap "(# " " #)" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Printer () -> [Printer ()] -> Printer ()
inter (String -> Printer ()
write ", ") ((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 "(#" " #)" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ String -> [Printer ()] -> Printer ()
prefixedLined "," ((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 _ mbinds :: Maybe [TyVarBind NodeInfo]
mbinds ctx :: Maybe (Context NodeInfo)
ctx ty :: Type NodeInfo
ty) =
Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (case Maybe [TyVarBind NodeInfo]
mbinds of
Nothing -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just ts :: [TyVarBind NodeInfo]
ts ->
do String -> Printer ()
write "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 ". ")
(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 _ a :: Type NodeInfo
a b :: 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 " -> ")
(Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
b)
typ (TyList _ t :: 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 _ t :: Type NodeInfo
t) =
Printer () -> Printer ()
forall a. Printer a -> Printer a
brackets (do String -> Printer ()
write ":"
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
t
String -> Printer ()
write ":")
typ (TyApp _ f :: Type NodeInfo
f a :: 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 _ n :: Name NodeInfo
n) = Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Name NodeInfo
n
typ (TyCon _ p :: QName NodeInfo
p) = QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
p
typ (TyParen _ e :: 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 _ a :: Type NodeInfo
a promotedop :: MaybePromotedName NodeInfo
promotedop b :: Type NodeInfo
b) = do
let isLineBreak' :: MaybePromotedName NodeInfo -> Printer Bool
isLineBreak' op :: MaybePromotedName NodeInfo
op =
case MaybePromotedName NodeInfo
op of
PromotedName _ op' :: QName NodeInfo
op' -> QName NodeInfo -> Printer Bool
isLineBreak QName NodeInfo
op'
UnpromotedName _ op' :: QName NodeInfo
op' -> QName NodeInfo -> Printer Bool
isLineBreak QName NodeInfo
op'
prettyInfixOp' :: MaybePromotedName NodeInfo -> Printer ()
prettyInfixOp' op :: MaybePromotedName NodeInfo
op =
case MaybePromotedName NodeInfo
op of
PromotedName _ op' :: QName NodeInfo
op' -> String -> Printer ()
write "'" Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> QName NodeInfo -> Printer ()
prettyInfixOp QName NodeInfo
op'
UnpromotedName _ op' :: 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 _ ty :: Type NodeInfo
ty k :: 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 " :: "
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
k)
typ (TyBang _ bangty :: BangType NodeInfo
bangty unpackty :: Unpackedness NodeInfo
unpackty right :: 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 _ left :: Type NodeInfo
left right :: Type NodeInfo
right) =
do Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
left
String -> Printer ()
write " ~ "
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
right
typ (TyPromoted _ (PromotedList _ _ ts :: [Type NodeInfo]
ts)) =
do String -> Printer ()
write "'["
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 " "
[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 "]"
typ (TyPromoted _ (PromotedTuple _ ts :: [Type NodeInfo]
ts)) =
do String -> Printer ()
write "'("
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 " "
[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 ")"
typ (TyPromoted _ (PromotedCon _ _ tname :: QName NodeInfo
tname)) =
do String -> Printer ()
write "'"
QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
tname
typ (TyPromoted _ (PromotedString _ _ raw :: String
raw)) = do
do String -> Printer ()
write "\""
String -> Printer ()
string String
raw
String -> Printer ()
write "\""
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 _ splice :: Splice NodeInfo
splice) = Splice NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Splice NodeInfo
splice
typ (TyWildCard _ name :: Maybe (Name NodeInfo)
name) =
case Maybe (Name NodeInfo)
name of
Nothing -> String -> Printer ()
write "_"
Just n :: Name NodeInfo
n ->
do String -> Printer ()
write "_"
Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Name NodeInfo
n
typ (TyQuasiQuote _ n :: String
n s :: String
s) = String -> Printer () -> Printer ()
quotation String
n (String -> Printer ()
string String
s)
#if MIN_VERSION_haskell_src_exts(1,20,0)
typ (TyUnboxedSum _ types :: [Type NodeInfo]
types) = do
let horVar :: Printer ()
horVar = String -> String -> Printer () -> Printer ()
forall a. String -> String -> Printer a -> Printer a
wrap "(# " " #)" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Printer () -> [Printer ()] -> Printer ()
inter (String -> Printer ()
write " | ") ((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 "(# " " #)" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ String -> [Printer ()] -> Printer ()
prefixedLined "|" ((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
#endif
#if MIN_VERSION_haskell_src_exts(1,21,0)
typ (TyStar _) = String -> Printer ()
write "*"
#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 _ names :: [Name NodeInfo]
names ty' :: 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 " :: ")
(Type NodeInfo -> Printer ()
declTy Type NodeInfo
ty'))
case Maybe PrintState
mst of
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 " ::"
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 " ") (Type NodeInfo -> Printer ()
declTy Type NodeInfo
ty'))
else (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write " :: ") (Type NodeInfo -> Printer ()
declTy Type NodeInfo
ty'))
Just st :: PrintState
st -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st
where
nameLength :: Name l -> Int
nameLength (Ident _ s :: String
s) = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s
nameLength (Symbol _ s :: 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
+ 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
+ 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
- 1)
decl' (PatBind _ pat :: Pat NodeInfo
pat rhs' :: Rhs NodeInfo
rhs' mbinds :: 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' e :: Decl NodeInfo
e = Decl NodeInfo -> Printer ()
decl Decl NodeInfo
e
declTy :: Type NodeInfo -> Printer ()
declTy :: Type NodeInfo -> Printer ()
declTy dty :: Type NodeInfo
dty =
case Type NodeInfo
dty of
TyForall _ mbinds :: Maybe [TyVarBind NodeInfo]
mbinds mctx :: Maybe (Context NodeInfo)
mctx ty :: Type NodeInfo
ty ->
case Maybe [TyVarBind NodeInfo]
mbinds of
Nothing -> do
case Maybe (Context NodeInfo)
mctx of
Nothing -> Bool -> Type NodeInfo -> Printer ()
prettyTy Bool
False Type NodeInfo
ty
Just ctx :: 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 " => ") (Bool -> Type NodeInfo -> Printer ()
prettyTy Bool
False Type NodeInfo
ty))
case Maybe PrintState
mst of
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 (-3) (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "=> ") (Bool -> Type NodeInfo -> Printer ()
prettyTy Bool
True Type NodeInfo
ty))
Just st :: PrintState
st -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st
Just ts :: [TyVarBind NodeInfo]
ts -> do
String -> Printer ()
write "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 "."
case Maybe (Context NodeInfo)
mctx of
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
Nothing -> do
Printer ()
newline
Bool -> Type NodeInfo -> Printer ()
prettyTy Bool
True Type NodeInfo
ty
Just st :: PrintState
st -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st
Just ctx :: 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
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 (-3) (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "=> ") (Bool -> Type NodeInfo -> Printer ()
prettyTy Bool
True Type NodeInfo
ty))
Just st :: 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 (-3) (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "=> ") (Bool -> Type NodeInfo -> Printer ()
prettyTy Bool
True Type NodeInfo
ty))
_ -> Bool -> Type NodeInfo -> Printer ()
prettyTy Bool
False Type NodeInfo
dty
where
collapseFaps :: Type l -> [Type l]
collapseFaps (TyFun _ arg :: Type l
arg result :: 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 e :: Type l
e = [Type l
e]
prettyTy :: Bool -> Type NodeInfo -> Printer ()
prettyTy breakLine :: Bool
breakLine ty :: 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
tys :: [Type NodeInfo]
tys -> String -> [Printer ()] -> Printer ()
prefixedLined "-> " ((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
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
tys :: [Type NodeInfo]
tys -> String -> [Printer ()] -> Printer ()
prefixedLined "-> " ((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 st :: PrintState
st -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st
conDecl :: ConDecl NodeInfo -> Printer ()
conDecl :: ConDecl NodeInfo -> Printer ()
conDecl (RecDecl _ name :: Name NodeInfo
name fields :: [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 -> [Printer ()] -> Printer ()
prefixedLined ","
((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 "}"
)
conDecl (ConDecl _ name :: Name NodeInfo
name bangty :: [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 _ a :: Type NodeInfo
a f :: Name NodeInfo
f b :: 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]
recUpdateExpr :: Printer () -> [FieldUpdate NodeInfo] -> Printer ()
recUpdateExpr :: Printer () -> [FieldUpdate NodeInfo] -> Printer ()
recUpdateExpr expWriter :: Printer ()
expWriter updates :: [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 "{ ") (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ String -> [Printer ()] -> Printer ()
prefixedLined ", " ([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 "}"
isLineBreak :: QName NodeInfo -> Printer Bool
isLineBreak :: QName NodeInfo -> Printer Bool
isLineBreak (UnQual _ (Symbol _ s :: 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 _ = 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 p :: 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 a :: Printer a
a b :: 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 r :: 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
$ \st :: 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
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 :: Binds NodeInfo
binds =
do Printer ()
newline
Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indented 2
(do String -> Printer ()
write "where"
Printer ()
newline
Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indented 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 e :: Exp NodeInfo
e a :: Exp NodeInfo
a op :: QOp NodeInfo
op b :: Exp NodeInfo
b indent :: 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 e' :: Exp NodeInfo
e' -> Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e'
OpChainLink qop :: 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 _ _ -> 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 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
+ 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
_ -> 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 _ stmts :: [Stmt NodeInfo]
stmts -> Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer ()
swing (String -> Printer ()
write " 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)
_ -> do
Printer ()
beforeRhs
case Maybe Int64
indent of
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 ""))
if Int64
col Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== 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 col :: 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 e' :: Exp NodeInfo
e' =
case Exp NodeInfo
e' of
InfixApp _ a' :: Exp NodeInfo
a' op' :: QOp NodeInfo
op' b' :: 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 -> 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 _ left :: Exp l
left op :: QOp l
op right :: 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 e :: 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 quoter :: String
quoter body :: 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 "|")
(do Printer ()
body
String -> Printer ()
write "|"))
unboxedSumValuePattern
:: (Pretty ast, Show (ast NodeInfo))
=> Int
-> Int
-> ast NodeInfo
-> Printer ()
unboxedSumValuePattern :: Int -> Int -> ast NodeInfo -> Printer ()
unboxedSumValuePattern nLeft :: Int
nLeft nRight :: Int
nRight e :: ast NodeInfo
e = do
String -> String -> Printer () -> Printer ()
forall a. String -> String -> Printer a -> Printer a
wrap "(# " " #)" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
Int -> Printer () -> Printer ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
nLeft (String -> Printer ()
write "| ")
ast NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ast NodeInfo
e
Int -> Printer () -> Printer ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
nRight (String -> Printer ()
write " |")