{-# LANGUAGE CPP #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Floskell.Pretty ( Pretty(..), pretty ) where
import Control.Applicative ( (<|>) )
import Control.Monad
( forM_, guard, replicateM_, unless, void, when )
import Control.Monad.State.Strict ( get, gets, modify )
import Data.Bool ( bool )
import Data.ByteString ( ByteString )
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString.Lazy as BL
import Data.List ( groupBy, sortBy, sortOn )
import Data.Maybe ( catMaybes, fromMaybe )
import qualified Data.Set as Set
import qualified Floskell.Buffer as Buffer
import Floskell.Config
import Floskell.Imports
( groupImports, sortImports, splitImports )
import Floskell.Printers
import Floskell.Types
import qualified Language.Haskell.Exts.Pretty as HSE
import Language.Haskell.Exts.Syntax
run :: (a -> a -> Bool) -> [a] -> ([a], [a])
run :: (a -> a -> Bool) -> [a] -> ([a], [a])
run a -> a -> Bool
_ [] = ([], [])
run a -> a -> Bool
_ [ a
x ] = ([ a
x ], [])
run a -> a -> Bool
eq (a
x : a
y : [a]
xs)
| a -> a -> Bool
eq a
x a
y = let ([a]
ys, [a]
zs) = (a -> a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> a -> Bool) -> [a] -> ([a], [a])
run a -> a -> Bool
eq (a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs) in (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ys, [a]
zs)
| Bool
otherwise = ([ a
x ], a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs)
runs :: (a -> a -> Bool) -> [a] -> [[a]]
runs :: (a -> a -> Bool) -> [a] -> [[a]]
runs a -> a -> Bool
_ [] = []
runs a -> a -> Bool
eq [a]
xs = let ([a]
ys, [a]
zs) = (a -> a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> a -> Bool) -> [a] -> ([a], [a])
run a -> a -> Bool
eq [a]
xs in [a]
ys [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: (a -> a -> Bool) -> [a] -> [[a]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
runs a -> a -> Bool
eq [a]
zs
stopImportModule :: TabStop
stopImportModule :: TabStop
stopImportModule = String -> TabStop
TabStop String
"import-module"
stopImportSpec :: TabStop
stopImportSpec :: TabStop
stopImportSpec = String -> TabStop
TabStop String
"import-spec"
stopRecordField :: TabStop
stopRecordField :: TabStop
stopRecordField = String -> TabStop
TabStop String
"record"
stopRhs :: TabStop
stopRhs :: TabStop
stopRhs = String -> TabStop
TabStop String
"rhs"
flattenApp :: Annotated ast
=> (ast NodeInfo -> Maybe (ast NodeInfo, ast NodeInfo))
-> ast NodeInfo
-> [ast NodeInfo]
flattenApp :: (ast NodeInfo -> Maybe (ast NodeInfo, ast NodeInfo))
-> ast NodeInfo -> [ast NodeInfo]
flattenApp ast NodeInfo -> Maybe (ast NodeInfo, ast NodeInfo)
fn = ast NodeInfo -> [ast NodeInfo]
go (ast NodeInfo -> [ast NodeInfo])
-> (ast NodeInfo -> ast NodeInfo) -> ast NodeInfo -> [ast NodeInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeInfo -> NodeInfo) -> ast NodeInfo -> ast NodeInfo
forall (ast :: * -> *) l.
Annotated ast =>
(l -> l) -> ast l -> ast l
amap (\NodeInfo
info -> NodeInfo
info { nodeInfoLeadingComments :: [Comment]
nodeInfoLeadingComments = []
, nodeInfoTrailingComments :: [Comment]
nodeInfoTrailingComments = []
})
where
go :: ast NodeInfo -> [ast NodeInfo]
go ast NodeInfo
x = case ast NodeInfo -> Maybe (ast NodeInfo, ast NodeInfo)
fn ast NodeInfo
x of
Just (ast NodeInfo
lhs, ast NodeInfo
rhs) -> let lhs' :: [ast NodeInfo]
lhs' = ast NodeInfo -> [ast NodeInfo]
go (ast NodeInfo -> [ast NodeInfo]) -> ast NodeInfo -> [ast NodeInfo]
forall a b. (a -> b) -> a -> b
$ Location -> ast NodeInfo -> ast NodeInfo -> ast NodeInfo
forall (ast1 :: * -> *) (ast2 :: * -> *).
(Annotated ast1, Annotated ast2) =>
Location -> ast1 NodeInfo -> ast2 NodeInfo -> ast2 NodeInfo
copyComments Location
Before ast NodeInfo
x ast NodeInfo
lhs
rhs' :: [ast NodeInfo]
rhs' = ast NodeInfo -> [ast NodeInfo]
go (ast NodeInfo -> [ast NodeInfo]) -> ast NodeInfo -> [ast NodeInfo]
forall a b. (a -> b) -> a -> b
$ Location -> ast NodeInfo -> ast NodeInfo -> ast NodeInfo
forall (ast1 :: * -> *) (ast2 :: * -> *).
(Annotated ast1, Annotated ast2) =>
Location -> ast1 NodeInfo -> ast2 NodeInfo -> ast2 NodeInfo
copyComments Location
After ast NodeInfo
x ast NodeInfo
rhs
in
[ast NodeInfo]
lhs' [ast NodeInfo] -> [ast NodeInfo] -> [ast NodeInfo]
forall a. [a] -> [a] -> [a]
++ [ast NodeInfo]
rhs'
Maybe (ast NodeInfo, ast NodeInfo)
Nothing -> [ ast NodeInfo
x ]
flattenInfix
:: (Annotated ast1, Annotated ast2)
=> (ast1 NodeInfo -> Maybe (ast1 NodeInfo, ast2 NodeInfo, ast1 NodeInfo))
-> ast1 NodeInfo
-> (ast1 NodeInfo, [(ast2 NodeInfo, ast1 NodeInfo)])
flattenInfix :: (ast1 NodeInfo
-> Maybe (ast1 NodeInfo, ast2 NodeInfo, ast1 NodeInfo))
-> ast1 NodeInfo
-> (ast1 NodeInfo, [(ast2 NodeInfo, ast1 NodeInfo)])
flattenInfix ast1 NodeInfo
-> Maybe (ast1 NodeInfo, ast2 NodeInfo, ast1 NodeInfo)
fn = ast1 NodeInfo -> (ast1 NodeInfo, [(ast2 NodeInfo, ast1 NodeInfo)])
go (ast1 NodeInfo
-> (ast1 NodeInfo, [(ast2 NodeInfo, ast1 NodeInfo)]))
-> (ast1 NodeInfo -> ast1 NodeInfo)
-> ast1 NodeInfo
-> (ast1 NodeInfo, [(ast2 NodeInfo, ast1 NodeInfo)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeInfo -> NodeInfo) -> ast1 NodeInfo -> ast1 NodeInfo
forall (ast :: * -> *) l.
Annotated ast =>
(l -> l) -> ast l -> ast l
amap (\NodeInfo
info -> NodeInfo
info { nodeInfoLeadingComments :: [Comment]
nodeInfoLeadingComments = []
, nodeInfoTrailingComments :: [Comment]
nodeInfoTrailingComments = []
})
where
go :: ast1 NodeInfo -> (ast1 NodeInfo, [(ast2 NodeInfo, ast1 NodeInfo)])
go ast1 NodeInfo
x = case ast1 NodeInfo
-> Maybe (ast1 NodeInfo, ast2 NodeInfo, ast1 NodeInfo)
fn ast1 NodeInfo
x of
Just (ast1 NodeInfo
lhs, ast2 NodeInfo
op, ast1 NodeInfo
rhs) ->
let (ast1 NodeInfo
lhs', [(ast2 NodeInfo, ast1 NodeInfo)]
ops) = ast1 NodeInfo -> (ast1 NodeInfo, [(ast2 NodeInfo, ast1 NodeInfo)])
go (ast1 NodeInfo
-> (ast1 NodeInfo, [(ast2 NodeInfo, ast1 NodeInfo)]))
-> ast1 NodeInfo
-> (ast1 NodeInfo, [(ast2 NodeInfo, ast1 NodeInfo)])
forall a b. (a -> b) -> a -> b
$ Location -> ast1 NodeInfo -> ast1 NodeInfo -> ast1 NodeInfo
forall (ast1 :: * -> *) (ast2 :: * -> *).
(Annotated ast1, Annotated ast2) =>
Location -> ast1 NodeInfo -> ast2 NodeInfo -> ast2 NodeInfo
copyComments Location
Before ast1 NodeInfo
x ast1 NodeInfo
lhs
(ast1 NodeInfo
lhs'', [(ast2 NodeInfo, ast1 NodeInfo)]
ops') = ast1 NodeInfo -> (ast1 NodeInfo, [(ast2 NodeInfo, ast1 NodeInfo)])
go (ast1 NodeInfo
-> (ast1 NodeInfo, [(ast2 NodeInfo, ast1 NodeInfo)]))
-> ast1 NodeInfo
-> (ast1 NodeInfo, [(ast2 NodeInfo, ast1 NodeInfo)])
forall a b. (a -> b) -> a -> b
$ Location -> ast1 NodeInfo -> ast1 NodeInfo -> ast1 NodeInfo
forall (ast1 :: * -> *) (ast2 :: * -> *).
(Annotated ast1, Annotated ast2) =>
Location -> ast1 NodeInfo -> ast2 NodeInfo -> ast2 NodeInfo
copyComments Location
After ast1 NodeInfo
x ast1 NodeInfo
rhs
in
(ast1 NodeInfo
lhs', [(ast2 NodeInfo, ast1 NodeInfo)]
ops [(ast2 NodeInfo, ast1 NodeInfo)]
-> [(ast2 NodeInfo, ast1 NodeInfo)]
-> [(ast2 NodeInfo, ast1 NodeInfo)]
forall a. [a] -> [a] -> [a]
++ (ast2 NodeInfo
op, ast1 NodeInfo
lhs'') (ast2 NodeInfo, ast1 NodeInfo)
-> [(ast2 NodeInfo, ast1 NodeInfo)]
-> [(ast2 NodeInfo, ast1 NodeInfo)]
forall a. a -> [a] -> [a]
: [(ast2 NodeInfo, ast1 NodeInfo)]
ops')
Maybe (ast1 NodeInfo, ast2 NodeInfo, ast1 NodeInfo)
Nothing -> (ast1 NodeInfo
x, [])
prettyHSE :: HSE.Pretty (ast NodeInfo) => ast NodeInfo -> Printer ()
prettyHSE :: ast NodeInfo -> Printer ()
prettyHSE ast NodeInfo
ast = String -> Printer ()
string (String -> Printer ()) -> String -> Printer ()
forall a b. (a -> b) -> a -> b
$ ast NodeInfo -> String
forall a. Pretty a => a -> String
HSE.prettyPrint ast NodeInfo
ast
class Pretty ast where
prettyPrint :: ast NodeInfo -> Printer ()
default prettyPrint
:: HSE.Pretty (ast NodeInfo) => ast NodeInfo -> Printer ()
prettyPrint = ast NodeInfo -> Printer ()
forall (ast :: * -> *).
Pretty (ast NodeInfo) =>
ast NodeInfo -> Printer ()
prettyHSE
pretty :: (Annotated ast, Pretty ast) => ast NodeInfo -> Printer ()
pretty :: ast NodeInfo -> Printer ()
pretty ast NodeInfo
ast = do
Location -> ast NodeInfo -> Printer ()
forall (ast :: * -> *).
Annotated ast =>
Location -> ast NodeInfo -> Printer ()
printComments Location
Before ast NodeInfo
ast
ast NodeInfo -> Printer ()
forall (ast :: * -> *). Pretty ast => ast NodeInfo -> Printer ()
prettyPrint ast NodeInfo
ast
Location -> ast NodeInfo -> Printer ()
forall (ast :: * -> *).
Annotated ast =>
Location -> ast NodeInfo -> Printer ()
printComments Location
After ast NodeInfo
ast
prettyOnside :: (Annotated ast, Pretty ast) => ast NodeInfo -> Printer ()
prettyOnside :: ast NodeInfo -> Printer ()
prettyOnside ast NodeInfo
ast = do
Bool
eol <- (PrintState -> Bool) -> Printer Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Bool
psEolComment
Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
eol Printer ()
newline
Bool
nl <- (PrintState -> Bool) -> Printer Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Bool
psNewline
if Bool
nl
then do
Location -> ast NodeInfo -> Printer ()
forall (ast :: * -> *).
Annotated ast =>
Location -> ast NodeInfo -> Printer ()
printComments Location
Before ast NodeInfo
ast
Printer () -> Printer ()
forall a. Printer a -> Printer a
onside (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ ast NodeInfo -> Printer ()
forall (ast :: * -> *). Pretty ast => ast NodeInfo -> Printer ()
prettyPrint ast NodeInfo
ast
Location -> ast NodeInfo -> Printer ()
forall (ast :: * -> *).
Annotated ast =>
Location -> ast NodeInfo -> Printer ()
printComments Location
After ast NodeInfo
ast
else Printer () -> Printer ()
forall a. Printer a -> Printer a
onside (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ ast NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty ast NodeInfo
ast
compareAST
:: (Functor ast, Ord (ast ())) => ast NodeInfo -> ast NodeInfo -> Ordering
compareAST :: ast NodeInfo -> ast NodeInfo -> Ordering
compareAST ast NodeInfo
a ast NodeInfo
b = ast NodeInfo -> ast ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ast NodeInfo
a ast () -> ast () -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` ast NodeInfo -> ast ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ast NodeInfo
b
filterComments :: Annotated a => Location -> a NodeInfo -> [Comment]
Location
Before = NodeInfo -> [Comment]
nodeInfoLeadingComments (NodeInfo -> [Comment])
-> (a NodeInfo -> NodeInfo) -> a NodeInfo -> [Comment]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a NodeInfo -> NodeInfo
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann
filterComments Location
After = NodeInfo -> [Comment]
nodeInfoTrailingComments (NodeInfo -> [Comment])
-> (a NodeInfo -> NodeInfo) -> a NodeInfo -> [Comment]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a NodeInfo -> NodeInfo
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann
copyComments :: (Annotated ast1, Annotated ast2)
=> Location
-> ast1 NodeInfo
-> ast2 NodeInfo
-> ast2 NodeInfo
Location
Before ast1 NodeInfo
from ast2 NodeInfo
to =
(NodeInfo -> NodeInfo) -> ast2 NodeInfo -> ast2 NodeInfo
forall (ast :: * -> *) l.
Annotated ast =>
(l -> l) -> ast l -> ast l
amap (\NodeInfo
n ->
NodeInfo
n { nodeInfoLeadingComments :: [Comment]
nodeInfoLeadingComments = NodeInfo -> [Comment]
nodeInfoLeadingComments (NodeInfo -> [Comment]) -> NodeInfo -> [Comment]
forall a b. (a -> b) -> a -> b
$ ast1 NodeInfo -> NodeInfo
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann ast1 NodeInfo
from })
ast2 NodeInfo
to
copyComments Location
After ast1 NodeInfo
from ast2 NodeInfo
to =
(NodeInfo -> NodeInfo) -> ast2 NodeInfo -> ast2 NodeInfo
forall (ast :: * -> *) l.
Annotated ast =>
(l -> l) -> ast l -> ast l
amap (\NodeInfo
n ->
NodeInfo
n { nodeInfoTrailingComments :: [Comment]
nodeInfoTrailingComments = NodeInfo -> [Comment]
nodeInfoTrailingComments (NodeInfo -> [Comment]) -> NodeInfo -> [Comment]
forall a b. (a -> b) -> a -> b
$ ast1 NodeInfo -> NodeInfo
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann ast1 NodeInfo
from })
ast2 NodeInfo
to
printComment :: Int -> (Comment, SrcSpan) -> Printer ()
Int
correction (Comment{String
SrcSpan
CommentType
commentText :: Comment -> String
commentSpan :: Comment -> SrcSpan
commentType :: Comment -> CommentType
commentText :: String
commentSpan :: SrcSpan
commentType :: CommentType
..}, SrcSpan
nextSpan) = do
Int
col <- Printer Int
getNextColumn
let padding :: Int
padding = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ SrcSpan -> Int
srcSpanStartColumn SrcSpan
commentSpan Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
correction Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
case CommentType
commentType of
CommentType
PreprocessorDirective -> do
Bool
nl <- (PrintState -> Bool) -> Printer Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Bool
psNewline
Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
nl Printer ()
newline
Int -> Printer () -> Printer ()
forall a. Int -> Printer a -> Printer a
column Int
0 (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ String -> Printer ()
string String
commentText
(PrintState -> PrintState) -> Printer ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\PrintState
s -> PrintState
s { psEolComment :: Bool
psEolComment = Bool
True })
CommentType
InlineComment -> do
ByteString -> Printer ()
write (ByteString -> Printer ()) -> ByteString -> Printer ()
forall a b. (a -> b) -> a -> b
$ Int -> Word8 -> ByteString
BS.replicate Int
padding Word8
32
ByteString -> Printer ()
write ByteString
"{-"
String -> Printer ()
string String
commentText
ByteString -> Printer ()
write ByteString
"-}"
Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SrcSpan -> Int
srcSpanEndLine SrcSpan
commentSpan Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= SrcSpan -> Int
srcSpanStartLine SrcSpan
nextSpan) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$
(PrintState -> PrintState) -> Printer ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\PrintState
s -> PrintState
s { psEolComment :: Bool
psEolComment = Bool
True })
CommentType
LineComment -> do
ByteString -> Printer ()
write (ByteString -> Printer ()) -> ByteString -> Printer ()
forall a b. (a -> b) -> a -> b
$ Int -> Word8 -> ByteString
BS.replicate Int
padding Word8
32
ByteString -> Printer ()
write ByteString
"--"
String -> Printer ()
string String
commentText
(PrintState -> PrintState) -> Printer ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\PrintState
s -> PrintState
s { psEolComment :: Bool
psEolComment = Bool
True })
printComments :: Annotated ast => Location -> ast NodeInfo -> Printer ()
= Bool -> Location -> ast NodeInfo -> Printer ()
forall (ast :: * -> *).
Annotated ast =>
Bool -> Location -> ast NodeInfo -> Printer ()
printCommentsInternal Bool
True
printComments' :: Annotated ast => Location -> ast NodeInfo -> Printer ()
= Bool -> Location -> ast NodeInfo -> Printer ()
forall (ast :: * -> *).
Annotated ast =>
Bool -> Location -> ast NodeInfo -> Printer ()
printCommentsInternal Bool
False
printCommentsInternal
:: Annotated ast => Bool -> Location -> ast NodeInfo -> Printer ()
Bool
nlBefore Location
loc ast NodeInfo
ast = Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Comment] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Comment]
comments) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
let firstComment :: Comment
firstComment = [Comment] -> Comment
forall a. [a] -> a
head [Comment]
comments
Bool
nl <- (PrintState -> Bool) -> Printer Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Bool
psNewline
Int
onside' <- (PrintState -> Int) -> Printer Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Int
psOnside
Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
nl (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ (PrintState -> PrintState) -> Printer ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((PrintState -> PrintState) -> Printer ())
-> (PrintState -> PrintState) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \PrintState
s -> PrintState
s { psOnside :: Int
psOnside = Int
0 }
Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Location
loc Location -> Location -> Bool
forall a. Eq a => a -> a -> Bool
== Location
Before Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
nl Bool -> Bool -> Bool
&& Bool
nlBefore) Printer ()
newline
Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Location
loc Location -> Location -> Bool
forall a. Eq a => a -> a -> Bool
== Location
After Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
nl Bool -> Bool -> Bool
&& Comment -> Bool
notSameLine Comment
firstComment) Printer ()
newline
Int
col <- Printer Int
getNextColumn
let correction :: Int
correction = case Location
loc of
Location
Before -> Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
- SrcSpan -> Int
srcSpanStartColumn SrcSpan
ssi Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
Location
After -> Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
- SrcSpan -> Int
srcSpanEndColumn SrcSpan
ssi Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
[(Comment, SrcSpan)]
-> ((Comment, SrcSpan) -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Comment] -> [SrcSpan] -> [(Comment, SrcSpan)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Comment]
comments ([SrcSpan] -> [SrcSpan]
forall a. [a] -> [a]
tail ((Comment -> SrcSpan) -> [Comment] -> [SrcSpan]
forall a b. (a -> b) -> [a] -> [b]
map Comment -> SrcSpan
commentSpan [Comment]
comments [SrcSpan] -> [SrcSpan] -> [SrcSpan]
forall a. [a] -> [a] -> [a]
++ [ SrcSpan
ssi ]))) (((Comment, SrcSpan) -> Printer ()) -> Printer ())
-> ((Comment, SrcSpan) -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$
Int -> (Comment, SrcSpan) -> Printer ()
printComment Int
correction
Bool
eol <- (PrintState -> Bool) -> Printer Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Bool
psEolComment
Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Location
loc Location -> Location -> Bool
forall a. Eq a => a -> a -> Bool
== Location
Before Bool -> Bool -> Bool
&& Bool
eol Bool -> Bool -> Bool
&& Int
onside' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) Printer ()
newline
Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
nl (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ (PrintState -> PrintState) -> Printer ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((PrintState -> PrintState) -> Printer ())
-> (PrintState -> PrintState) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \PrintState
s -> PrintState
s { psOnside :: Int
psOnside = Int
onside' }
where
ssi :: SrcSpan
ssi = ast NodeInfo -> SrcSpan
forall (ast :: * -> *). Annotated ast => ast NodeInfo -> SrcSpan
nodeSpan ast NodeInfo
ast
comments :: [Comment]
comments = Location -> ast NodeInfo -> [Comment]
forall (a :: * -> *).
Annotated a =>
Location -> a NodeInfo -> [Comment]
filterComments Location
loc ast NodeInfo
ast
notSameLine :: Comment -> Bool
notSameLine Comment
comment = SrcSpan -> Int
srcSpanEndLine SrcSpan
ssi
Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< SrcSpan -> Int
srcSpanStartLine (Comment -> SrcSpan
commentSpan Comment
comment)
opName :: QOp a -> ByteString
opName :: QOp a -> ByteString
opName QOp a
op = case QOp a
op of
(QVarOp a
_ QName a
qname) -> QName a -> ByteString
forall a. QName a -> ByteString
opName' QName a
qname
(QConOp a
_ QName a
qname) -> QName a -> ByteString
forall a. QName a -> ByteString
opName' QName a
qname
opName' :: QName a -> ByteString
opName' :: QName a -> ByteString
opName' (Qual a
_ ModuleName a
_ Name a
name) = Name a -> ByteString
forall a. Name a -> ByteString
opName'' Name a
name
opName' (UnQual a
_ Name a
name) = Name a -> ByteString
forall a. Name a -> ByteString
opName'' Name a
name
opName' (Special a
_ (FunCon a
_)) = ByteString
"->"
opName' (Special a
_ (Cons a
_)) = ByteString
":"
opName' (Special a
_ SpecialCon a
_) = ByteString
""
opName'' :: Name a -> ByteString
opName'' :: Name a -> ByteString
opName'' (Ident a
_ String
_) = ByteString
"``"
opName'' (Symbol a
_ String
str) = String -> ByteString
BS8.pack String
str
lineDelta :: Annotated ast => ast NodeInfo -> ast NodeInfo -> Int
lineDelta :: ast NodeInfo -> ast NodeInfo -> Int
lineDelta ast NodeInfo
prev ast NodeInfo
next = Int
nextLine Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
prevLine
where
prevLine :: Int
prevLine = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Int
prevNodeLine Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
prevCommentLines)
nextLine :: Int
nextLine = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (Int
nextNodeLine Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
nextCommentLines)
prevNodeLine :: Int
prevNodeLine = SrcSpan -> Int
srcSpanEndLine (SrcSpan -> Int) -> SrcSpan -> Int
forall a b. (a -> b) -> a -> b
$ ast NodeInfo -> SrcSpan
forall (ast :: * -> *). Annotated ast => ast NodeInfo -> SrcSpan
nodeSpan ast NodeInfo
prev
nextNodeLine :: Int
nextNodeLine = SrcSpan -> Int
srcSpanStartLine (SrcSpan -> Int) -> SrcSpan -> Int
forall a b. (a -> b) -> a -> b
$ ast NodeInfo -> SrcSpan
forall (ast :: * -> *). Annotated ast => ast NodeInfo -> SrcSpan
nodeSpan ast NodeInfo
next
prevCommentLines :: [Int]
prevCommentLines = (Comment -> Int) -> [Comment] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (SrcSpan -> Int
srcSpanEndLine (SrcSpan -> Int) -> (Comment -> SrcSpan) -> Comment -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Comment -> SrcSpan
commentSpan) ([Comment] -> [Int]) -> [Comment] -> [Int]
forall a b. (a -> b) -> a -> b
$
Location -> ast NodeInfo -> [Comment]
forall (a :: * -> *).
Annotated a =>
Location -> a NodeInfo -> [Comment]
filterComments Location
After ast NodeInfo
prev
nextCommentLines :: [Int]
nextCommentLines = (Comment -> Int) -> [Comment] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (SrcSpan -> Int
srcSpanStartLine (SrcSpan -> Int) -> (Comment -> SrcSpan) -> Comment -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Comment -> SrcSpan
commentSpan) ([Comment] -> [Int]) -> [Comment] -> [Int]
forall a b. (a -> b) -> a -> b
$
Location -> ast NodeInfo -> [Comment]
forall (a :: * -> *).
Annotated a =>
Location -> a NodeInfo -> [Comment]
filterComments Location
Before ast NodeInfo
next
linedFn :: Annotated ast
=> (ast NodeInfo -> Printer ())
-> [ast NodeInfo]
-> Printer ()
linedFn :: (ast NodeInfo -> Printer ()) -> [ast NodeInfo] -> Printer ()
linedFn ast NodeInfo -> Printer ()
fn [ast NodeInfo]
xs = do
Bool
preserveP <- (OptionConfig -> Bool) -> Printer Bool
forall a. (OptionConfig -> a) -> Printer a
getOption OptionConfig -> Bool
cfgOptionPreserveVerticalSpace
if Bool
preserveP
then case [ast NodeInfo]
xs of
ast NodeInfo
x : [ast NodeInfo]
xs' -> do
Printer () -> Printer ()
forall a. Printer a -> Printer a
cut (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ ast NodeInfo -> Printer ()
fn ast NodeInfo
x
[(ast NodeInfo, ast NodeInfo)]
-> ((ast NodeInfo, ast NodeInfo) -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([ast NodeInfo] -> [ast NodeInfo] -> [(ast NodeInfo, ast NodeInfo)]
forall a b. [a] -> [b] -> [(a, b)]
zip [ast NodeInfo]
xs [ast NodeInfo]
xs') (((ast NodeInfo, ast NodeInfo) -> Printer ()) -> Printer ())
-> ((ast NodeInfo, ast NodeInfo) -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \(ast NodeInfo
prev, ast NodeInfo
cur) -> do
Int -> Printer () -> Printer ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
2 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ ast NodeInfo -> ast NodeInfo -> Int
forall (ast :: * -> *).
Annotated ast =>
ast NodeInfo -> ast NodeInfo -> Int
lineDelta ast NodeInfo
prev ast NodeInfo
cur)) Printer ()
newline
Printer () -> Printer ()
forall a. Printer a -> Printer a
cut (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ ast NodeInfo -> Printer ()
fn ast NodeInfo
cur
[] -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else Printer () -> [Printer ()] -> Printer ()
inter Printer ()
newline ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (ast NodeInfo -> Printer ()) -> [ast NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map (Printer () -> Printer ()
forall a. Printer a -> Printer a
cut (Printer () -> Printer ())
-> (ast NodeInfo -> Printer ()) -> ast NodeInfo -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ast NodeInfo -> Printer ()
fn) [ast NodeInfo]
xs
lined :: (Annotated ast, Pretty ast) => [ast NodeInfo] -> Printer ()
lined :: [ast NodeInfo] -> Printer ()
lined = (ast NodeInfo -> Printer ()) -> [ast NodeInfo] -> Printer ()
forall (ast :: * -> *).
Annotated ast =>
(ast NodeInfo -> Printer ()) -> [ast NodeInfo] -> Printer ()
linedFn ast NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty
linedOnside :: (Annotated ast, Pretty ast) => [ast NodeInfo] -> Printer ()
linedOnside :: [ast NodeInfo] -> Printer ()
linedOnside = (ast NodeInfo -> Printer ()) -> [ast NodeInfo] -> Printer ()
forall (ast :: * -> *).
Annotated ast =>
(ast NodeInfo -> Printer ()) -> [ast NodeInfo] -> Printer ()
linedFn ast NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
prettyOnside
listVOpLen :: LayoutContext -> ByteString -> Printer Int
listVOpLen :: LayoutContext -> ByteString -> Printer Int
listVOpLen LayoutContext
ctx ByteString
sep = do
Whitespace
ws <- (Config -> Whitespace) -> Printer Whitespace
forall b. (Config -> b) -> Printer b
getConfig (LayoutContext -> ByteString -> OpConfig -> Whitespace
cfgOpWs LayoutContext
ctx ByteString
sep (OpConfig -> Whitespace)
-> (Config -> OpConfig) -> Config -> Whitespace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> OpConfig
cfgOp)
Int -> Printer Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Printer Int) -> Int -> Printer Int
forall a b. (a -> b) -> a -> b
$ if Location -> Whitespace -> Bool
wsLinebreak Location
After Whitespace
ws
then Int
0
else ByteString -> Int
BS.length ByteString
sep Int -> Int -> Int
forall a. Num a => a -> a -> a
+ if Location -> Whitespace -> Bool
wsSpace Location
After Whitespace
ws then Int
1 else Int
0
listVinternal :: (Annotated ast, Pretty ast)
=> LayoutContext
-> ByteString
-> [ast NodeInfo]
-> Printer ()
listVinternal :: LayoutContext -> ByteString -> [ast NodeInfo] -> Printer ()
listVinternal LayoutContext
ctx ByteString
sep [ast NodeInfo]
xs = case [ast NodeInfo]
xs of
[] -> Printer ()
newline
(ast NodeInfo
x : [ast NodeInfo]
xs') -> do
Bool
nl <- (PrintState -> Bool) -> Printer Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Bool
psNewline
Int
col <- Printer Int
getNextColumn
Int
delta <- LayoutContext -> ByteString -> Printer Int
listVOpLen LayoutContext
ctx ByteString
sep
let itemCol :: Int
itemCol = if Bool
nl Bool -> Bool -> Bool
&& [ast NodeInfo] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ast NodeInfo]
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 then Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
delta else Int
col
sepCol :: Int
sepCol = Int
itemCol Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
delta
Int -> Printer () -> Printer ()
forall a. Int -> Printer a -> Printer a
column Int
itemCol (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
Location -> ast NodeInfo -> Printer ()
forall (ast :: * -> *).
Annotated ast =>
Location -> ast NodeInfo -> Printer ()
printComments' Location
Before ast NodeInfo
x
Printer () -> Printer ()
forall a. Printer a -> Printer a
cut (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ ast NodeInfo -> Printer ()
forall (ast :: * -> *). Pretty ast => ast NodeInfo -> Printer ()
prettyPrint ast NodeInfo
x
Location -> ast NodeInfo -> Printer ()
forall (ast :: * -> *).
Annotated ast =>
Location -> ast NodeInfo -> Printer ()
printComments Location
After ast NodeInfo
x
[ast NodeInfo] -> (ast NodeInfo -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ast NodeInfo]
xs' ((ast NodeInfo -> Printer ()) -> Printer ())
-> (ast NodeInfo -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \ast NodeInfo
x' -> do
Int -> Printer () -> Printer ()
forall a. Int -> Printer a -> Printer a
column Int
itemCol (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Location -> ast NodeInfo -> Printer ()
forall (ast :: * -> *).
Annotated ast =>
Location -> ast NodeInfo -> Printer ()
printComments Location
Before ast NodeInfo
x'
Int -> Printer () -> Printer ()
forall a. Int -> Printer a -> Printer a
column Int
sepCol (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ LayoutContext -> ByteString -> Printer ()
operatorV LayoutContext
ctx ByteString
sep
Int -> Printer () -> Printer ()
forall a. Int -> Printer a -> Printer a
column Int
itemCol (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Printer () -> Printer ()
forall a. Printer a -> Printer a
cut (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ ast NodeInfo -> Printer ()
forall (ast :: * -> *). Pretty ast => ast NodeInfo -> Printer ()
prettyPrint ast NodeInfo
x'
Int -> Printer () -> Printer ()
forall a. Int -> Printer a -> Printer a
column Int
itemCol (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Location -> ast NodeInfo -> Printer ()
forall (ast :: * -> *).
Annotated ast =>
Location -> ast NodeInfo -> Printer ()
printComments Location
After ast NodeInfo
x'
listH :: (Annotated ast, Pretty ast)
=> LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [ast NodeInfo]
-> Printer ()
listH :: LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [ast NodeInfo]
-> Printer ()
listH LayoutContext
_ ByteString
open ByteString
close ByteString
_ [] = do
ByteString -> Printer ()
write ByteString
open
ByteString -> Printer ()
write ByteString
close
listH LayoutContext
ctx ByteString
open ByteString
close ByteString
sep [ast NodeInfo]
xs =
LayoutContext
-> ByteString -> ByteString -> Printer () -> Printer ()
groupH LayoutContext
ctx ByteString
open ByteString
close (Printer () -> Printer ())
-> ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Printer () -> [Printer ()] -> Printer ()
inter (LayoutContext -> ByteString -> Printer ()
operatorH LayoutContext
ctx ByteString
sep) ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (ast NodeInfo -> Printer ()) -> [ast NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map ast NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty [ast NodeInfo]
xs
listV :: (Annotated ast, Pretty ast)
=> LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [ast NodeInfo]
-> Printer ()
listV :: LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [ast NodeInfo]
-> Printer ()
listV LayoutContext
ctx ByteString
open ByteString
close ByteString
sep [ast NodeInfo]
xs = LayoutContext
-> ByteString -> ByteString -> Printer () -> Printer ()
groupV LayoutContext
ctx ByteString
open ByteString
close (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
Whitespace
ws <- (Config -> Whitespace) -> Printer Whitespace
forall b. (Config -> b) -> Printer b
getConfig (LayoutContext -> ByteString -> OpConfig -> Whitespace
cfgOpWs LayoutContext
ctx ByteString
sep (OpConfig -> Whitespace)
-> (Config -> OpConfig) -> Config -> Whitespace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> OpConfig
cfgOp)
Whitespace
ws' <- (Config -> Whitespace) -> Printer Whitespace
forall b. (Config -> b) -> Printer b
getConfig (LayoutContext -> ByteString -> GroupConfig -> Whitespace
cfgGroupWs LayoutContext
ctx ByteString
open (GroupConfig -> Whitespace)
-> (Config -> GroupConfig) -> Config -> Whitespace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> GroupConfig
cfgGroup)
Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Location -> Whitespace -> Bool
wsLinebreak Location
Before Whitespace
ws' Bool -> Bool -> Bool
|| Location -> Whitespace -> Bool
wsSpace Location
After Whitespace
ws' Bool -> Bool -> Bool
|| Location -> Whitespace -> Bool
wsLinebreak Location
After Whitespace
ws
Bool -> Bool -> Bool
|| Bool -> Bool
not (Location -> Whitespace -> Bool
wsSpace Location
After Whitespace
ws))
Printer ()
space
LayoutContext -> ByteString -> [ast NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
LayoutContext -> ByteString -> [ast NodeInfo] -> Printer ()
listVinternal LayoutContext
ctx ByteString
sep [ast NodeInfo]
xs
list :: (Annotated ast, Pretty ast)
=> LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [ast NodeInfo]
-> Printer ()
list :: LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [ast NodeInfo]
-> Printer ()
list LayoutContext
ctx ByteString
open ByteString
close ByteString
sep [ast NodeInfo]
xs = Printer () -> Printer ()
forall a. Printer a -> Printer a
oneline Printer ()
hor Printer () -> Printer () -> Printer ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Printer ()
ver
where
hor :: Printer ()
hor = LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [ast NodeInfo]
-> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [ast NodeInfo]
-> Printer ()
listH LayoutContext
ctx ByteString
open ByteString
close ByteString
sep [ast NodeInfo]
xs
ver :: Printer ()
ver = LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [ast NodeInfo]
-> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [ast NodeInfo]
-> Printer ()
listV LayoutContext
ctx ByteString
open ByteString
close ByteString
sep [ast NodeInfo]
xs
listH' :: (Annotated ast, Pretty ast)
=> LayoutContext
-> ByteString
-> [ast NodeInfo]
-> Printer ()
listH' :: LayoutContext -> ByteString -> [ast NodeInfo] -> Printer ()
listH' LayoutContext
ctx ByteString
sep = Printer () -> [Printer ()] -> Printer ()
inter (LayoutContext -> ByteString -> Printer ()
operatorH LayoutContext
ctx ByteString
sep) ([Printer ()] -> Printer ())
-> ([ast NodeInfo] -> [Printer ()]) -> [ast NodeInfo] -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ast NodeInfo -> Printer ()) -> [ast NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map ast NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty
listV' :: (Annotated ast, Pretty ast)
=> LayoutContext
-> ByteString
-> [ast NodeInfo]
-> Printer ()
listV' :: LayoutContext -> ByteString -> [ast NodeInfo] -> Printer ()
listV' LayoutContext
ctx ByteString
sep [ast NodeInfo]
xs =
if [ast NodeInfo] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ast NodeInfo]
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 then LayoutContext -> ByteString -> [ast NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
LayoutContext -> ByteString -> [ast NodeInfo] -> Printer ()
listVinternal LayoutContext
ctx ByteString
sep [ast NodeInfo]
xs else (ast NodeInfo -> Printer ()) -> [ast NodeInfo] -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ast NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty [ast NodeInfo]
xs
list' :: (Annotated ast, Pretty ast)
=> LayoutContext
-> ByteString
-> [ast NodeInfo]
-> Printer ()
list' :: LayoutContext -> ByteString -> [ast NodeInfo] -> Printer ()
list' LayoutContext
ctx ByteString
sep [ast NodeInfo]
xs = Printer () -> Printer ()
forall a. Printer a -> Printer a
oneline Printer ()
hor Printer () -> Printer () -> Printer ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Printer ()
ver
where
hor :: Printer ()
hor = LayoutContext -> ByteString -> [ast NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
LayoutContext -> ByteString -> [ast NodeInfo] -> Printer ()
listH' LayoutContext
ctx ByteString
sep [ast NodeInfo]
xs
ver :: Printer ()
ver = LayoutContext -> ByteString -> [ast NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
LayoutContext -> ByteString -> [ast NodeInfo] -> Printer ()
listV' LayoutContext
ctx ByteString
sep [ast NodeInfo]
xs
listAutoWrap :: (Annotated ast, Pretty ast)
=> LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [ast NodeInfo]
-> Printer ()
listAutoWrap :: LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [ast NodeInfo]
-> Printer ()
listAutoWrap LayoutContext
_ ByteString
open ByteString
close ByteString
_ [] = do
ByteString -> Printer ()
write ByteString
open
ByteString -> Printer ()
write ByteString
close
listAutoWrap LayoutContext
ctx ByteString
open ByteString
close ByteString
sep [ast NodeInfo]
xs =
Printer () -> Printer ()
forall a. Printer a -> Printer a
aligned (Printer () -> Printer ())
-> (Printer () -> Printer ()) -> Printer () -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutContext
-> ByteString -> ByteString -> Printer () -> Printer ()
groupH LayoutContext
ctx ByteString
open ByteString
close (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ LayoutContext -> ByteString -> [ast NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
LayoutContext -> ByteString -> [ast NodeInfo] -> Printer ()
listAutoWrap' LayoutContext
ctx ByteString
sep [ast NodeInfo]
xs
listAutoWrap' :: (Annotated ast, Pretty ast)
=> LayoutContext
-> ByteString
-> [ast NodeInfo]
-> Printer ()
listAutoWrap' :: LayoutContext -> ByteString -> [ast NodeInfo] -> Printer ()
listAutoWrap' LayoutContext
_ ByteString
_ [] = () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
listAutoWrap' LayoutContext
ctx ByteString
sep (ast NodeInfo
x : [ast NodeInfo]
xs) = Printer () -> Printer ()
forall a. Printer a -> Printer a
aligned (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
Whitespace
ws <- (Config -> Whitespace) -> Printer Whitespace
forall b. (Config -> b) -> Printer b
getConfig (LayoutContext -> ByteString -> OpConfig -> Whitespace
cfgOpWs LayoutContext
ctx ByteString
sep (OpConfig -> Whitespace)
-> (Config -> OpConfig) -> Config -> Whitespace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> OpConfig
cfgOp)
let correction :: Int
correction = if Location -> Whitespace -> Bool
wsLinebreak Location
After Whitespace
ws
then Int
0
else ByteString -> Int
BS.length ByteString
sep Int -> Int -> Int
forall a. Num a => a -> a -> a
+ if Location -> Whitespace -> Bool
wsSpace Location
After Whitespace
ws then Int
1 else Int
0
Int
col <- Printer Int
getNextColumn
ast NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty ast NodeInfo
x
Int -> [ast NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
Int -> [ast NodeInfo] -> Printer ()
go (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
correction) [ast NodeInfo]
xs
where
go :: Int -> [ast NodeInfo] -> Printer ()
go Int
_ [] = () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
go Int
col [ ast NodeInfo
x' ] = do
Location -> ast NodeInfo -> Printer ()
forall (ast :: * -> *).
Annotated ast =>
Location -> ast NodeInfo -> Printer ()
printComments Location
Before ast NodeInfo
x'
Int -> Printer () -> Printer ()
forall a. Int -> Printer a -> Printer a
column Int
col (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ LayoutContext -> ByteString -> Printer ()
operator LayoutContext
ctx ByteString
sep
ast NodeInfo -> Printer ()
forall (ast :: * -> *). Pretty ast => ast NodeInfo -> Printer ()
prettyPrint ast NodeInfo
x'
Location -> ast NodeInfo -> Printer ()
forall (ast :: * -> *).
Annotated ast =>
Location -> ast NodeInfo -> Printer ()
printComments Location
After ast NodeInfo
x'
go Int
col (ast NodeInfo
x' : [ast NodeInfo]
xs') = do
Location -> ast NodeInfo -> Printer ()
forall (ast :: * -> *).
Annotated ast =>
Location -> ast NodeInfo -> Printer ()
printComments Location
Before ast NodeInfo
x'
Printer () -> Printer ()
forall a. Printer a -> Printer a
cut (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
Int -> Printer () -> Printer ()
forall a. Int -> Printer a -> Printer a
column Int
col (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ LayoutContext -> ByteString -> Printer ()
operator LayoutContext
ctx ByteString
sep
ast NodeInfo -> Printer ()
forall (ast :: * -> *). Pretty ast => ast NodeInfo -> Printer ()
prettyPrint ast NodeInfo
x'
Location -> ast NodeInfo -> Printer ()
forall (ast :: * -> *).
Annotated ast =>
Location -> ast NodeInfo -> Printer ()
printComments Location
After ast NodeInfo
x'
Int -> [ast NodeInfo] -> Printer ()
go Int
col [ast NodeInfo]
xs'
measure :: Printer a -> Printer (Maybe Int)
measure :: Printer a -> Printer (Maybe Int)
measure Printer a
p = do
PrintState
s <- Printer PrintState
forall s (m :: * -> *). MonadState s m => m s
get
let s' :: PrintState
s' = PrintState
s { psBuffer :: Buffer
psBuffer = Buffer
Buffer.empty, psEolComment :: Bool
psEolComment = Bool
False }
Maybe Int -> Printer (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Int -> Printer (Maybe Int))
-> Maybe Int -> Printer (Maybe Int)
forall a b. (a -> b) -> a -> b
$ case Printer a -> PrintState -> Maybe (Penalty, PrintState)
forall a. Printer a -> PrintState -> Maybe (Penalty, PrintState)
execPrinter (Printer a -> Printer a
forall a. Printer a -> Printer a
oneline Printer a
p) PrintState
s' of
Maybe (Penalty, PrintState)
Nothing -> Maybe Int
forall a. Maybe a
Nothing
Just (Penalty
_, PrintState
s'') -> Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> (Buffer -> Int) -> Buffer -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Int
x -> Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- PrintState -> Int
psIndentLevel PrintState
s) (Int -> Int) -> (Buffer -> Int) -> Buffer -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
(Int64 -> Int) -> (Buffer -> Int64) -> Buffer -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
BL.length (ByteString -> Int64) -> (Buffer -> ByteString) -> Buffer -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Buffer -> ByteString
Buffer.toLazyByteString (Buffer -> Maybe Int) -> Buffer -> Maybe Int
forall a b. (a -> b) -> a -> b
$ PrintState -> Buffer
psBuffer PrintState
s''
measure' :: Printer a -> Printer (Maybe [Int])
measure' :: Printer a -> Printer (Maybe [Int])
measure' Printer a
p = (Int -> [Int]) -> Maybe Int -> Maybe [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: []) (Maybe Int -> Maybe [Int])
-> Printer (Maybe Int) -> Printer (Maybe [Int])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Printer a -> Printer (Maybe Int)
forall a. Printer a -> Printer (Maybe Int)
measure Printer a
p
measureMatch :: Match NodeInfo -> Printer (Maybe [Int])
measureMatch :: Match NodeInfo -> Printer (Maybe [Int])
measureMatch (Match NodeInfo
_ Name NodeInfo
name [Pat NodeInfo]
pats Rhs NodeInfo
_ Maybe (Binds NodeInfo)
Nothing) = Printer () -> Printer (Maybe [Int])
forall a. Printer a -> Printer (Maybe [Int])
measure' (Name NodeInfo -> [Pat NodeInfo] -> Printer ()
forall (ast1 :: * -> *) (ast2 :: * -> *).
(Annotated ast1, Annotated ast2, Pretty ast1, Pretty ast2) =>
ast1 NodeInfo -> [ast2 NodeInfo] -> Printer ()
prettyApp Name NodeInfo
name [Pat NodeInfo]
pats)
measureMatch (InfixMatch NodeInfo
_ Pat NodeInfo
pat Name NodeInfo
name [Pat NodeInfo]
pats Rhs NodeInfo
_ Maybe (Binds NodeInfo)
Nothing) = Printer () -> Printer (Maybe [Int])
forall a. Printer a -> Printer (Maybe [Int])
measure' Printer ()
go
where
go :: Printer ()
go = do
Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
pat
LayoutContext
-> ByteString
-> Printer ()
-> (Printer () -> Printer ())
-> Printer ()
forall a.
LayoutContext
-> ByteString
-> Printer ()
-> (Printer () -> Printer a)
-> Printer a
withOperatorFormatting LayoutContext
Pattern
(Name NodeInfo -> ByteString
forall a. Name a -> ByteString
opName'' Name NodeInfo
name)
(Op NodeInfo -> Printer ()
forall (ast :: * -> *).
Pretty (ast NodeInfo) =>
ast NodeInfo -> Printer ()
prettyHSE (Op NodeInfo -> Printer ()) -> Op NodeInfo -> Printer ()
forall a b. (a -> b) -> a -> b
$ NodeInfo -> Name NodeInfo -> Op NodeInfo
forall l. l -> Name l -> Op l
VarOp NodeInfo
noNodeInfo Name NodeInfo
name)
Printer () -> Printer ()
forall a. a -> a
id
Printer () -> [Printer ()] -> Printer ()
inter Printer ()
spaceOrNewline ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (Pat NodeInfo -> Printer ()) -> [Pat NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty [Pat NodeInfo]
pats
measureMatch Match NodeInfo
_ = Maybe [Int] -> Printer (Maybe [Int])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Int]
forall a. Maybe a
Nothing
measureDecl :: Decl NodeInfo -> Printer (Maybe [Int])
measureDecl :: Decl NodeInfo -> Printer (Maybe [Int])
measureDecl (PatBind NodeInfo
_ Pat NodeInfo
pat Rhs NodeInfo
_ Maybe (Binds NodeInfo)
Nothing) = Printer () -> Printer (Maybe [Int])
forall a. Printer a -> Printer (Maybe [Int])
measure' (Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
pat)
measureDecl (FunBind NodeInfo
_ [Match NodeInfo]
matches) =
([[Int]] -> [Int]) -> Maybe [[Int]] -> Maybe [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[Int]] -> [Int]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Maybe [[Int]] -> Maybe [Int])
-> ([Maybe [Int]] -> Maybe [[Int]]) -> [Maybe [Int]] -> Maybe [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe [Int]] -> Maybe [[Int]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([Maybe [Int]] -> Maybe [Int])
-> Printer [Maybe [Int]] -> Printer (Maybe [Int])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Match NodeInfo -> Printer (Maybe [Int]))
-> [Match NodeInfo] -> Printer [Maybe [Int]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Match NodeInfo -> Printer (Maybe [Int])
measureMatch [Match NodeInfo]
matches
measureDecl Decl NodeInfo
_ = Maybe [Int] -> Printer (Maybe [Int])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Int]
forall a. Maybe a
Nothing
measureClassDecl :: ClassDecl NodeInfo -> Printer (Maybe [Int])
measureClassDecl :: ClassDecl NodeInfo -> Printer (Maybe [Int])
measureClassDecl (ClsDecl NodeInfo
_ Decl NodeInfo
decl) = Decl NodeInfo -> Printer (Maybe [Int])
measureDecl Decl NodeInfo
decl
measureClassDecl ClassDecl NodeInfo
_ = Maybe [Int] -> Printer (Maybe [Int])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Int]
forall a. Maybe a
Nothing
measureInstDecl :: InstDecl NodeInfo -> Printer (Maybe [Int])
measureInstDecl :: InstDecl NodeInfo -> Printer (Maybe [Int])
measureInstDecl (InsDecl NodeInfo
_ Decl NodeInfo
decl) = Decl NodeInfo -> Printer (Maybe [Int])
measureDecl Decl NodeInfo
decl
measureInstDecl InstDecl NodeInfo
_ = Maybe [Int] -> Printer (Maybe [Int])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Int]
forall a. Maybe a
Nothing
measureAlt :: Alt NodeInfo -> Printer (Maybe [Int])
measureAlt :: Alt NodeInfo -> Printer (Maybe [Int])
measureAlt (Alt NodeInfo
_ Pat NodeInfo
pat Rhs NodeInfo
_ Maybe (Binds NodeInfo)
Nothing) = Printer () -> Printer (Maybe [Int])
forall a. Printer a -> Printer (Maybe [Int])
measure' (Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
pat)
measureAlt Alt NodeInfo
_ = Maybe [Int] -> Printer (Maybe [Int])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Int]
forall a. Maybe a
Nothing
withComputedTabStop :: TabStop
-> (AlignConfig -> Bool)
-> (a -> Printer (Maybe [Int]))
-> [a]
-> Printer b
-> Printer b
withComputedTabStop :: TabStop
-> (AlignConfig -> Bool)
-> (a -> Printer (Maybe [Int]))
-> [a]
-> Printer b
-> Printer b
withComputedTabStop TabStop
name AlignConfig -> Bool
predicate a -> Printer (Maybe [Int])
fn [a]
xs Printer b
p = do
Bool
enabled <- (Config -> Bool) -> Printer Bool
forall b. (Config -> b) -> Printer b
getConfig (AlignConfig -> Bool
predicate (AlignConfig -> Bool) -> (Config -> AlignConfig) -> Config -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> AlignConfig
cfgAlign)
(Int
limAbs, Int
limRel) <- (Config -> (Int, Int)) -> Printer (Int, Int)
forall b. (Config -> b) -> Printer b
getConfig (AlignConfig -> (Int, Int)
cfgAlignLimits (AlignConfig -> (Int, Int))
-> (Config -> AlignConfig) -> Config -> (Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> AlignConfig
cfgAlign)
Maybe [[Int]]
mtabss <- [Maybe [Int]] -> Maybe [[Int]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([Maybe [Int]] -> Maybe [[Int]])
-> Printer [Maybe [Int]] -> Printer (Maybe [[Int]])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> Printer (Maybe [Int])) -> [a] -> Printer [Maybe [Int]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> Printer (Maybe [Int])
fn [a]
xs
let tab :: Maybe Int
tab = do
[[Int]]
tabss <- Maybe [[Int]]
mtabss
let tabs :: [Int]
tabs = [[Int]] -> [Int]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Int]]
tabss
maxtab :: Int
maxtab = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
tabs
mintab :: Int
mintab = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Int]
tabs
delta :: Int
delta = Int
maxtab Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
mintab
diff :: Int
diff = Int
delta Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
100 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
maxtab
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
enabled
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Int
delta Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
limAbs Bool -> Bool -> Bool
|| Int
diff Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
limRel
Int -> Maybe Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
maxtab
[(TabStop, Maybe Int)] -> Printer b -> Printer b
forall a. [(TabStop, Maybe Int)] -> Printer a -> Printer a
withTabStops [ (TabStop
name, Maybe Int
tab) ] Printer b
p
moduleName :: ModuleName a -> String
moduleName :: ModuleName a -> String
moduleName (ModuleName a
_ String
s) = String
s
prettyPragmas :: [ModulePragma NodeInfo] -> Printer ()
prettyPragmas :: [ModulePragma NodeInfo] -> Printer ()
prettyPragmas [ModulePragma NodeInfo]
ps = do
Bool
splitP <- (OptionConfig -> Bool) -> Printer Bool
forall a. (OptionConfig -> a) -> Printer a
getOption OptionConfig -> Bool
cfgOptionSplitLanguagePragmas
Bool
sortP <- (OptionConfig -> Bool) -> Printer Bool
forall a. (OptionConfig -> a) -> Printer a
getOption OptionConfig -> Bool
cfgOptionSortPragmas
let ps' :: [ModulePragma NodeInfo]
ps' = if Bool
splitP then (ModulePragma NodeInfo -> [ModulePragma NodeInfo])
-> [ModulePragma NodeInfo] -> [ModulePragma NodeInfo]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ModulePragma NodeInfo -> [ModulePragma NodeInfo]
forall l. ModulePragma l -> [ModulePragma l]
splitPragma [ModulePragma NodeInfo]
ps else [ModulePragma NodeInfo]
ps
let ps'' :: [ModulePragma NodeInfo]
ps'' = if Bool
sortP then (ModulePragma NodeInfo -> ModulePragma NodeInfo -> Ordering)
-> [ModulePragma NodeInfo] -> [ModulePragma NodeInfo]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ModulePragma NodeInfo -> ModulePragma NodeInfo -> Ordering
forall (ast :: * -> *).
(Functor ast, Ord (ast ())) =>
ast NodeInfo -> ast NodeInfo -> Ordering
compareAST [ModulePragma NodeInfo]
ps' else [ModulePragma NodeInfo]
ps'
Printer () -> [Printer ()] -> Printer ()
inter Printer ()
blankline ([Printer ()] -> Printer ())
-> ([[ModulePragma NodeInfo]] -> [Printer ()])
-> [[ModulePragma NodeInfo]]
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([ModulePragma NodeInfo] -> Printer ())
-> [[ModulePragma NodeInfo]] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map [ModulePragma NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
[ast NodeInfo] -> Printer ()
lined ([[ModulePragma NodeInfo]] -> Printer ())
-> [[ModulePragma NodeInfo]] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (ModulePragma NodeInfo -> ModulePragma NodeInfo -> Bool)
-> [ModulePragma NodeInfo] -> [[ModulePragma NodeInfo]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy ModulePragma NodeInfo -> ModulePragma NodeInfo -> Bool
forall l l. ModulePragma l -> ModulePragma l -> Bool
sameType [ModulePragma NodeInfo]
ps''
where
splitPragma :: ModulePragma l -> [ModulePragma l]
splitPragma (LanguagePragma l
anno [Name l]
langs) =
(Name l -> ModulePragma l) -> [Name l] -> [ModulePragma l]
forall a b. (a -> b) -> [a] -> [b]
map (l -> [Name l] -> ModulePragma l
forall l. l -> [Name l] -> ModulePragma l
LanguagePragma l
anno ([Name l] -> ModulePragma l)
-> (Name l -> [Name l]) -> Name l -> ModulePragma l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name l -> [Name l] -> [Name l]
forall a. a -> [a] -> [a]
: [])) [Name l]
langs
splitPragma ModulePragma l
p = [ ModulePragma l
p ]
sameType :: ModulePragma l -> ModulePragma l -> Bool
sameType LanguagePragma{} LanguagePragma{} = Bool
True
sameType OptionsPragma{} OptionsPragma{} = Bool
True
sameType AnnModulePragma{} AnnModulePragma{} = Bool
True
sameType ModulePragma l
_ ModulePragma l
_ = Bool
False
prettyImports :: [ImportDecl NodeInfo] -> Printer ()
prettyImports :: [ImportDecl NodeInfo] -> Printer ()
prettyImports [ImportDecl NodeInfo]
is = do
SortImportsRule
sortP <- (OptionConfig -> SortImportsRule) -> Printer SortImportsRule
forall a. (OptionConfig -> a) -> Printer a
getOption OptionConfig -> SortImportsRule
cfgOptionSortImports
Bool
alignModuleP <- (Config -> Bool) -> Printer Bool
forall b. (Config -> b) -> Printer b
getConfig (AlignConfig -> Bool
cfgAlignImportModule (AlignConfig -> Bool) -> (Config -> AlignConfig) -> Config -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> AlignConfig
cfgAlign)
Bool
alignSpecP <- (Config -> Bool) -> Printer Bool
forall b. (Config -> b) -> Printer b
getConfig (AlignConfig -> Bool
cfgAlignImportSpec (AlignConfig -> Bool) -> (Config -> AlignConfig) -> Config -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> AlignConfig
cfgAlign)
let maxNameLength :: Int
maxNameLength = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (ImportDecl NodeInfo -> Int) -> [ImportDecl NodeInfo] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int)
-> (ImportDecl NodeInfo -> String) -> ImportDecl NodeInfo -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName NodeInfo -> String
forall a. ModuleName a -> String
moduleName (ModuleName NodeInfo -> String)
-> (ImportDecl NodeInfo -> ModuleName NodeInfo)
-> ImportDecl NodeInfo
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImportDecl NodeInfo -> ModuleName NodeInfo
forall l. ImportDecl l -> ModuleName l
importModule) [ImportDecl NodeInfo]
is
alignModule :: Maybe Int
alignModule = if Bool
alignModuleP then Int -> Maybe Int
forall a. a -> Maybe a
Just Int
16 else Maybe Int
forall a. Maybe a
Nothing
alignSpec :: Maybe Int
alignSpec = if Bool
alignSpecP
then Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
alignModule Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
maxNameLength)
else Maybe Int
forall a. Maybe a
Nothing
[(TabStop, Maybe Int)] -> Printer () -> Printer ()
forall a. [(TabStop, Maybe Int)] -> Printer a -> Printer a
withTabStops [ (TabStop
stopImportModule, Maybe Int
alignModule)
, (TabStop
stopImportSpec, Maybe Int
alignSpec)
] (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ case SortImportsRule
sortP of
SortImportsRule
NoImportSort -> [ImportDecl NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
[ast NodeInfo] -> Printer ()
lined [ImportDecl NodeInfo]
is
SortImportsRule
SortImportsByPrefix -> [[ImportDecl NodeInfo]] -> Printer ()
prettyGroups ([[ImportDecl NodeInfo]] -> Printer ())
-> ([ImportDecl NodeInfo] -> [[ImportDecl NodeInfo]])
-> [ImportDecl NodeInfo]
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [ImportDecl NodeInfo] -> [[ImportDecl NodeInfo]]
forall a. Int -> [ImportDecl a] -> [[ImportDecl a]]
groupImports Int
0 ([ImportDecl NodeInfo] -> Printer ())
-> [ImportDecl NodeInfo] -> Printer ()
forall a b. (a -> b) -> a -> b
$ [ImportDecl NodeInfo] -> [ImportDecl NodeInfo]
forall a. [ImportDecl a] -> [ImportDecl a]
sortImports [ImportDecl NodeInfo]
is
SortImportsByGroups [ImportsGroup]
groups -> [[ImportDecl NodeInfo]] -> Printer ()
prettyGroups ([[ImportDecl NodeInfo]] -> Printer ())
-> [[ImportDecl NodeInfo]] -> Printer ()
forall a b. (a -> b) -> a -> b
$ [ImportsGroup] -> [ImportDecl NodeInfo] -> [[ImportDecl NodeInfo]]
forall a. [ImportsGroup] -> [ImportDecl a] -> [[ImportDecl a]]
splitImports [ImportsGroup]
groups [ImportDecl NodeInfo]
is
where
prettyGroups :: [[ImportDecl NodeInfo]] -> Printer ()
prettyGroups = Printer () -> [Printer ()] -> Printer ()
inter Printer ()
blankline ([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 (Printer () -> [Printer ()] -> Printer ()
inter 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 (Printer () -> Printer ()
forall a. Printer a -> Printer a
cut (Printer () -> Printer ())
-> (ImportDecl NodeInfo -> Printer ())
-> ImportDecl NodeInfo
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImportDecl NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty))
skipBlankAfterDecl :: Decl a -> Bool
skipBlankAfterDecl :: Decl a -> Bool
skipBlankAfterDecl Decl a
a = case Decl a
a of
TypeSig{} -> Bool
True
DeprPragmaDecl{} -> Bool
True
WarnPragmaDecl{} -> Bool
True
AnnPragma{} -> Bool
True
MinimalPragma{} -> Bool
True
InlineSig{} -> Bool
True
InlineConlikeSig{} -> Bool
True
SpecSig{} -> Bool
True
SpecInlineSig{} -> Bool
True
InstSig{} -> Bool
True
PatSynSig{} -> Bool
True
Decl a
_ -> Bool
False
skipBlankDecl :: Decl NodeInfo -> Decl NodeInfo -> Bool
skipBlankDecl :: Decl NodeInfo -> Decl NodeInfo -> Bool
skipBlankDecl Decl NodeInfo
a Decl NodeInfo
_ = Decl NodeInfo -> Bool
forall a. Decl a -> Bool
skipBlankAfterDecl Decl NodeInfo
a
skipBlankClassDecl :: ClassDecl NodeInfo -> ClassDecl NodeInfo -> Bool
skipBlankClassDecl :: ClassDecl NodeInfo -> ClassDecl NodeInfo -> Bool
skipBlankClassDecl ClassDecl NodeInfo
a ClassDecl NodeInfo
_ = case ClassDecl NodeInfo
a of
(ClsDecl NodeInfo
_ Decl NodeInfo
decl) -> Decl NodeInfo -> Bool
forall a. Decl a -> Bool
skipBlankAfterDecl Decl NodeInfo
decl
ClsTyDef{} -> Bool
True
ClsDefSig{} -> Bool
True
ClassDecl NodeInfo
_ -> Bool
False
skipBlankInstDecl :: InstDecl NodeInfo -> InstDecl NodeInfo -> Bool
skipBlankInstDecl :: InstDecl NodeInfo -> InstDecl NodeInfo -> Bool
skipBlankInstDecl InstDecl NodeInfo
a InstDecl NodeInfo
_ = case InstDecl NodeInfo
a of
(InsDecl NodeInfo
_ Decl NodeInfo
decl) -> Decl NodeInfo -> Bool
forall a. Decl a -> Bool
skipBlankAfterDecl Decl NodeInfo
decl
InstDecl NodeInfo
_ -> Bool
False
prettyDecls :: (Annotated ast, Pretty ast)
=> (ast NodeInfo -> ast NodeInfo -> Bool)
-> DeclarationConstruct
-> [ast NodeInfo]
-> Printer ()
prettyDecls :: (ast NodeInfo -> ast NodeInfo -> Bool)
-> DeclarationConstruct -> [ast NodeInfo] -> Printer ()
prettyDecls ast NodeInfo -> ast NodeInfo -> Bool
fn DeclarationConstruct
dc = Printer () -> [Printer ()] -> Printer ()
inter Printer ()
sep ([Printer ()] -> Printer ())
-> ([ast NodeInfo] -> [Printer ()]) -> [ast NodeInfo] -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([ast NodeInfo] -> Printer ()) -> [[ast NodeInfo]] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map [ast NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
[ast NodeInfo] -> Printer ()
lined ([[ast NodeInfo]] -> [Printer ()])
-> ([ast NodeInfo] -> [[ast NodeInfo]])
-> [ast NodeInfo]
-> [Printer ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ast NodeInfo -> ast NodeInfo -> Bool)
-> [ast NodeInfo] -> [[ast NodeInfo]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
runs ast NodeInfo -> ast NodeInfo -> Bool
fn
where
sep :: Printer ()
sep = Printer () -> Printer () -> Bool -> Printer ()
forall a. a -> a -> Bool -> a
bool Printer ()
blankline Printer ()
newline (Bool -> Printer ())
-> (Set DeclarationConstruct -> Bool)
-> Set DeclarationConstruct
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DeclarationConstruct -> Set DeclarationConstruct -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member DeclarationConstruct
dc
(Set DeclarationConstruct -> Printer ())
-> Printer (Set DeclarationConstruct) -> Printer ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (OptionConfig -> Set DeclarationConstruct)
-> Printer (Set DeclarationConstruct)
forall a. (OptionConfig -> a) -> Printer a
getOption OptionConfig -> Set DeclarationConstruct
cfgOptionDeclNoBlankLines
prettySimpleDecl :: (Annotated ast1, Pretty ast1, Annotated ast2, Pretty ast2)
=> ast1 NodeInfo
-> ByteString
-> ast2 NodeInfo
-> Printer ()
prettySimpleDecl :: ast1 NodeInfo -> ByteString -> ast2 NodeInfo -> Printer ()
prettySimpleDecl ast1 NodeInfo
lhs ByteString
op ast2 NodeInfo
rhs = (LayoutConfig -> Layout) -> Printer () -> Printer () -> Printer ()
forall a.
(LayoutConfig -> Layout) -> Printer a -> Printer a -> Printer a
withLayout LayoutConfig -> Layout
cfgLayoutDeclaration Printer ()
flex Printer ()
vertical
where
flex :: Printer ()
flex = do
ast1 NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty ast1 NodeInfo
lhs
LayoutContext -> ByteString -> Printer ()
operator LayoutContext
Declaration ByteString
op
ast2 NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty ast2 NodeInfo
rhs
vertical :: Printer ()
vertical = do
ast1 NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty ast1 NodeInfo
lhs
LayoutContext -> ByteString -> Printer ()
operatorV LayoutContext
Declaration ByteString
op
ast2 NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty ast2 NodeInfo
rhs
prettyConDecls :: (Annotated ast, Pretty ast) => [ast NodeInfo] -> Printer ()
prettyConDecls :: [ast NodeInfo] -> Printer ()
prettyConDecls [ast NodeInfo]
condecls = do
Bool
alignedConDecls <- (OptionConfig -> Bool) -> Printer Bool
forall a. (OptionConfig -> a) -> Printer a
getOption OptionConfig -> Bool
cfgOptionAlignSumTypeDecl
if Bool
alignedConDecls Bool -> Bool -> Bool
&& [ast NodeInfo] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ast NodeInfo]
condecls Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
then (LayoutConfig -> Layout) -> Printer () -> Printer () -> Printer ()
forall a.
(LayoutConfig -> Layout) -> Printer a -> Printer a -> Printer a
withLayout LayoutConfig -> Layout
cfgLayoutDeclaration Printer ()
flex' Printer ()
vertical'
else (LayoutConfig -> Layout) -> Printer () -> Printer () -> Printer ()
forall a.
(LayoutConfig -> Layout) -> Printer a -> Printer a -> Printer a
withLayout LayoutConfig -> Layout
cfgLayoutDeclaration Printer ()
flex Printer ()
vertical
where
flex :: Printer ()
flex = do
LayoutContext -> ByteString -> Printer ()
operator LayoutContext
Declaration ByteString
"="
(LayoutConfig -> Layout) -> Printer () -> Printer () -> Printer ()
forall a.
(LayoutConfig -> Layout) -> Printer a -> Printer a -> Printer a
withLayout LayoutConfig -> Layout
cfgLayoutConDecls Printer ()
flexDecls Printer ()
verticalDecls
flex' :: Printer ()
flex' = (LayoutConfig -> Layout) -> Printer () -> Printer () -> Printer ()
forall a.
(LayoutConfig -> Layout) -> Printer a -> Printer a -> Printer a
withLayout LayoutConfig -> Layout
cfgLayoutConDecls Printer ()
flexDecls' Printer ()
verticalDecls'
vertical :: Printer ()
vertical = do
LayoutContext -> ByteString -> Printer ()
operatorV LayoutContext
Declaration ByteString
"="
(LayoutConfig -> Layout) -> Printer () -> Printer () -> Printer ()
forall a.
(LayoutConfig -> Layout) -> Printer a -> Printer a -> Printer a
withLayout LayoutConfig -> Layout
cfgLayoutConDecls Printer ()
flexDecls Printer ()
verticalDecls
vertical' :: Printer ()
vertical' = (LayoutConfig -> Layout) -> Printer () -> Printer () -> Printer ()
forall a.
(LayoutConfig -> Layout) -> Printer a -> Printer a -> Printer a
withLayout LayoutConfig -> Layout
cfgLayoutConDecls Printer ()
flexDecls' Printer ()
verticalDecls'
flexDecls :: Printer ()
flexDecls = LayoutContext -> ByteString -> [ast NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
LayoutContext -> ByteString -> [ast NodeInfo] -> Printer ()
listAutoWrap' LayoutContext
Declaration ByteString
"|" [ast NodeInfo]
condecls
flexDecls' :: Printer ()
flexDecls' = Printer ()
horizontalDecls' Printer () -> Printer () -> Printer ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Printer ()
verticalDecls'
horizontalDecls' :: Printer ()
horizontalDecls' = do
LayoutContext -> ByteString -> Printer ()
operatorH LayoutContext
Declaration ByteString
"="
LayoutContext -> ByteString -> [ast NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
LayoutContext -> ByteString -> [ast NodeInfo] -> Printer ()
listH' LayoutContext
Declaration ByteString
"|" [ast NodeInfo]
condecls
verticalDecls :: Printer ()
verticalDecls = LayoutContext -> ByteString -> [ast NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
LayoutContext -> ByteString -> [ast NodeInfo] -> Printer ()
listV' LayoutContext
Declaration ByteString
"|" [ast NodeInfo]
condecls
verticalDecls' :: Printer ()
verticalDecls' = do
LayoutContext
-> ByteString
-> Printer ()
-> (Printer () -> Printer ())
-> Printer ()
forall a.
LayoutContext
-> ByteString
-> Printer ()
-> (Printer () -> Printer a)
-> Printer a
withOperatorFormattingV LayoutContext
Declaration ByteString
"|" (ByteString -> Printer ()
write ByteString
"=") Printer () -> Printer ()
forall a. a -> a
id
LayoutContext -> ByteString -> [ast NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
LayoutContext -> ByteString -> [ast NodeInfo] -> Printer ()
listV' LayoutContext
Declaration ByteString
"|" [ast NodeInfo]
condecls
prettyForall :: (Annotated ast, Pretty ast) => [ast NodeInfo] -> Printer ()
prettyForall :: [ast NodeInfo] -> Printer ()
prettyForall [ast NodeInfo]
vars = do
ByteString -> Printer ()
write ByteString
"forall "
Printer () -> [Printer ()] -> Printer ()
inter Printer ()
space ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (ast NodeInfo -> Printer ()) -> [ast NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map ast NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty [ast NodeInfo]
vars
LayoutContext -> ByteString -> Printer ()
operator LayoutContext
Type ByteString
"."
prettyTypesig :: (Annotated ast, Pretty ast)
=> LayoutContext
-> [ast NodeInfo]
-> Type NodeInfo
-> Printer ()
prettyTypesig :: LayoutContext -> [ast NodeInfo] -> Type NodeInfo -> Printer ()
prettyTypesig LayoutContext
ctx [ast NodeInfo]
names Type NodeInfo
ty = do
Printer () -> [Printer ()] -> Printer ()
inter Printer ()
comma ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (ast NodeInfo -> Printer ()) -> [ast NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map ast NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty [ast NodeInfo]
names
TabStop -> Printer ()
atTabStop TabStop
stopRecordField
(IndentConfig -> Indent)
-> Printer () -> (Int -> Printer ()) -> Printer ()
forall a.
(IndentConfig -> Indent)
-> Printer a -> (Int -> Printer a) -> Printer a
withIndentConfig IndentConfig -> Indent
cfgIndentTypesig Printer ()
align Int -> Printer ()
indentby
where
align :: Printer ()
align = Printer () -> Printer ()
forall a. Printer a -> Printer a
onside (Printer () -> Printer ())
-> (Printer () -> Printer ()) -> Printer () -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutContext -> ByteString -> Printer () -> Printer ()
forall a. LayoutContext -> ByteString -> Printer a -> Printer a
alignOnOperator LayoutContext
ctx ByteString
"::" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty
indentby :: Int -> Printer ()
indentby Int
i = Int -> Printer () -> Printer ()
forall a. Int -> Printer a -> Printer a
indented Int
i (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
LayoutContext -> ByteString -> Printer ()
operator LayoutContext
ctx ByteString
"::"
Bool
nl <- (PrintState -> Bool) -> Printer Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Bool
psNewline
Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
nl (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
Int
delta <- LayoutContext -> ByteString -> Printer Int
listVOpLen LayoutContext
ctx ByteString
"->"
ByteString -> Printer ()
write (ByteString -> Printer ()) -> ByteString -> Printer ()
forall a b. (a -> b) -> a -> b
$ Int -> Word8 -> ByteString
BS.replicate Int
delta Word8
32
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty
prettyApp :: (Annotated ast1, Annotated ast2, Pretty ast1, Pretty ast2)
=> ast1 NodeInfo
-> [ast2 NodeInfo]
-> Printer ()
prettyApp :: ast1 NodeInfo -> [ast2 NodeInfo] -> Printer ()
prettyApp ast1 NodeInfo
fn [ast2 NodeInfo]
args = (LayoutConfig -> Layout) -> Printer () -> Printer () -> Printer ()
forall a.
(LayoutConfig -> Layout) -> Printer a -> Printer a -> Printer a
withLayout LayoutConfig -> Layout
cfgLayoutApp Printer ()
flex Printer ()
vertical
where
flex :: Printer ()
flex = do
ast1 NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty ast1 NodeInfo
fn
[ast2 NodeInfo] -> (ast2 NodeInfo -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ast2 NodeInfo]
args ((ast2 NodeInfo -> Printer ()) -> Printer ())
-> (ast2 NodeInfo -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \ast2 NodeInfo
arg -> Printer () -> Printer ()
forall a. Printer a -> Printer a
cut (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
Printer ()
spaceOrNewline
ast2 NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty ast2 NodeInfo
arg
vertical :: Printer ()
vertical = do
ast1 NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty ast1 NodeInfo
fn
(IndentConfig -> Indent) -> Printer () -> Printer ()
forall a. (IndentConfig -> Indent) -> Printer a -> Printer a
withIndent IndentConfig -> Indent
cfgIndentApp (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ [ast2 NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
[ast NodeInfo] -> Printer ()
lined [ast2 NodeInfo]
args
prettyInfixApp
:: (Annotated ast, Pretty ast, Annotated op, HSE.Pretty (op NodeInfo))
=> (op NodeInfo -> ByteString)
-> LayoutContext
-> (ast NodeInfo, [(op NodeInfo, ast NodeInfo)])
-> Printer ()
prettyInfixApp :: (op NodeInfo -> ByteString)
-> LayoutContext
-> (ast NodeInfo, [(op NodeInfo, ast NodeInfo)])
-> Printer ()
prettyInfixApp op NodeInfo -> ByteString
nameFn LayoutContext
ctx (ast NodeInfo
lhs, [(op NodeInfo, ast NodeInfo)]
args) =
(LayoutConfig -> Layout) -> Printer () -> Printer () -> Printer ()
forall a.
(LayoutConfig -> Layout) -> Printer a -> Printer a -> Printer a
withLayout LayoutConfig -> Layout
cfgLayoutInfixApp Printer ()
flex Printer ()
vertical
where
flex :: Printer ()
flex = do
ast NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty ast NodeInfo
lhs
[(op NodeInfo, ast NodeInfo)]
-> ((op NodeInfo, ast NodeInfo) -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(op NodeInfo, ast NodeInfo)]
args (((op NodeInfo, ast NodeInfo) -> Printer ()) -> Printer ())
-> ((op NodeInfo, ast NodeInfo) -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \(op NodeInfo
op, ast NodeInfo
arg) -> Printer () -> Printer ()
forall a. Printer a -> Printer a
cut (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
LayoutContext
-> ByteString
-> Printer ()
-> (Printer () -> Printer ())
-> Printer ()
forall a.
LayoutContext
-> ByteString
-> Printer ()
-> (Printer () -> Printer a)
-> Printer a
withOperatorFormatting LayoutContext
ctx (op NodeInfo -> ByteString
nameFn op NodeInfo
op) (op NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
prettyOp op NodeInfo
op) Printer () -> Printer ()
forall a. a -> a
id
ast NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty ast NodeInfo
arg
vertical :: Printer ()
vertical = do
ast NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty ast NodeInfo
lhs
[(op NodeInfo, ast NodeInfo)]
-> ((op NodeInfo, ast NodeInfo) -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(op NodeInfo, ast NodeInfo)]
args (((op NodeInfo, ast NodeInfo) -> Printer ()) -> Printer ())
-> ((op NodeInfo, ast NodeInfo) -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \(op NodeInfo
op, ast NodeInfo
arg) -> do
LayoutContext
-> ByteString
-> Printer ()
-> (Printer () -> Printer ())
-> Printer ()
forall a.
LayoutContext
-> ByteString
-> Printer ()
-> (Printer () -> Printer a)
-> Printer a
withOperatorFormattingV LayoutContext
ctx (op NodeInfo -> ByteString
nameFn op NodeInfo
op) (op NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
prettyOp op NodeInfo
op) Printer () -> Printer ()
forall a. a -> a
id
ast NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty ast NodeInfo
arg
prettyOp :: ast NodeInfo -> Printer ()
prettyOp ast NodeInfo
op = do
Location -> ast NodeInfo -> Printer ()
forall (ast :: * -> *).
Annotated ast =>
Location -> ast NodeInfo -> Printer ()
printComments Location
Before ast NodeInfo
op
ast NodeInfo -> Printer ()
forall (ast :: * -> *).
Pretty (ast NodeInfo) =>
ast NodeInfo -> Printer ()
prettyHSE ast NodeInfo
op
Location -> ast NodeInfo -> Printer ()
forall (ast :: * -> *).
Annotated ast =>
Location -> ast NodeInfo -> Printer ()
printComments Location
After ast NodeInfo
op
prettyRecord :: (Annotated ast1, Pretty ast1, Annotated ast2, Pretty ast2)
=> (ast2 NodeInfo -> Printer (Maybe Int))
-> LayoutContext
-> ast1 NodeInfo
-> [ast2 NodeInfo]
-> Printer ()
prettyRecord :: (ast2 NodeInfo -> Printer (Maybe Int))
-> LayoutContext -> ast1 NodeInfo -> [ast2 NodeInfo] -> Printer ()
prettyRecord ast2 NodeInfo -> Printer (Maybe Int)
len LayoutContext
ctx ast1 NodeInfo
name [ast2 NodeInfo]
fields = (LayoutConfig -> Layout) -> Printer () -> Printer () -> Printer ()
forall a.
(LayoutConfig -> Layout) -> Printer a -> Printer a -> Printer a
withLayout LayoutConfig -> Layout
cfgLayoutRecord Printer ()
flex Printer ()
vertical
where
flex :: Printer ()
flex = do
LayoutContext
-> ByteString
-> Printer ()
-> (Printer () -> Printer ())
-> Printer ()
forall a.
LayoutContext
-> ByteString
-> Printer ()
-> (Printer () -> Printer a)
-> Printer a
withOperatorFormattingH LayoutContext
ctx ByteString
"record" (ast1 NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty ast1 NodeInfo
name) Printer () -> Printer ()
forall a. a -> a
id
(ast2 NodeInfo -> Printer (Maybe Int))
-> LayoutContext -> [ast2 NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
(ast NodeInfo -> Printer (Maybe Int))
-> LayoutContext -> [ast NodeInfo] -> Printer ()
prettyRecordFields ast2 NodeInfo -> Printer (Maybe Int)
len LayoutContext
ctx [ast2 NodeInfo]
fields
vertical :: Printer ()
vertical = do
LayoutContext
-> ByteString
-> Printer ()
-> (Printer () -> Printer ())
-> Printer ()
forall a.
LayoutContext
-> ByteString
-> Printer ()
-> (Printer () -> Printer a)
-> Printer a
withOperatorFormatting LayoutContext
ctx ByteString
"record" (ast1 NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty ast1 NodeInfo
name) Printer () -> Printer ()
forall a. a -> a
id
(ast2 NodeInfo -> Printer (Maybe Int))
-> LayoutContext -> [ast2 NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
(ast NodeInfo -> Printer (Maybe Int))
-> LayoutContext -> [ast NodeInfo] -> Printer ()
prettyRecordFields ast2 NodeInfo -> Printer (Maybe Int)
len LayoutContext
ctx [ast2 NodeInfo]
fields
prettyRecordFields :: (Annotated ast, Pretty ast)
=> (ast NodeInfo -> Printer (Maybe Int))
-> LayoutContext
-> [ast NodeInfo]
-> Printer ()
prettyRecordFields :: (ast NodeInfo -> Printer (Maybe Int))
-> LayoutContext -> [ast NodeInfo] -> Printer ()
prettyRecordFields ast NodeInfo -> Printer (Maybe Int)
len LayoutContext
ctx [ast NodeInfo]
fields = (LayoutConfig -> Layout) -> Printer () -> Printer () -> Printer ()
forall a.
(LayoutConfig -> Layout) -> Printer a -> Printer a -> Printer a
withLayout LayoutConfig -> Layout
cfgLayoutRecord Printer ()
flex Printer ()
vertical
where
flex :: Printer ()
flex = LayoutContext
-> ByteString -> ByteString -> Printer () -> Printer ()
groupH LayoutContext
ctx ByteString
"{" ByteString
"}" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Printer () -> [Printer ()] -> Printer ()
inter (LayoutContext -> ByteString -> Printer ()
operatorH LayoutContext
ctx ByteString
",") ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$
(ast NodeInfo -> Printer ()) -> [ast NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map ast NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
prettyOnside [ast NodeInfo]
fields
vertical :: Printer ()
vertical = LayoutContext
-> ByteString -> ByteString -> Printer () -> Printer ()
groupV LayoutContext
ctx ByteString
"{" ByteString
"}" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$
TabStop
-> (AlignConfig -> Bool)
-> (ast NodeInfo -> Printer (Maybe [Int]))
-> [ast NodeInfo]
-> Printer ()
-> Printer ()
forall a b.
TabStop
-> (AlignConfig -> Bool)
-> (a -> Printer (Maybe [Int]))
-> [a]
-> Printer b
-> Printer b
withComputedTabStop TabStop
stopRecordField
AlignConfig -> Bool
cfgAlignRecordFields
((Maybe Int -> Maybe [Int])
-> Printer (Maybe Int) -> Printer (Maybe [Int])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int -> [Int]) -> Maybe Int -> Maybe [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> [Int]
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (Printer (Maybe Int) -> Printer (Maybe [Int]))
-> (ast NodeInfo -> Printer (Maybe Int))
-> ast NodeInfo
-> Printer (Maybe [Int])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ast NodeInfo -> Printer (Maybe Int)
len)
[ast NodeInfo]
fields (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ LayoutContext -> ByteString -> [ast NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
LayoutContext -> ByteString -> [ast NodeInfo] -> Printer ()
listVinternal LayoutContext
ctx ByteString
"," [ast NodeInfo]
fields
prettyPragma :: ByteString -> Printer () -> Printer ()
prettyPragma :: ByteString -> Printer () -> Printer ()
prettyPragma ByteString
name = ByteString -> Maybe (Printer ()) -> Printer ()
prettyPragma' ByteString
name (Maybe (Printer ()) -> Printer ())
-> (Printer () -> Maybe (Printer ())) -> Printer () -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Printer () -> Maybe (Printer ())
forall a. a -> Maybe a
Just
prettyPragma' :: ByteString -> Maybe (Printer ()) -> Printer ()
prettyPragma' :: ByteString -> Maybe (Printer ()) -> Printer ()
prettyPragma' ByteString
name Maybe (Printer ())
mp = do
ByteString -> Printer ()
write ByteString
"{-# "
ByteString -> Printer ()
write ByteString
name
Maybe (Printer ()) -> (Printer () -> Printer ()) -> Printer ()
forall a. Maybe a -> (a -> Printer ()) -> Printer ()
mayM_ Maybe (Printer ())
mp ((Printer () -> Printer ()) -> Printer ())
-> (Printer () -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ Printer ()
-> (Printer () -> Printer ()) -> Printer () -> Printer ()
forall (f :: * -> *) a x b.
Applicative f =>
f a -> (x -> f b) -> x -> f b
withPrefix Printer ()
space Printer () -> Printer ()
forall a. Printer a -> Printer a
aligned
ByteString -> Printer ()
write ByteString
" #-}"
prettyBinds :: Binds NodeInfo -> Printer ()
prettyBinds :: Binds NodeInfo -> Printer ()
prettyBinds Binds NodeInfo
binds = (IndentConfig -> Int) -> Printer () -> Printer ()
forall a. (IndentConfig -> Int) -> Printer a -> Printer a
withIndentBy IndentConfig -> Int
cfgIndentWhere (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
ByteString -> Printer ()
write ByteString
"where"
(IndentConfig -> Indent) -> Printer () -> Printer ()
forall a. (IndentConfig -> Indent) -> Printer a -> Printer a
withIndent IndentConfig -> Indent
cfgIndentWhereBinds (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Binds NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Binds NodeInfo
binds
instance Pretty Module where
prettyPrint :: Module NodeInfo -> Printer ()
prettyPrint (Module NodeInfo
_ Maybe (ModuleHead NodeInfo)
mhead [ModulePragma NodeInfo]
pragmas [ImportDecl NodeInfo]
imports [Decl NodeInfo]
decls) = Printer () -> [Printer ()] -> Printer ()
inter Printer ()
blankline ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$
[Maybe (Printer ())] -> [Printer ()]
forall a. [Maybe a] -> [a]
catMaybes [ ([ModulePragma NodeInfo] -> Printer ())
-> [ModulePragma NodeInfo] -> Maybe (Printer ())
forall (t :: * -> *) a a.
Foldable t =>
(t a -> a) -> t a -> Maybe a
ifNotEmpty [ModulePragma NodeInfo] -> Printer ()
prettyPragmas [ModulePragma NodeInfo]
pragmas
, ModuleHead NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty (ModuleHead NodeInfo -> Printer ())
-> Maybe (ModuleHead NodeInfo) -> Maybe (Printer ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (ModuleHead NodeInfo)
mhead
, ([ImportDecl NodeInfo] -> Printer ())
-> [ImportDecl NodeInfo] -> Maybe (Printer ())
forall (t :: * -> *) a a.
Foldable t =>
(t a -> a) -> t a -> Maybe a
ifNotEmpty [ImportDecl NodeInfo] -> Printer ()
prettyImports [ImportDecl NodeInfo]
imports
, ([Decl NodeInfo] -> Printer ())
-> [Decl NodeInfo] -> Maybe (Printer ())
forall (t :: * -> *) a a.
Foldable t =>
(t a -> a) -> t a -> Maybe a
ifNotEmpty ((Decl NodeInfo -> Decl NodeInfo -> Bool)
-> DeclarationConstruct -> [Decl NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
(ast NodeInfo -> ast NodeInfo -> Bool)
-> DeclarationConstruct -> [ast NodeInfo] -> Printer ()
prettyDecls Decl NodeInfo -> Decl NodeInfo -> Bool
skipBlankDecl DeclarationConstruct
DeclModule) [Decl NodeInfo]
decls
]
where
ifNotEmpty :: (t a -> a) -> t a -> Maybe a
ifNotEmpty t a -> a
f t a
xs = if t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
xs then Maybe a
forall a. Maybe a
Nothing else a -> Maybe a
forall a. a -> Maybe a
Just (t a -> a
f t a
xs)
prettyPrint ast :: Module NodeInfo
ast@XmlPage{} = Module NodeInfo -> Printer ()
forall (ast :: * -> *).
Pretty (ast NodeInfo) =>
ast NodeInfo -> Printer ()
prettyHSE Module NodeInfo
ast
prettyPrint ast :: Module NodeInfo
ast@XmlHybrid{} = Module NodeInfo -> Printer ()
forall (ast :: * -> *).
Pretty (ast NodeInfo) =>
ast NodeInfo -> Printer ()
prettyHSE Module NodeInfo
ast
instance Pretty ModuleHead where
prettyPrint :: ModuleHead NodeInfo -> Printer ()
prettyPrint (ModuleHead NodeInfo
_ ModuleName NodeInfo
name Maybe (WarningText NodeInfo)
mwarning Maybe (ExportSpecList NodeInfo)
mexports) = do
ByteString -> Printer () -> Printer ()
forall a. ByteString -> Printer a -> Printer a
depend ByteString
"module" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
ModuleName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty ModuleName NodeInfo
name
Maybe (WarningText NodeInfo)
-> (WarningText NodeInfo -> Printer ()) -> Printer ()
forall a. Maybe a -> (a -> Printer ()) -> Printer ()
mayM_ Maybe (WarningText NodeInfo)
mwarning ((WarningText NodeInfo -> Printer ()) -> Printer ())
-> (WarningText NodeInfo -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ Printer ()
-> (WarningText NodeInfo -> Printer ())
-> WarningText NodeInfo
-> Printer ()
forall (f :: * -> *) a x b.
Applicative f =>
f a -> (x -> f b) -> x -> f b
withPrefix Printer ()
spaceOrNewline WarningText NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty
(LayoutConfig -> Layout) -> Printer () -> Printer () -> Printer ()
forall a.
(LayoutConfig -> Layout) -> Printer a -> Printer a -> Printer a
withLayout LayoutConfig -> Layout
cfgLayoutExportSpecList Printer ()
flex Printer ()
vertical
where
flex :: Printer ()
flex = do
Maybe (ExportSpecList NodeInfo)
-> (ExportSpecList NodeInfo -> Printer ()) -> Printer ()
forall a. Maybe a -> (a -> Printer ()) -> Printer ()
mayM_ Maybe (ExportSpecList NodeInfo)
mexports ((ExportSpecList NodeInfo -> Printer ()) -> Printer ())
-> (ExportSpecList NodeInfo -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \(ExportSpecList NodeInfo
_ [ExportSpec NodeInfo]
exports) -> do
Printer ()
space
LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [ExportSpec NodeInfo]
-> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [ast NodeInfo]
-> Printer ()
listAutoWrap LayoutContext
Other ByteString
"(" ByteString
")" ByteString
"," [ExportSpec NodeInfo]
exports
ByteString -> Printer ()
write ByteString
" where"
vertical :: Printer ()
vertical = do
Maybe (ExportSpecList NodeInfo)
-> (ExportSpecList NodeInfo -> Printer ()) -> Printer ()
forall a. Maybe a -> (a -> Printer ()) -> Printer ()
mayM_ Maybe (ExportSpecList NodeInfo)
mexports ((ExportSpecList NodeInfo -> Printer ()) -> Printer ())
-> (ExportSpecList NodeInfo -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \(ExportSpecList NodeInfo
_ [ExportSpec NodeInfo]
exports) -> do
(IndentConfig -> Indent) -> Printer () -> Printer ()
forall a. (IndentConfig -> Indent) -> Printer a -> Printer a
withIndent IndentConfig -> Indent
cfgIndentExportSpecList (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$
LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [ExportSpec NodeInfo]
-> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [ast NodeInfo]
-> Printer ()
listV LayoutContext
Other ByteString
"(" ByteString
")" ByteString
"," [ExportSpec NodeInfo]
exports
ByteString -> Printer ()
write ByteString
" where"
instance Pretty WarningText where
prettyPrint :: WarningText NodeInfo -> Printer ()
prettyPrint (DeprText NodeInfo
_ String
s) = ByteString -> Printer ()
write ByteString
"{-# DEPRECATED " Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Printer ()
string (String -> String
forall a. Show a => a -> String
show String
s)
Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Printer ()
write ByteString
" #-}"
prettyPrint (WarnText NodeInfo
_ String
s) = ByteString -> Printer ()
write ByteString
"{-# WARNING " Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Printer ()
string (String -> String
forall a. Show a => a -> String
show String
s)
Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Printer ()
write ByteString
" #-}"
instance Pretty ExportSpec
instance Pretty ImportDecl where
prettyPrint :: ImportDecl NodeInfo -> Printer ()
prettyPrint ImportDecl{Bool
Maybe String
Maybe (ModuleName NodeInfo)
Maybe (ImportSpecList NodeInfo)
ModuleName NodeInfo
NodeInfo
importAnn :: forall l. ImportDecl l -> l
importQualified :: forall l. ImportDecl l -> Bool
importSrc :: forall l. ImportDecl l -> Bool
importSafe :: forall l. ImportDecl l -> Bool
importPkg :: forall l. ImportDecl l -> Maybe String
importAs :: forall l. ImportDecl l -> Maybe (ModuleName l)
importSpecs :: forall l. ImportDecl l -> Maybe (ImportSpecList l)
importSpecs :: Maybe (ImportSpecList NodeInfo)
importAs :: Maybe (ModuleName NodeInfo)
importPkg :: Maybe String
importSafe :: Bool
importSrc :: Bool
importQualified :: Bool
importModule :: ModuleName NodeInfo
importAnn :: NodeInfo
importModule :: forall l. ImportDecl l -> ModuleName l
..} = do
Printer () -> [Printer ()] -> Printer ()
inter Printer ()
space ([Printer ()] -> Printer ())
-> ([String] -> [Printer ()]) -> [String] -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Printer ()) -> [String] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map String -> Printer ()
string ([String] -> Printer ()) -> [String] -> Printer ()
forall a b. (a -> b) -> a -> b
$
(String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null)
[ String
"import"
, if Bool
importSrc then String
"{-# SOURCE #-}" else String
""
, if Bool
importSafe then String
"safe" else String
""
, if Bool
importQualified then String
"qualified" else String
""
, String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" String -> String
forall a. Show a => a -> String
show Maybe String
importPkg
]
TabStop -> Printer ()
atTabStop TabStop
stopImportModule
Printer ()
space
String -> Printer ()
string (String -> Printer ()) -> String -> Printer ()
forall a b. (a -> b) -> a -> b
$ ModuleName NodeInfo -> String
forall a. ModuleName a -> String
moduleName ModuleName NodeInfo
importModule
Maybe (ModuleName NodeInfo)
-> (ModuleName NodeInfo -> Printer ()) -> Printer ()
forall a. Maybe a -> (a -> Printer ()) -> Printer ()
mayM_ Maybe (ModuleName NodeInfo)
importAs ((ModuleName NodeInfo -> Printer ()) -> Printer ())
-> (ModuleName NodeInfo -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \ModuleName NodeInfo
name -> do
TabStop -> Printer ()
atTabStop TabStop
stopImportSpec
ByteString -> Printer ()
write ByteString
" as "
ModuleName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty ModuleName NodeInfo
name
Maybe (ImportSpecList NodeInfo)
-> (ImportSpecList NodeInfo -> Printer ()) -> Printer ()
forall a. Maybe a -> (a -> Printer ()) -> Printer ()
mayM_ Maybe (ImportSpecList NodeInfo)
importSpecs ImportSpecList NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty
instance Pretty ImportSpecList where
prettyPrint :: ImportSpecList NodeInfo -> Printer ()
prettyPrint (ImportSpecList NodeInfo
_ Bool
hiding [ImportSpec NodeInfo]
specs) = do
Bool
sortP <- (OptionConfig -> Bool) -> Printer Bool
forall a. (OptionConfig -> a) -> Printer a
getOption OptionConfig -> Bool
cfgOptionSortImportLists
let specs' :: [ImportSpec NodeInfo]
specs' = if Bool
sortP then (ImportSpec NodeInfo -> String)
-> [ImportSpec NodeInfo] -> [ImportSpec NodeInfo]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn ImportSpec NodeInfo -> String
forall a. Pretty a => a -> String
HSE.prettyPrint [ImportSpec NodeInfo]
specs else [ImportSpec NodeInfo]
specs
TabStop -> Printer ()
atTabStop TabStop
stopImportSpec
(LayoutConfig -> Layout) -> Printer () -> Printer () -> Printer ()
forall a.
(LayoutConfig -> Layout) -> Printer a -> Printer a -> Printer a
withLayout LayoutConfig -> Layout
cfgLayoutImportSpecList ([ImportSpec NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
[ast NodeInfo] -> Printer ()
flex [ImportSpec NodeInfo]
specs') ([ImportSpec NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
[ast NodeInfo] -> Printer ()
vertical [ImportSpec NodeInfo]
specs')
where
flex :: [ast NodeInfo] -> Printer ()
flex [ast NodeInfo]
imports = (IndentConfig -> Indent) -> Printer () -> Printer ()
forall a. (IndentConfig -> Indent) -> Printer a -> Printer a
withIndentFlex IndentConfig -> Indent
cfgIndentImportSpecList (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ 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
$ ByteString -> Printer ()
write ByteString
"hiding "
LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [ast NodeInfo]
-> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [ast NodeInfo]
-> Printer ()
listAutoWrap LayoutContext
Other ByteString
"(" ByteString
")" ByteString
"," [ast NodeInfo]
imports
vertical :: [ast NodeInfo] -> Printer ()
vertical [ast NodeInfo]
imports = (IndentConfig -> Indent) -> Printer () -> Printer ()
forall a. (IndentConfig -> Indent) -> Printer a -> Printer a
withIndent IndentConfig -> Indent
cfgIndentImportSpecList (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ 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
$ ByteString -> Printer ()
write ByteString
"hiding "
LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [ast NodeInfo]
-> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [ast NodeInfo]
-> Printer ()
listV LayoutContext
Other ByteString
"(" ByteString
")" ByteString
"," [ast NodeInfo]
imports
instance Pretty ImportSpec
instance Pretty Assoc
instance Pretty Decl where
prettyPrint :: Decl NodeInfo -> Printer ()
prettyPrint (TypeDecl NodeInfo
_ DeclHead NodeInfo
declhead Type NodeInfo
ty) =
ByteString -> Printer () -> Printer ()
forall a. ByteString -> Printer a -> Printer a
depend ByteString
"type" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ DeclHead NodeInfo -> ByteString -> Type NodeInfo -> Printer ()
forall (ast1 :: * -> *) (ast2 :: * -> *).
(Annotated ast1, Pretty ast1, Annotated ast2, Pretty ast2) =>
ast1 NodeInfo -> ByteString -> ast2 NodeInfo -> Printer ()
prettySimpleDecl DeclHead NodeInfo
declhead ByteString
"=" Type NodeInfo
ty
prettyPrint (TypeFamDecl NodeInfo
_ DeclHead NodeInfo
declhead Maybe (ResultSig NodeInfo)
mresultsig Maybe (InjectivityInfo NodeInfo)
minjectivityinfo) =
ByteString -> Printer () -> Printer ()
forall a. ByteString -> Printer a -> Printer a
depend ByteString
"type family" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
DeclHead NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty DeclHead NodeInfo
declhead
Maybe (ResultSig NodeInfo)
-> (ResultSig NodeInfo -> Printer ()) -> Printer ()
forall a. Maybe a -> (a -> Printer ()) -> Printer ()
mayM_ Maybe (ResultSig NodeInfo)
mresultsig ResultSig NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty
Maybe (InjectivityInfo NodeInfo)
-> (InjectivityInfo NodeInfo -> Printer ()) -> Printer ()
forall a. Maybe a -> (a -> Printer ()) -> Printer ()
mayM_ Maybe (InjectivityInfo NodeInfo)
minjectivityinfo InjectivityInfo NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty
prettyPrint (ClosedTypeFamDecl NodeInfo
_
DeclHead NodeInfo
declhead
Maybe (ResultSig NodeInfo)
mresultsig
Maybe (InjectivityInfo NodeInfo)
minjectivityinfo
[TypeEqn NodeInfo]
typeeqns) = ByteString -> Printer () -> Printer ()
forall a. ByteString -> Printer a -> Printer a
depend ByteString
"type family" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
DeclHead NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty DeclHead NodeInfo
declhead
Maybe (ResultSig NodeInfo)
-> (ResultSig NodeInfo -> Printer ()) -> Printer ()
forall a. Maybe a -> (a -> Printer ()) -> Printer ()
mayM_ Maybe (ResultSig NodeInfo)
mresultsig ResultSig NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty
Maybe (InjectivityInfo NodeInfo)
-> (InjectivityInfo NodeInfo -> Printer ()) -> Printer ()
forall a. Maybe a -> (a -> Printer ()) -> Printer ()
mayM_ Maybe (InjectivityInfo NodeInfo)
minjectivityinfo InjectivityInfo NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty
ByteString -> Printer ()
write ByteString
" where"
Printer ()
newline
[TypeEqn NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
[ast NodeInfo] -> Printer ()
linedOnside [TypeEqn NodeInfo]
typeeqns
prettyPrint (DataDecl NodeInfo
_ DataOrNew NodeInfo
dataornew Maybe (Context NodeInfo)
mcontext DeclHead NodeInfo
declhead [QualConDecl NodeInfo]
qualcondecls [Deriving NodeInfo]
derivings) = do
Printer () -> Printer () -> Printer ()
forall a. Printer () -> Printer a -> Printer a
depend' (DataOrNew NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty DataOrNew NodeInfo
dataornew) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
(Context NodeInfo -> Printer ())
-> Maybe (Context NodeInfo) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Context NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Maybe (Context NodeInfo)
mcontext
DeclHead NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty DeclHead NodeInfo
declhead
Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([QualConDecl NodeInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [QualConDecl NodeInfo]
qualcondecls) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ [QualConDecl NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
[ast NodeInfo] -> Printer ()
prettyConDecls [QualConDecl NodeInfo]
qualcondecls
(Deriving NodeInfo -> Printer ())
-> [Deriving NodeInfo] -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Deriving NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty [Deriving NodeInfo]
derivings
prettyPrint (GDataDecl NodeInfo
_
DataOrNew NodeInfo
dataornew
Maybe (Context NodeInfo)
mcontext
DeclHead NodeInfo
declhead
Maybe (Type NodeInfo)
mkind
[GadtDecl NodeInfo]
gadtdecls
[Deriving NodeInfo]
derivings) = do
Printer () -> Printer () -> Printer ()
forall a. Printer () -> Printer a -> Printer a
depend' (DataOrNew NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty DataOrNew NodeInfo
dataornew) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
(Context NodeInfo -> Printer ())
-> Maybe (Context NodeInfo) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Context NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Maybe (Context NodeInfo)
mcontext
DeclHead NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty DeclHead NodeInfo
declhead
Maybe (Type NodeInfo)
-> (Type NodeInfo -> Printer ()) -> Printer ()
forall a. Maybe a -> (a -> Printer ()) -> Printer ()
mayM_ Maybe (Type NodeInfo)
mkind ((Type NodeInfo -> Printer ()) -> Printer ())
-> (Type NodeInfo -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \Type NodeInfo
kind -> do
LayoutContext -> ByteString -> Printer ()
operator LayoutContext
Declaration ByteString
"::"
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
kind
ByteString -> Printer ()
write ByteString
" where"
Printer ()
newline
[GadtDecl NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
[ast NodeInfo] -> Printer ()
linedOnside [GadtDecl NodeInfo]
gadtdecls
(Deriving NodeInfo -> Printer ())
-> [Deriving NodeInfo] -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Deriving NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty [Deriving NodeInfo]
derivings
prettyPrint (DataFamDecl NodeInfo
_ Maybe (Context NodeInfo)
mcontext DeclHead NodeInfo
declhead Maybe (ResultSig NodeInfo)
mresultsig) =
ByteString -> Printer () -> Printer ()
forall a. ByteString -> Printer a -> Printer a
depend ByteString
"data family" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
(Context NodeInfo -> Printer ())
-> Maybe (Context NodeInfo) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Context NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Maybe (Context NodeInfo)
mcontext
DeclHead NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty DeclHead NodeInfo
declhead
(ResultSig NodeInfo -> Printer ())
-> Maybe (ResultSig NodeInfo) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ResultSig NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Maybe (ResultSig NodeInfo)
mresultsig
prettyPrint (TypeInsDecl NodeInfo
_ Type NodeInfo
ty Type NodeInfo
ty') =
ByteString -> Printer () -> Printer ()
forall a. ByteString -> Printer a -> Printer a
depend ByteString
"type instance" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Type NodeInfo -> ByteString -> Type NodeInfo -> Printer ()
forall (ast1 :: * -> *) (ast2 :: * -> *).
(Annotated ast1, Pretty ast1, Annotated ast2, Pretty ast2) =>
ast1 NodeInfo -> ByteString -> ast2 NodeInfo -> Printer ()
prettySimpleDecl Type NodeInfo
ty ByteString
"=" Type NodeInfo
ty'
prettyPrint (DataInsDecl NodeInfo
_ DataOrNew NodeInfo
dataornew Type NodeInfo
ty [QualConDecl NodeInfo]
qualcondecls [Deriving NodeInfo]
derivings) = do
Printer () -> Printer () -> Printer ()
forall a. Printer () -> Printer a -> Printer a
depend' (DataOrNew NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty DataOrNew NodeInfo
dataornew Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Printer ()
write ByteString
" instance") (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty
[QualConDecl NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
[ast NodeInfo] -> Printer ()
prettyConDecls [QualConDecl NodeInfo]
qualcondecls
(Deriving NodeInfo -> Printer ())
-> [Deriving NodeInfo] -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Deriving NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty [Deriving NodeInfo]
derivings
prettyPrint (GDataInsDecl NodeInfo
_ DataOrNew NodeInfo
dataornew Type NodeInfo
ty Maybe (Type NodeInfo)
mkind [GadtDecl NodeInfo]
gadtdecls [Deriving NodeInfo]
derivings) = do
Printer () -> Printer () -> Printer ()
forall a. Printer () -> Printer a -> Printer a
depend' (DataOrNew NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty DataOrNew NodeInfo
dataornew Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Printer ()
write ByteString
" instance") (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty
Maybe (Type NodeInfo)
-> (Type NodeInfo -> Printer ()) -> Printer ()
forall a. Maybe a -> (a -> Printer ()) -> Printer ()
mayM_ Maybe (Type NodeInfo)
mkind ((Type NodeInfo -> Printer ()) -> Printer ())
-> (Type NodeInfo -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \Type NodeInfo
kind -> do
LayoutContext -> ByteString -> Printer ()
operator LayoutContext
Declaration ByteString
"::"
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
kind
ByteString -> Printer ()
write ByteString
" where"
Printer ()
newline
[GadtDecl NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
[ast NodeInfo] -> Printer ()
linedOnside [GadtDecl NodeInfo]
gadtdecls
(Deriving NodeInfo -> Printer ())
-> [Deriving NodeInfo] -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Deriving NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty [Deriving NodeInfo]
derivings
prettyPrint (ClassDecl NodeInfo
_ Maybe (Context NodeInfo)
mcontext DeclHead NodeInfo
declhead [FunDep NodeInfo]
fundeps Maybe [ClassDecl NodeInfo]
mclassdecls) = do
ByteString -> Printer () -> Printer ()
forall a. ByteString -> Printer a -> Printer a
depend ByteString
"class" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
(Context NodeInfo -> Printer ())
-> Maybe (Context NodeInfo) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Context NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Maybe (Context NodeInfo)
mcontext
DeclHead NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty DeclHead NodeInfo
declhead
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
LayoutContext -> ByteString -> Printer ()
operator LayoutContext
Declaration ByteString
"|"
LayoutContext -> ByteString -> [FunDep NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
LayoutContext -> ByteString -> [ast NodeInfo] -> Printer ()
list' LayoutContext
Declaration ByteString
"," [FunDep NodeInfo]
fundeps
Maybe [ClassDecl NodeInfo]
-> ([ClassDecl NodeInfo] -> Printer ()) -> Printer ()
forall a. Maybe a -> (a -> Printer ()) -> Printer ()
mayM_ Maybe [ClassDecl NodeInfo]
mclassdecls (([ClassDecl NodeInfo] -> Printer ()) -> Printer ())
-> ([ClassDecl NodeInfo] -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \[ClassDecl NodeInfo]
decls -> do
ByteString -> Printer ()
write ByteString
" where"
(IndentConfig -> Indent) -> Printer () -> Printer ()
forall a. (IndentConfig -> Indent) -> Printer a -> Printer a
withIndent IndentConfig -> Indent
cfgIndentClass (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ TabStop
-> (AlignConfig -> Bool)
-> (ClassDecl NodeInfo -> Printer (Maybe [Int]))
-> [ClassDecl NodeInfo]
-> Printer ()
-> Printer ()
forall a b.
TabStop
-> (AlignConfig -> Bool)
-> (a -> Printer (Maybe [Int]))
-> [a]
-> Printer b
-> Printer b
withComputedTabStop TabStop
stopRhs
AlignConfig -> Bool
cfgAlignClass
ClassDecl NodeInfo -> Printer (Maybe [Int])
measureClassDecl
[ClassDecl NodeInfo]
decls (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$
(ClassDecl NodeInfo -> ClassDecl NodeInfo -> Bool)
-> DeclarationConstruct -> [ClassDecl NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
(ast NodeInfo -> ast NodeInfo -> Bool)
-> DeclarationConstruct -> [ast NodeInfo] -> Printer ()
prettyDecls ClassDecl NodeInfo -> ClassDecl NodeInfo -> Bool
skipBlankClassDecl DeclarationConstruct
DeclClass [ClassDecl NodeInfo]
decls
prettyPrint (InstDecl NodeInfo
_ Maybe (Overlap NodeInfo)
moverlap InstRule NodeInfo
instrule Maybe [InstDecl NodeInfo]
minstdecls) = do
ByteString -> Printer () -> Printer ()
forall a. ByteString -> Printer a -> Printer a
depend ByteString
"instance" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
(Overlap NodeInfo -> Printer ())
-> Maybe (Overlap NodeInfo) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Overlap NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Maybe (Overlap NodeInfo)
moverlap
InstRule NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty InstRule NodeInfo
instrule
Maybe [InstDecl NodeInfo]
-> ([InstDecl NodeInfo] -> Printer ()) -> Printer ()
forall a. Maybe a -> (a -> Printer ()) -> Printer ()
mayM_ Maybe [InstDecl NodeInfo]
minstdecls (([InstDecl NodeInfo] -> Printer ()) -> Printer ())
-> ([InstDecl NodeInfo] -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \[InstDecl NodeInfo]
decls -> do
ByteString -> Printer ()
write ByteString
" where"
(IndentConfig -> Indent) -> Printer () -> Printer ()
forall a. (IndentConfig -> Indent) -> Printer a -> Printer a
withIndent IndentConfig -> Indent
cfgIndentClass (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$
TabStop
-> (AlignConfig -> Bool)
-> (InstDecl NodeInfo -> Printer (Maybe [Int]))
-> [InstDecl NodeInfo]
-> Printer ()
-> Printer ()
forall a b.
TabStop
-> (AlignConfig -> Bool)
-> (a -> Printer (Maybe [Int]))
-> [a]
-> Printer b
-> Printer b
withComputedTabStop TabStop
stopRhs AlignConfig -> Bool
cfgAlignClass InstDecl NodeInfo -> Printer (Maybe [Int])
measureInstDecl [InstDecl NodeInfo]
decls (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$
(InstDecl NodeInfo -> InstDecl NodeInfo -> Bool)
-> DeclarationConstruct -> [InstDecl NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
(ast NodeInfo -> ast NodeInfo -> Bool)
-> DeclarationConstruct -> [ast NodeInfo] -> Printer ()
prettyDecls InstDecl NodeInfo -> InstDecl NodeInfo -> Bool
skipBlankInstDecl DeclarationConstruct
DeclInstance [InstDecl NodeInfo]
decls
#if MIN_VERSION_haskell_src_exts(1,20,0)
prettyPrint (DerivDecl NodeInfo
_ Maybe (DerivStrategy NodeInfo)
mderivstrategy Maybe (Overlap NodeInfo)
moverlap InstRule NodeInfo
instrule) =
ByteString -> Printer () -> Printer ()
forall a. ByteString -> Printer a -> Printer a
depend ByteString
"deriving" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
Maybe (DerivStrategy NodeInfo)
-> (DerivStrategy NodeInfo -> Printer ()) -> Printer ()
forall a. Maybe a -> (a -> Printer ()) -> Printer ()
mayM_ Maybe (DerivStrategy NodeInfo)
mderivstrategy ((DerivStrategy NodeInfo -> Printer ()) -> Printer ())
-> (DerivStrategy NodeInfo -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ Printer ()
-> (DerivStrategy NodeInfo -> Printer ())
-> DerivStrategy NodeInfo
-> Printer ()
forall (f :: * -> *) a x b.
Applicative f =>
f a -> (x -> f b) -> x -> f b
withPostfix Printer ()
space DerivStrategy NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty
ByteString -> Printer ()
write ByteString
"instance "
Maybe (Overlap NodeInfo)
-> (Overlap NodeInfo -> Printer ()) -> Printer ()
forall a. Maybe a -> (a -> Printer ()) -> Printer ()
mayM_ Maybe (Overlap NodeInfo)
moverlap ((Overlap NodeInfo -> Printer ()) -> Printer ())
-> (Overlap NodeInfo -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ Printer ()
-> (Overlap NodeInfo -> Printer ())
-> Overlap NodeInfo
-> Printer ()
forall (f :: * -> *) a x b.
Applicative f =>
f a -> (x -> f b) -> x -> f b
withPostfix Printer ()
space Overlap NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty
InstRule NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty InstRule NodeInfo
instrule
#else
prettyPrint (DerivDecl _ moverlap instrule) = depend "deriving" $ do
write "instance "
mayM_ moverlap $ withPostfix space pretty
pretty instrule
#endif
prettyPrint (InfixDecl NodeInfo
_ Assoc NodeInfo
assoc Maybe Int
mint [Op NodeInfo]
ops) = Printer () -> Printer ()
forall a. Printer a -> Printer a
onside (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
Assoc NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Assoc NodeInfo
assoc
Maybe Int -> (Int -> Printer ()) -> Printer ()
forall a. Maybe a -> (a -> Printer ()) -> Printer ()
mayM_ Maybe Int
mint ((Int -> Printer ()) -> Printer ())
-> (Int -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ Printer () -> (Int -> Printer ()) -> Int -> Printer ()
forall (f :: * -> *) a x b.
Applicative f =>
f a -> (x -> f b) -> x -> f b
withPrefix Printer ()
space Int -> Printer ()
int
Printer ()
space
Printer () -> [Printer ()] -> Printer ()
inter Printer ()
comma ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (Op NodeInfo -> Printer ()) -> [Op NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Op NodeInfo -> Printer ()
forall (ast :: * -> *).
Pretty (ast NodeInfo) =>
ast NodeInfo -> Printer ()
prettyHSE [Op NodeInfo]
ops
prettyPrint (DefaultDecl NodeInfo
_ [Type NodeInfo]
types) = do
ByteString -> Printer ()
write ByteString
"default "
LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [Type NodeInfo]
-> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [ast NodeInfo]
-> Printer ()
listAutoWrap LayoutContext
Other ByteString
"(" ByteString
")" ByteString
"," [Type NodeInfo]
types
prettyPrint (SpliceDecl NodeInfo
_ Exp NodeInfo
expr) = Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr
prettyPrint (TypeSig NodeInfo
_ [Name NodeInfo]
names Type NodeInfo
ty) =
Printer () -> Printer ()
forall a. Printer a -> Printer a
onside (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ LayoutContext -> [Name NodeInfo] -> Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
LayoutContext -> [ast NodeInfo] -> Type NodeInfo -> Printer ()
prettyTypesig LayoutContext
Declaration [Name NodeInfo]
names Type NodeInfo
ty
#if MIN_VERSION_haskell_src_exts(1,21,0)
prettyPrint (PatSynSig NodeInfo
_
[Name NodeInfo]
names
Maybe [TyVarBind NodeInfo]
mtyvarbinds
Maybe (Context NodeInfo)
mcontext
Maybe [TyVarBind NodeInfo]
mtyvarbinds'
Maybe (Context NodeInfo)
mcontext'
Type NodeInfo
ty) = ByteString -> Printer () -> Printer ()
forall a. ByteString -> Printer a -> Printer a
depend ByteString
"pattern" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
Printer () -> [Printer ()] -> Printer ()
inter Printer ()
comma ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (Name NodeInfo -> Printer ()) -> [Name NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty [Name NodeInfo]
names
LayoutContext -> ByteString -> Printer ()
operator LayoutContext
Declaration ByteString
"::"
([TyVarBind NodeInfo] -> Printer ())
-> Maybe [TyVarBind NodeInfo] -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [TyVarBind NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
[ast NodeInfo] -> Printer ()
prettyForall Maybe [TyVarBind NodeInfo]
mtyvarbinds
Maybe (Context NodeInfo)
-> (Context NodeInfo -> Printer ()) -> Printer ()
forall a. Maybe a -> (a -> Printer ()) -> Printer ()
mayM_ Maybe (Context NodeInfo)
mcontext Context NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty
([TyVarBind NodeInfo] -> Printer ())
-> Maybe [TyVarBind NodeInfo] -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [TyVarBind NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
[ast NodeInfo] -> Printer ()
prettyForall Maybe [TyVarBind NodeInfo]
mtyvarbinds'
Maybe (Context NodeInfo)
-> (Context NodeInfo -> Printer ()) -> Printer ()
forall a. Maybe a -> (a -> Printer ()) -> Printer ()
mayM_ Maybe (Context NodeInfo)
mcontext' Context NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty
#elif MIN_VERSION_haskell_src_exts(1,20,0)
prettyPrint (PatSynSig _ names mtyvarbinds mcontext mcontext' ty) =
depend "pattern" $ do
inter comma $ map pretty names
operator Declaration "::"
mapM_ prettyForall mtyvarbinds
mayM_ mcontext pretty
mayM_ mcontext' pretty
pretty ty
#else
prettyPrint (PatSynSig _ name mtyvarbinds mcontext mcontext' ty) =
depend "pattern" $ do
pretty name
operator Declaration "::"
mapM_ prettyForall mtyvarbinds
mayM_ mcontext pretty
mayM_ mcontext' pretty
pretty ty
#endif
prettyPrint (FunBind NodeInfo
_ [Match NodeInfo]
matches) =
TabStop
-> (AlignConfig -> Bool)
-> (Match NodeInfo -> Printer (Maybe [Int]))
-> [Match NodeInfo]
-> Printer ()
-> Printer ()
forall a b.
TabStop
-> (AlignConfig -> Bool)
-> (a -> Printer (Maybe [Int]))
-> [a]
-> Printer b
-> Printer b
withComputedTabStop TabStop
stopRhs AlignConfig -> Bool
cfgAlignMatches Match NodeInfo -> Printer (Maybe [Int])
measureMatch [Match NodeInfo]
matches (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$
[Match NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
[ast NodeInfo] -> Printer ()
linedOnside [Match NodeInfo]
matches
prettyPrint (PatBind NodeInfo
_ Pat NodeInfo
pat Rhs NodeInfo
rhs Maybe (Binds NodeInfo)
mbinds) = do
Printer () -> Printer ()
forall a. Printer a -> Printer a
onside (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
pat
TabStop -> Printer ()
atTabStop TabStop
stopRhs
Rhs NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Rhs NodeInfo
rhs
(Binds NodeInfo -> Printer ())
-> Maybe (Binds NodeInfo) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Binds NodeInfo -> Printer ()
prettyBinds Maybe (Binds NodeInfo)
mbinds
prettyPrint (PatSyn NodeInfo
_ Pat NodeInfo
pat Pat NodeInfo
pat' PatternSynDirection NodeInfo
patternsyndirection) = do
ByteString -> Printer () -> Printer ()
forall a. ByteString -> Printer a -> Printer a
depend ByteString
"pattern" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Pat NodeInfo -> ByteString -> Pat NodeInfo -> Printer ()
forall (ast1 :: * -> *) (ast2 :: * -> *).
(Annotated ast1, Pretty ast1, Annotated ast2, Pretty ast2) =>
ast1 NodeInfo -> ByteString -> ast2 NodeInfo -> Printer ()
prettySimpleDecl Pat NodeInfo
pat ByteString
sep Pat NodeInfo
pat'
case PatternSynDirection NodeInfo
patternsyndirection of
ExplicitBidirectional NodeInfo
_ [Decl NodeInfo]
decls ->
Binds NodeInfo -> Printer ()
prettyBinds (NodeInfo -> [Decl NodeInfo] -> Binds NodeInfo
forall l. l -> [Decl l] -> Binds l
BDecls NodeInfo
noNodeInfo [Decl NodeInfo]
decls)
PatternSynDirection NodeInfo
_ -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
sep :: ByteString
sep = case PatternSynDirection NodeInfo
patternsyndirection of
PatternSynDirection NodeInfo
ImplicitBidirectional -> ByteString
"="
ExplicitBidirectional NodeInfo
_ [Decl NodeInfo]
_ -> ByteString
"<-"
PatternSynDirection NodeInfo
Unidirectional -> ByteString
"<-"
prettyPrint (ForImp NodeInfo
_ CallConv NodeInfo
callconv Maybe (Safety NodeInfo)
msafety Maybe String
mstring Name NodeInfo
name Type NodeInfo
ty) =
ByteString -> Printer () -> Printer ()
forall a. ByteString -> Printer a -> Printer a
depend ByteString
"foreign import" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
CallConv NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty CallConv NodeInfo
callconv
Maybe (Safety NodeInfo)
-> (Safety NodeInfo -> Printer ()) -> Printer ()
forall a. Maybe a -> (a -> Printer ()) -> Printer ()
mayM_ Maybe (Safety NodeInfo)
msafety ((Safety NodeInfo -> Printer ()) -> Printer ())
-> (Safety NodeInfo -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ Printer ()
-> (Safety NodeInfo -> Printer ()) -> Safety NodeInfo -> Printer ()
forall (f :: * -> *) a x b.
Applicative f =>
f a -> (x -> f b) -> x -> f b
withPrefix Printer ()
space Safety NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty
Maybe String -> (String -> Printer ()) -> Printer ()
forall a. Maybe a -> (a -> Printer ()) -> Printer ()
mayM_ Maybe String
mstring ((String -> Printer ()) -> Printer ())
-> (String -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ Printer () -> (String -> Printer ()) -> String -> Printer ()
forall (f :: * -> *) a x b.
Applicative f =>
f a -> (x -> f b) -> x -> f b
withPrefix Printer ()
space (String -> Printer ()
string (String -> Printer ())
-> (String -> String) -> String -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. Show a => a -> String
show)
Printer ()
space
LayoutContext -> [Name NodeInfo] -> Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
LayoutContext -> [ast NodeInfo] -> Type NodeInfo -> Printer ()
prettyTypesig LayoutContext
Declaration [ Name NodeInfo
name ] Type NodeInfo
ty
prettyPrint (ForExp NodeInfo
_ CallConv NodeInfo
callconv Maybe String
mstring Name NodeInfo
name Type NodeInfo
ty) =
ByteString -> Printer () -> Printer ()
forall a. ByteString -> Printer a -> Printer a
depend ByteString
"foreign export" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
CallConv NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty CallConv NodeInfo
callconv
Maybe String -> (String -> Printer ()) -> Printer ()
forall a. Maybe a -> (a -> Printer ()) -> Printer ()
mayM_ Maybe String
mstring ((String -> Printer ()) -> Printer ())
-> (String -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ Printer () -> (String -> Printer ()) -> String -> Printer ()
forall (f :: * -> *) a x b.
Applicative f =>
f a -> (x -> f b) -> x -> f b
withPrefix Printer ()
space (String -> Printer ()
string (String -> Printer ())
-> (String -> String) -> String -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. Show a => a -> String
show)
Printer ()
space
LayoutContext -> [Name NodeInfo] -> Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
LayoutContext -> [ast NodeInfo] -> Type NodeInfo -> Printer ()
prettyTypesig LayoutContext
Declaration [ Name NodeInfo
name ] Type NodeInfo
ty
prettyPrint (RulePragmaDecl NodeInfo
_ [Rule NodeInfo]
rules) =
if [Rule NodeInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Rule NodeInfo]
rules
then ByteString -> Maybe (Printer ()) -> Printer ()
prettyPragma' ByteString
"RULES" Maybe (Printer ())
forall a. Maybe a
Nothing
else ByteString -> Printer () -> Printer ()
prettyPragma ByteString
"RULES" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ (Rule NodeInfo -> Printer ()) -> [Rule NodeInfo] -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Rule NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty [Rule NodeInfo]
rules
prettyPrint (DeprPragmaDecl NodeInfo
_ [([Name NodeInfo], String)]
deprecations) =
if [([Name NodeInfo], String)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [([Name NodeInfo], String)]
deprecations
then ByteString -> Maybe (Printer ()) -> Printer ()
prettyPragma' ByteString
"DEPRECATED" Maybe (Printer ())
forall a. Maybe a
Nothing
else ByteString -> Printer () -> Printer ()
prettyPragma ByteString
"DEPRECATED" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ [([Name NodeInfo], String)]
-> (([Name NodeInfo], String) -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [([Name NodeInfo], String)]
deprecations ((([Name NodeInfo], String) -> Printer ()) -> Printer ())
-> (([Name NodeInfo], String) -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$
\([Name NodeInfo]
names, String
str) -> do
Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Name NodeInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name NodeInfo]
names) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
Printer () -> [Printer ()] -> Printer ()
inter Printer ()
comma ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (Name NodeInfo -> Printer ()) -> [Name NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty [Name NodeInfo]
names
Printer ()
space
String -> Printer ()
string (String -> String
forall a. Show a => a -> String
show String
str)
prettyPrint (WarnPragmaDecl NodeInfo
_ [([Name NodeInfo], String)]
warnings) =
if [([Name NodeInfo], String)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [([Name NodeInfo], String)]
warnings
then ByteString -> Maybe (Printer ()) -> Printer ()
prettyPragma' ByteString
"WARNING" Maybe (Printer ())
forall a. Maybe a
Nothing
else ByteString -> Printer () -> Printer ()
prettyPragma ByteString
"WARNING" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ [([Name NodeInfo], String)]
-> (([Name NodeInfo], String) -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [([Name NodeInfo], String)]
warnings ((([Name NodeInfo], String) -> Printer ()) -> Printer ())
-> (([Name NodeInfo], String) -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \([Name NodeInfo]
names, String
str) -> do
Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Name NodeInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name NodeInfo]
names) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
Printer () -> [Printer ()] -> Printer ()
inter Printer ()
comma ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (Name NodeInfo -> Printer ()) -> [Name NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty [Name NodeInfo]
names
Printer ()
space
String -> Printer ()
string (String -> String
forall a. Show a => a -> String
show String
str)
prettyPrint (InlineSig NodeInfo
_ Bool
inline Maybe (Activation NodeInfo)
mactivation QName NodeInfo
qname) = ByteString -> Printer () -> Printer ()
prettyPragma ByteString
name (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
Maybe (Activation NodeInfo)
-> (Activation NodeInfo -> Printer ()) -> Printer ()
forall a. Maybe a -> (a -> Printer ()) -> Printer ()
mayM_ Maybe (Activation NodeInfo)
mactivation ((Activation NodeInfo -> Printer ()) -> Printer ())
-> (Activation NodeInfo -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ Printer ()
-> (Activation NodeInfo -> Printer ())
-> Activation NodeInfo
-> Printer ()
forall (f :: * -> *) a x b.
Applicative f =>
f a -> (x -> f b) -> x -> f b
withPostfix Printer ()
space Activation NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty
QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
qname
where
name :: ByteString
name = if Bool
inline then ByteString
"INLINE" else ByteString
"NOINLINE"
prettyPrint (InlineConlikeSig NodeInfo
_ Maybe (Activation NodeInfo)
mactivation QName NodeInfo
qname) =
ByteString -> Printer () -> Printer ()
prettyPragma ByteString
"INLINE CONLIKE" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
Maybe (Activation NodeInfo)
-> (Activation NodeInfo -> Printer ()) -> Printer ()
forall a. Maybe a -> (a -> Printer ()) -> Printer ()
mayM_ Maybe (Activation NodeInfo)
mactivation ((Activation NodeInfo -> Printer ()) -> Printer ())
-> (Activation NodeInfo -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ Printer ()
-> (Activation NodeInfo -> Printer ())
-> Activation NodeInfo
-> Printer ()
forall (f :: * -> *) a x b.
Applicative f =>
f a -> (x -> f b) -> x -> f b
withPostfix Printer ()
space Activation NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty
QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
qname
prettyPrint (SpecSig NodeInfo
_ Maybe (Activation NodeInfo)
mactivation QName NodeInfo
qname [Type NodeInfo]
types) =
ByteString -> Printer () -> Printer ()
prettyPragma ByteString
"SPECIALISE" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
Maybe (Activation NodeInfo)
-> (Activation NodeInfo -> Printer ()) -> Printer ()
forall a. Maybe a -> (a -> Printer ()) -> Printer ()
mayM_ Maybe (Activation NodeInfo)
mactivation ((Activation NodeInfo -> Printer ()) -> Printer ())
-> (Activation NodeInfo -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ Printer ()
-> (Activation NodeInfo -> Printer ())
-> Activation NodeInfo
-> Printer ()
forall (f :: * -> *) a x b.
Applicative f =>
f a -> (x -> f b) -> x -> f b
withPostfix Printer ()
space Activation NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty
QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
qname
LayoutContext -> ByteString -> Printer ()
operator LayoutContext
Declaration ByteString
"::"
Printer () -> [Printer ()] -> Printer ()
inter Printer ()
comma ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (Type NodeInfo -> Printer ()) -> [Type NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty [Type NodeInfo]
types
prettyPrint (SpecInlineSig NodeInfo
_ Bool
inline Maybe (Activation NodeInfo)
mactivation QName NodeInfo
qname [Type NodeInfo]
types) =
ByteString -> Printer () -> Printer ()
prettyPragma ByteString
name (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
Maybe (Activation NodeInfo)
-> (Activation NodeInfo -> Printer ()) -> Printer ()
forall a. Maybe a -> (a -> Printer ()) -> Printer ()
mayM_ Maybe (Activation NodeInfo)
mactivation ((Activation NodeInfo -> Printer ()) -> Printer ())
-> (Activation NodeInfo -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ Printer ()
-> (Activation NodeInfo -> Printer ())
-> Activation NodeInfo
-> Printer ()
forall (f :: * -> *) a x b.
Applicative f =>
f a -> (x -> f b) -> x -> f b
withPostfix Printer ()
space Activation NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty
QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
qname
LayoutContext -> ByteString -> Printer ()
operator LayoutContext
Declaration ByteString
"::"
Printer () -> [Printer ()] -> Printer ()
inter Printer ()
comma ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (Type NodeInfo -> Printer ()) -> [Type NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty [Type NodeInfo]
types
where
name :: ByteString
name = if Bool
inline then ByteString
"SPECIALISE INLINE" else ByteString
"SPECIALISE NOINLINE"
prettyPrint (InstSig NodeInfo
_ InstRule NodeInfo
instrule) =
ByteString -> Printer () -> Printer ()
prettyPragma ByteString
"SPECIALISE instance" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ InstRule NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty InstRule NodeInfo
instrule
prettyPrint (AnnPragma NodeInfo
_ Annotation NodeInfo
annotation) =
ByteString -> Printer () -> Printer ()
prettyPragma ByteString
"ANN" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Annotation NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Annotation NodeInfo
annotation
prettyPrint (MinimalPragma NodeInfo
_ Maybe (BooleanFormula NodeInfo)
mbooleanformula) =
ByteString -> Printer () -> Printer ()
prettyPragma ByteString
"MINIMAL" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ (BooleanFormula NodeInfo -> Printer ())
-> Maybe (BooleanFormula NodeInfo) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ BooleanFormula NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Maybe (BooleanFormula NodeInfo)
mbooleanformula
prettyPrint Decl NodeInfo
decl = Decl NodeInfo -> Printer ()
forall (ast :: * -> *).
Pretty (ast NodeInfo) =>
ast NodeInfo -> Printer ()
prettyHSE Decl NodeInfo
decl
instance Pretty DeclHead where
prettyPrint :: DeclHead NodeInfo -> Printer ()
prettyPrint (DHead NodeInfo
_ Name NodeInfo
name) = Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Name NodeInfo
name
prettyPrint (DHInfix NodeInfo
_ TyVarBind NodeInfo
tyvarbind Name NodeInfo
name) = do
TyVarBind NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty TyVarBind NodeInfo
tyvarbind
Op NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty (Op NodeInfo -> Printer ()) -> Op NodeInfo -> Printer ()
forall a b. (a -> b) -> a -> b
$ NodeInfo -> Name NodeInfo -> Op NodeInfo
forall l. l -> Name l -> Op l
VarOp NodeInfo
noNodeInfo Name NodeInfo
name
prettyPrint (DHParen NodeInfo
_ DeclHead NodeInfo
declhead) = Printer () -> Printer ()
parens (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ DeclHead NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty DeclHead NodeInfo
declhead
prettyPrint (DHApp NodeInfo
_ DeclHead NodeInfo
declhead TyVarBind NodeInfo
tyvarbind) = Printer () -> Printer () -> Printer ()
forall a. Printer () -> Printer a -> Printer a
depend' (DeclHead NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty DeclHead NodeInfo
declhead) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$
TyVarBind NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty TyVarBind NodeInfo
tyvarbind
instance Pretty InstRule where
prettyPrint :: InstRule NodeInfo -> Printer ()
prettyPrint (IRule NodeInfo
_ Maybe [TyVarBind NodeInfo]
mtyvarbinds Maybe (Context NodeInfo)
mcontext InstHead NodeInfo
insthead) = do
([TyVarBind NodeInfo] -> Printer ())
-> Maybe [TyVarBind NodeInfo] -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [TyVarBind NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
[ast NodeInfo] -> Printer ()
prettyForall Maybe [TyVarBind NodeInfo]
mtyvarbinds
(Context NodeInfo -> Printer ())
-> Maybe (Context NodeInfo) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Context NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Maybe (Context NodeInfo)
mcontext
InstHead NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty InstHead NodeInfo
insthead
prettyPrint (IParen NodeInfo
_ InstRule NodeInfo
instrule) = Printer () -> Printer ()
parens (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ InstRule NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty InstRule NodeInfo
instrule
instance Pretty InstHead where
prettyPrint :: InstHead NodeInfo -> Printer ()
prettyPrint (IHCon NodeInfo
_ QName NodeInfo
qname) = QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
qname
prettyPrint (IHInfix NodeInfo
_ Type NodeInfo
ty QName NodeInfo
qname) = do
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty
Printer ()
space
QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
qname
prettyPrint (IHParen NodeInfo
_ InstHead NodeInfo
insthead) = Printer () -> Printer ()
parens (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ InstHead NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty InstHead NodeInfo
insthead
prettyPrint (IHApp NodeInfo
_ InstHead NodeInfo
insthead Type NodeInfo
ty) = Printer () -> Printer () -> Printer ()
forall a. Printer () -> Printer a -> Printer a
depend' (InstHead NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty InstHead NodeInfo
insthead) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty
instance Pretty Binds where
prettyPrint :: Binds NodeInfo -> Printer ()
prettyPrint (BDecls NodeInfo
_ [Decl NodeInfo]
decls) =
TabStop
-> (AlignConfig -> Bool)
-> (Decl NodeInfo -> Printer (Maybe [Int]))
-> [Decl NodeInfo]
-> Printer ()
-> Printer ()
forall a b.
TabStop
-> (AlignConfig -> Bool)
-> (a -> Printer (Maybe [Int]))
-> [a]
-> Printer b
-> Printer b
withComputedTabStop TabStop
stopRhs AlignConfig -> Bool
cfgAlignWhere Decl NodeInfo -> Printer (Maybe [Int])
measureDecl [Decl NodeInfo]
decls (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$
(Decl NodeInfo -> Decl NodeInfo -> Bool)
-> DeclarationConstruct -> [Decl NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
(ast NodeInfo -> ast NodeInfo -> Bool)
-> DeclarationConstruct -> [ast NodeInfo] -> Printer ()
prettyDecls Decl NodeInfo -> Decl NodeInfo -> Bool
skipBlankDecl DeclarationConstruct
DeclWhere [Decl NodeInfo]
decls
prettyPrint (IPBinds NodeInfo
_ [IPBind NodeInfo]
ipbinds) = [IPBind NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
[ast NodeInfo] -> Printer ()
linedOnside [IPBind NodeInfo]
ipbinds
instance Pretty IPBind where
prettyPrint :: IPBind NodeInfo -> Printer ()
prettyPrint (IPBind NodeInfo
_ IPName NodeInfo
ipname Exp NodeInfo
expr) = IPName NodeInfo -> ByteString -> Exp NodeInfo -> Printer ()
forall (ast1 :: * -> *) (ast2 :: * -> *).
(Annotated ast1, Pretty ast1, Annotated ast2, Pretty ast2) =>
ast1 NodeInfo -> ByteString -> ast2 NodeInfo -> Printer ()
prettySimpleDecl IPName NodeInfo
ipname ByteString
"=" Exp NodeInfo
expr
instance Pretty InjectivityInfo where
prettyPrint :: InjectivityInfo NodeInfo -> Printer ()
prettyPrint (InjectivityInfo NodeInfo
_ Name NodeInfo
name [Name NodeInfo]
names) = do
LayoutContext -> ByteString -> Printer ()
operator LayoutContext
Declaration ByteString
"|"
Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Name NodeInfo
name
LayoutContext -> ByteString -> Printer ()
operator LayoutContext
Declaration ByteString
"->"
Printer () -> [Printer ()] -> Printer ()
inter Printer ()
space ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (Name NodeInfo -> Printer ()) -> [Name NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty [Name NodeInfo]
names
instance Pretty ResultSig where
prettyPrint :: ResultSig NodeInfo -> Printer ()
prettyPrint (KindSig NodeInfo
_ Type NodeInfo
kind) =
(LayoutConfig -> Layout) -> Printer () -> Printer () -> Printer ()
forall a.
(LayoutConfig -> Layout) -> Printer a -> Printer a -> Printer a
withLayout LayoutConfig -> Layout
cfgLayoutDeclaration Printer ()
flex Printer ()
vertical
where
flex :: Printer ()
flex = do
LayoutContext -> ByteString -> Printer ()
operator LayoutContext
Declaration ByteString
"::"
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
kind
vertical :: Printer ()
vertical = do
LayoutContext -> ByteString -> Printer ()
operatorV LayoutContext
Declaration ByteString
"::"
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
kind
prettyPrint (TyVarSig NodeInfo
_ TyVarBind NodeInfo
tyvarbind) =
(LayoutConfig -> Layout) -> Printer () -> Printer () -> Printer ()
forall a.
(LayoutConfig -> Layout) -> Printer a -> Printer a -> Printer a
withLayout LayoutConfig -> Layout
cfgLayoutDeclaration Printer ()
flex Printer ()
vertical
where
flex :: Printer ()
flex = do
LayoutContext -> ByteString -> Printer ()
operator LayoutContext
Declaration ByteString
"="
TyVarBind NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty TyVarBind NodeInfo
tyvarbind
vertical :: Printer ()
vertical = do
LayoutContext -> ByteString -> Printer ()
operatorV LayoutContext
Declaration ByteString
"="
TyVarBind NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty TyVarBind NodeInfo
tyvarbind
instance Pretty ClassDecl where
prettyPrint :: ClassDecl NodeInfo -> Printer ()
prettyPrint (ClsDecl NodeInfo
_ Decl NodeInfo
decl) = Decl NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Decl NodeInfo
decl
prettyPrint (ClsDataFam NodeInfo
_ Maybe (Context NodeInfo)
mcontext DeclHead NodeInfo
declhead Maybe (ResultSig NodeInfo)
mresultsig) = ByteString -> Printer () -> Printer ()
forall a. ByteString -> Printer a -> Printer a
depend ByteString
"data" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
(Context NodeInfo -> Printer ())
-> Maybe (Context NodeInfo) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Context NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Maybe (Context NodeInfo)
mcontext
DeclHead NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty DeclHead NodeInfo
declhead
Maybe (ResultSig NodeInfo)
-> (ResultSig NodeInfo -> Printer ()) -> Printer ()
forall a. Maybe a -> (a -> Printer ()) -> Printer ()
mayM_ Maybe (ResultSig NodeInfo)
mresultsig ResultSig NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty
prettyPrint (ClsTyFam NodeInfo
_ DeclHead NodeInfo
declhead Maybe (ResultSig NodeInfo)
mresultsig Maybe (InjectivityInfo NodeInfo)
minjectivityinfo) =
ByteString -> Printer () -> Printer ()
forall a. ByteString -> Printer a -> Printer a
depend ByteString
"type" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
DeclHead NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty DeclHead NodeInfo
declhead
Maybe (ResultSig NodeInfo)
-> (ResultSig NodeInfo -> Printer ()) -> Printer ()
forall a. Maybe a -> (a -> Printer ()) -> Printer ()
mayM_ Maybe (ResultSig NodeInfo)
mresultsig ResultSig NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty
(InjectivityInfo NodeInfo -> Printer ())
-> Maybe (InjectivityInfo NodeInfo) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ InjectivityInfo NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Maybe (InjectivityInfo NodeInfo)
minjectivityinfo
prettyPrint (ClsTyDef NodeInfo
_ TypeEqn NodeInfo
typeeqn) = ByteString -> Printer () -> Printer ()
forall a. ByteString -> Printer a -> Printer a
depend ByteString
"type" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ TypeEqn NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty TypeEqn NodeInfo
typeeqn
prettyPrint (ClsDefSig NodeInfo
_ Name NodeInfo
name Type NodeInfo
ty) = do
ByteString -> Printer ()
write ByteString
"default"
Printer ()
space
LayoutContext -> [Name NodeInfo] -> Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
LayoutContext -> [ast NodeInfo] -> Type NodeInfo -> Printer ()
prettyTypesig LayoutContext
Declaration [ Name NodeInfo
name ] Type NodeInfo
ty
instance Pretty InstDecl where
prettyPrint :: InstDecl NodeInfo -> Printer ()
prettyPrint (InsDecl NodeInfo
_ Decl NodeInfo
decl) = Decl NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Decl NodeInfo
decl
prettyPrint (InsType NodeInfo
_ Type NodeInfo
ty Type NodeInfo
ty') =
ByteString -> Printer () -> Printer ()
forall a. ByteString -> Printer a -> Printer a
depend ByteString
"type" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Type NodeInfo -> ByteString -> Type NodeInfo -> Printer ()
forall (ast1 :: * -> *) (ast2 :: * -> *).
(Annotated ast1, Pretty ast1, Annotated ast2, Pretty ast2) =>
ast1 NodeInfo -> ByteString -> ast2 NodeInfo -> Printer ()
prettySimpleDecl Type NodeInfo
ty ByteString
"=" Type NodeInfo
ty'
prettyPrint (InsData NodeInfo
_ DataOrNew NodeInfo
dataornew Type NodeInfo
ty [QualConDecl NodeInfo]
qualcondecls [Deriving NodeInfo]
derivings) =
Printer () -> Printer () -> Printer ()
forall a. Printer () -> Printer a -> Printer a
depend' (DataOrNew NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty DataOrNew NodeInfo
dataornew) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty
Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([QualConDecl NodeInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [QualConDecl NodeInfo]
qualcondecls) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ [QualConDecl NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
[ast NodeInfo] -> Printer ()
prettyConDecls [QualConDecl NodeInfo]
qualcondecls
(Deriving NodeInfo -> Printer ())
-> [Deriving NodeInfo] -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Deriving NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty [Deriving NodeInfo]
derivings
prettyPrint (InsGData NodeInfo
_ DataOrNew NodeInfo
dataornew Type NodeInfo
ty Maybe (Type NodeInfo)
mkind [GadtDecl NodeInfo]
gadtdecls [Deriving NodeInfo]
derivings) = do
Printer () -> Printer () -> Printer ()
forall a. Printer () -> Printer a -> Printer a
depend' (DataOrNew NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty DataOrNew NodeInfo
dataornew) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty
Maybe (Type NodeInfo)
-> (Type NodeInfo -> Printer ()) -> Printer ()
forall a. Maybe a -> (a -> Printer ()) -> Printer ()
mayM_ Maybe (Type NodeInfo)
mkind ((Type NodeInfo -> Printer ()) -> Printer ())
-> (Type NodeInfo -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \Type NodeInfo
kind -> do
LayoutContext -> ByteString -> Printer ()
operator LayoutContext
Declaration ByteString
"::"
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
kind
ByteString -> Printer ()
write ByteString
" where"
Printer ()
newline
[GadtDecl NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
[ast NodeInfo] -> Printer ()
lined [GadtDecl NodeInfo]
gadtdecls
(Deriving NodeInfo -> Printer ())
-> [Deriving NodeInfo] -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Deriving NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty [Deriving NodeInfo]
derivings
instance Pretty Deriving where
#if MIN_VERSION_haskell_src_exts(1,20,0)
prettyPrint :: Deriving NodeInfo -> Printer ()
prettyPrint (Deriving NodeInfo
_ Maybe (DerivStrategy NodeInfo)
mderivstrategy [InstRule NodeInfo]
instrules) =
(IndentConfig -> Int) -> Printer () -> Printer ()
forall a. (IndentConfig -> Int) -> Printer a -> Printer a
withIndentBy IndentConfig -> Int
cfgIndentDeriving (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
ByteString -> Printer ()
write ByteString
"deriving "
Printer ()
prettyStratBefore
case [InstRule NodeInfo]
instrules of
[ i :: InstRule NodeInfo
i@IRule{} ] -> InstRule NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty InstRule NodeInfo
i
[ IParen NodeInfo
_ InstRule NodeInfo
i ] -> LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [InstRule NodeInfo]
-> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [ast NodeInfo]
-> Printer ()
listAutoWrap LayoutContext
Other ByteString
"(" ByteString
")" ByteString
"," [ InstRule NodeInfo
i ]
[InstRule NodeInfo]
_ -> LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [InstRule NodeInfo]
-> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [ast NodeInfo]
-> Printer ()
listAutoWrap LayoutContext
Other ByteString
"(" ByteString
")" ByteString
"," [InstRule NodeInfo]
instrules
Printer ()
prettyStratAfter
where
(Printer ()
prettyStratBefore, Printer ()
prettyStratAfter) = case Maybe (DerivStrategy NodeInfo)
mderivstrategy of
#if MIN_VERSION_haskell_src_exts(1,21,0)
Just x :: DerivStrategy NodeInfo
x@DerivVia{} -> (() -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return (), Printer ()
space Printer () -> Printer () -> Printer ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> DerivStrategy NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty DerivStrategy NodeInfo
x)
#endif
Just DerivStrategy NodeInfo
x -> (DerivStrategy NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty DerivStrategy NodeInfo
x Printer () -> Printer () -> Printer ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Printer ()
space, () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
Maybe (DerivStrategy NodeInfo)
_ -> (() -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return (), () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
#else
prettyPrint (Deriving _ instrules) = withIndentBy cfgIndentDeriving $ do
write "deriving "
case instrules of
[ i@IRule{} ] -> pretty i
[ IParen _ i ] -> listAutoWrap Other "(" ")" "," [ i ]
_ -> listAutoWrap Other "(" ")" "," instrules
#endif
instance Pretty ConDecl where
prettyPrint :: ConDecl NodeInfo -> Printer ()
prettyPrint (ConDecl NodeInfo
_ Name NodeInfo
name [Type NodeInfo]
types) = do
Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty 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]
types) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
Printer ()
space
Printer () -> Printer ()
forall a. Printer a -> Printer a
oneline Printer ()
hor Printer () -> Printer () -> Printer ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Printer ()
ver
where
hor :: Printer ()
hor = Printer () -> [Printer ()] -> Printer ()
inter Printer ()
space ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (Type NodeInfo -> Printer ()) -> [Type NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty [Type NodeInfo]
types
ver :: Printer ()
ver = Printer () -> Printer ()
forall a. Printer a -> Printer a
aligned (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ [Type NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
[ast NodeInfo] -> Printer ()
linedOnside [Type NodeInfo]
types
prettyPrint (InfixConDecl NodeInfo
_ Type NodeInfo
ty Name NodeInfo
name Type NodeInfo
ty') = do
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty
Op NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty (Op NodeInfo -> Printer ()) -> Op NodeInfo -> Printer ()
forall a b. (a -> b) -> a -> b
$ NodeInfo -> Name NodeInfo -> Op NodeInfo
forall l. l -> Name l -> Op l
ConOp NodeInfo
noNodeInfo Name NodeInfo
name
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty'
prettyPrint (RecDecl NodeInfo
_ Name NodeInfo
name [FieldDecl NodeInfo]
fielddecls) =
(FieldDecl NodeInfo -> Printer (Maybe Int))
-> LayoutContext
-> Name NodeInfo
-> [FieldDecl NodeInfo]
-> Printer ()
forall (ast1 :: * -> *) (ast2 :: * -> *).
(Annotated ast1, Pretty ast1, Annotated ast2, Pretty ast2) =>
(ast2 NodeInfo -> Printer (Maybe Int))
-> LayoutContext -> ast1 NodeInfo -> [ast2 NodeInfo] -> Printer ()
prettyRecord FieldDecl NodeInfo -> Printer (Maybe Int)
len LayoutContext
Declaration Name NodeInfo
name [FieldDecl NodeInfo]
fielddecls
where
len :: FieldDecl NodeInfo -> Printer (Maybe Int)
len (FieldDecl NodeInfo
_ [Name NodeInfo]
names Type NodeInfo
_) = Printer () -> Printer (Maybe Int)
forall a. Printer a -> Printer (Maybe Int)
measure (Printer () -> Printer (Maybe Int))
-> Printer () -> Printer (Maybe Int)
forall a b. (a -> b) -> a -> b
$ Printer () -> [Printer ()] -> Printer ()
inter Printer ()
comma ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (Name NodeInfo -> Printer ()) -> [Name NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty [Name NodeInfo]
names
instance Pretty FieldDecl where
prettyPrint :: FieldDecl NodeInfo -> Printer ()
prettyPrint (FieldDecl NodeInfo
_ [Name NodeInfo]
names Type NodeInfo
ty) = LayoutContext -> [Name NodeInfo] -> Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
LayoutContext -> [ast NodeInfo] -> Type NodeInfo -> Printer ()
prettyTypesig LayoutContext
Declaration [Name NodeInfo]
names Type NodeInfo
ty
instance Pretty QualConDecl where
prettyPrint :: QualConDecl NodeInfo -> Printer ()
prettyPrint (QualConDecl NodeInfo
_ Maybe [TyVarBind NodeInfo]
mtyvarbinds Maybe (Context NodeInfo)
mcontext ConDecl NodeInfo
condecl) = do
([TyVarBind NodeInfo] -> Printer ())
-> Maybe [TyVarBind NodeInfo] -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [TyVarBind NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
[ast NodeInfo] -> Printer ()
prettyForall Maybe [TyVarBind NodeInfo]
mtyvarbinds
(Context NodeInfo -> Printer ())
-> Maybe (Context NodeInfo) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Context NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Maybe (Context NodeInfo)
mcontext
ConDecl NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty ConDecl NodeInfo
condecl
instance Pretty GadtDecl where
#if MIN_VERSION_haskell_src_exts(1,21,0)
prettyPrint :: GadtDecl NodeInfo -> Printer ()
prettyPrint (GadtDecl NodeInfo
_ Name NodeInfo
name Maybe [TyVarBind NodeInfo]
_ Maybe (Context NodeInfo)
_ Maybe [FieldDecl NodeInfo]
mfielddecls Type NodeInfo
ty) = do
Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Name NodeInfo
name
LayoutContext -> ByteString -> Printer ()
operator LayoutContext
Declaration ByteString
"::"
Maybe [FieldDecl NodeInfo]
-> ([FieldDecl NodeInfo] -> Printer ()) -> Printer ()
forall a. Maybe a -> (a -> Printer ()) -> Printer ()
mayM_ Maybe [FieldDecl NodeInfo]
mfielddecls (([FieldDecl NodeInfo] -> Printer ()) -> Printer ())
-> ([FieldDecl NodeInfo] -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \[FieldDecl NodeInfo]
decls -> do
(FieldDecl NodeInfo -> Printer (Maybe Int))
-> LayoutContext -> [FieldDecl NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
(ast NodeInfo -> Printer (Maybe Int))
-> LayoutContext -> [ast NodeInfo] -> Printer ()
prettyRecordFields FieldDecl NodeInfo -> Printer (Maybe Int)
len LayoutContext
Declaration [FieldDecl NodeInfo]
decls
LayoutContext -> ByteString -> Printer ()
operator LayoutContext
Type ByteString
"->"
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty
#else
prettyPrint (GadtDecl _ name mfielddecls ty) = do
pretty name
operator Declaration "::"
mayM_ mfielddecls $ \decls -> do
prettyRecordFields len Declaration decls
operator Type "->"
pretty ty
#endif
where
len :: FieldDecl NodeInfo -> Printer (Maybe Int)
len (FieldDecl NodeInfo
_ [Name NodeInfo]
names Type NodeInfo
_) = Printer () -> Printer (Maybe Int)
forall a. Printer a -> Printer (Maybe Int)
measure (Printer () -> Printer (Maybe Int))
-> Printer () -> Printer (Maybe Int)
forall a b. (a -> b) -> a -> b
$ Printer () -> [Printer ()] -> Printer ()
inter Printer ()
comma ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (Name NodeInfo -> Printer ()) -> [Name NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty [Name NodeInfo]
names
instance Pretty Match where
prettyPrint :: Match NodeInfo -> Printer ()
prettyPrint (Match NodeInfo
_ Name NodeInfo
name [Pat NodeInfo]
pats Rhs NodeInfo
rhs Maybe (Binds NodeInfo)
mbinds) = do
Printer () -> Printer ()
forall a. Printer a -> Printer a
onside (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
Name NodeInfo -> [Pat NodeInfo] -> Printer ()
forall (ast1 :: * -> *) (ast2 :: * -> *).
(Annotated ast1, Annotated ast2, Pretty ast1, Pretty ast2) =>
ast1 NodeInfo -> [ast2 NodeInfo] -> Printer ()
prettyApp Name NodeInfo
name [Pat NodeInfo]
pats
TabStop -> Printer ()
atTabStop TabStop
stopRhs
Rhs NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Rhs NodeInfo
rhs
(Binds NodeInfo -> Printer ())
-> Maybe (Binds NodeInfo) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Binds NodeInfo -> Printer ()
prettyBinds Maybe (Binds NodeInfo)
mbinds
prettyPrint (InfixMatch NodeInfo
_ Pat NodeInfo
pat Name NodeInfo
name [Pat NodeInfo]
pats Rhs NodeInfo
rhs Maybe (Binds NodeInfo)
mbinds) = do
Printer () -> Printer ()
forall a. Printer a -> Printer a
onside (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
(LayoutConfig -> Layout) -> Printer () -> Printer () -> Printer ()
forall a.
(LayoutConfig -> Layout) -> Printer a -> Printer a -> Printer a
withLayout LayoutConfig -> Layout
cfgLayoutInfixApp Printer ()
flex Printer ()
vertical
TabStop -> Printer ()
atTabStop TabStop
stopRhs
Rhs NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Rhs NodeInfo
rhs
(Binds NodeInfo -> Printer ())
-> Maybe (Binds NodeInfo) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Binds NodeInfo -> Printer ()
prettyBinds Maybe (Binds NodeInfo)
mbinds
where
flex :: Printer ()
flex = do
Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
pat
LayoutContext
-> ByteString
-> Printer ()
-> (Printer () -> Printer ())
-> Printer ()
forall a.
LayoutContext
-> ByteString
-> Printer ()
-> (Printer () -> Printer a)
-> Printer a
withOperatorFormatting LayoutContext
Pattern
(Name NodeInfo -> ByteString
forall a. Name a -> ByteString
opName'' Name NodeInfo
name)
(Op NodeInfo -> Printer ()
forall (ast :: * -> *).
Pretty (ast NodeInfo) =>
ast NodeInfo -> Printer ()
prettyHSE (Op NodeInfo -> Printer ()) -> Op NodeInfo -> Printer ()
forall a b. (a -> b) -> a -> b
$ NodeInfo -> Name NodeInfo -> Op NodeInfo
forall l. l -> Name l -> Op l
VarOp NodeInfo
noNodeInfo Name NodeInfo
name)
Printer () -> Printer ()
forall a. a -> a
id
Printer () -> [Printer ()] -> Printer ()
inter Printer ()
spaceOrNewline ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (Pat NodeInfo -> Printer ()) -> [Pat NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty [Pat NodeInfo]
pats
vertical :: Printer ()
vertical = do
Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
pat
LayoutContext
-> ByteString
-> Printer ()
-> (Printer () -> Printer ())
-> Printer ()
forall a.
LayoutContext
-> ByteString
-> Printer ()
-> (Printer () -> Printer a)
-> Printer a
withOperatorFormattingV LayoutContext
Pattern
(Name NodeInfo -> ByteString
forall a. Name a -> ByteString
opName'' Name NodeInfo
name)
(Op NodeInfo -> Printer ()
forall (ast :: * -> *).
Pretty (ast NodeInfo) =>
ast NodeInfo -> Printer ()
prettyHSE (Op NodeInfo -> Printer ()) -> Op NodeInfo -> Printer ()
forall a b. (a -> b) -> a -> b
$ NodeInfo -> Name NodeInfo -> Op NodeInfo
forall l. l -> Name l -> Op l
VarOp NodeInfo
noNodeInfo Name NodeInfo
name)
Printer () -> Printer ()
forall a. a -> a
id
[Pat NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
[ast NodeInfo] -> Printer ()
linedOnside [Pat NodeInfo]
pats
instance Pretty Rhs where
prettyPrint :: Rhs NodeInfo -> Printer ()
prettyPrint (UnGuardedRhs NodeInfo
_ Exp NodeInfo
expr) =
Printer () -> Printer ()
forall a. Printer a -> Printer a
cut (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ (LayoutConfig -> Layout) -> Printer () -> Printer () -> Printer ()
forall a.
(LayoutConfig -> Layout) -> Printer a -> Printer a -> Printer a
withLayout LayoutConfig -> Layout
cfgLayoutDeclaration Printer ()
flex Printer ()
vertical
where
flex :: Printer ()
flex = do
LayoutContext -> ByteString -> Printer ()
operator LayoutContext
Declaration ByteString
"="
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr
vertical :: Printer ()
vertical = do
LayoutContext -> ByteString -> Printer ()
operatorV LayoutContext
Declaration ByteString
"="
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr
prettyPrint (GuardedRhss NodeInfo
_ [GuardedRhs NodeInfo]
guardedrhss) =
(IndentConfig -> Indent) -> Printer () -> Printer ()
forall a. (IndentConfig -> Indent) -> Printer a -> Printer a
withIndent IndentConfig -> Indent
cfgIndentMultiIf (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ [GuardedRhs NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
[ast NodeInfo] -> Printer ()
linedOnside [GuardedRhs NodeInfo]
guardedrhss
instance Pretty GuardedRhs where
prettyPrint :: GuardedRhs NodeInfo -> Printer ()
prettyPrint (GuardedRhs NodeInfo
_ [Stmt NodeInfo]
stmts Exp NodeInfo
expr) =
(LayoutConfig -> Layout) -> Printer () -> Printer () -> Printer ()
forall a.
(LayoutConfig -> Layout) -> Printer a -> Printer a -> Printer a
withLayout LayoutConfig -> Layout
cfgLayoutDeclaration Printer ()
flex Printer ()
vertical
where
flex :: Printer ()
flex = do
LayoutContext -> ByteString -> Printer () -> Printer ()
operatorSectionR LayoutContext
Pattern ByteString
"|" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Printer ()
write ByteString
"|"
Printer () -> [Printer ()] -> Printer ()
inter Printer ()
comma ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (Stmt NodeInfo -> Printer ()) -> [Stmt NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Stmt NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty [Stmt NodeInfo]
stmts
LayoutContext -> ByteString -> Printer ()
operator LayoutContext
Declaration ByteString
"="
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr
vertical :: Printer ()
vertical = do
LayoutContext -> ByteString -> Printer () -> Printer ()
operatorSectionR LayoutContext
Pattern ByteString
"|" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Printer ()
write ByteString
"|"
Printer () -> [Printer ()] -> Printer ()
inter Printer ()
comma ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (Stmt NodeInfo -> Printer ()) -> [Stmt NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Stmt NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty [Stmt NodeInfo]
stmts
LayoutContext -> ByteString -> Printer ()
operatorV LayoutContext
Declaration ByteString
"="
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr
instance Pretty Context where
prettyPrint :: Context NodeInfo -> Printer ()
prettyPrint (CxSingle NodeInfo
_ Asst NodeInfo
asst) = do
Asst NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Asst NodeInfo
asst
LayoutContext -> ByteString -> Printer ()
operator LayoutContext
Type ByteString
"=>"
prettyPrint (CxTuple NodeInfo
_ [Asst NodeInfo]
assts) = do
LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [Asst NodeInfo]
-> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [ast NodeInfo]
-> Printer ()
list LayoutContext
Type ByteString
"(" ByteString
")" ByteString
"," [Asst NodeInfo]
assts
LayoutContext -> ByteString -> Printer ()
operator LayoutContext
Type ByteString
"=>"
prettyPrint (CxEmpty NodeInfo
_) = do
ByteString -> Printer ()
write ByteString
"()"
LayoutContext -> ByteString -> Printer ()
operator LayoutContext
Type ByteString
"=>"
instance Pretty FunDep where
prettyPrint :: FunDep NodeInfo -> Printer ()
prettyPrint (FunDep NodeInfo
_ [Name NodeInfo]
names [Name NodeInfo]
names') = do
Printer () -> [Printer ()] -> Printer ()
inter Printer ()
space ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (Name NodeInfo -> Printer ()) -> [Name NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty [Name NodeInfo]
names
LayoutContext -> ByteString -> Printer ()
operator LayoutContext
Declaration ByteString
"->"
Printer () -> [Printer ()] -> Printer ()
inter Printer ()
space ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (Name NodeInfo -> Printer ()) -> [Name NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty [Name NodeInfo]
names'
#if MIN_VERSION_haskell_src_exts(1,22,0)
instance Pretty Asst where
prettyPrint :: Asst NodeInfo -> Printer ()
prettyPrint (TypeA NodeInfo
_ Type NodeInfo
ty) = Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty
prettyPrint (IParam NodeInfo
_ IPName NodeInfo
ipname Type NodeInfo
ty) = LayoutContext -> [IPName NodeInfo] -> Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
LayoutContext -> [ast NodeInfo] -> Type NodeInfo -> Printer ()
prettyTypesig LayoutContext
Declaration [ IPName NodeInfo
ipname ] Type NodeInfo
ty
prettyPrint (ParenA NodeInfo
_ Asst NodeInfo
asst) = Printer () -> Printer ()
parens (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Asst NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Asst NodeInfo
asst
#else
instance Pretty Asst where
prettyPrint (ClassA _ qname types) = do
pretty qname
space
inter space $ map pretty types
prettyPrint (AppA _ name types) = do
pretty name
space
inter space $ map pretty types
prettyPrint (InfixA _ ty qname ty') = do
pretty ty
withOperatorFormatting Type
(opName' qname)
(prettyHSE $ QVarOp noNodeInfo qname)
id
pretty ty'
prettyPrint (IParam _ ipname ty) = prettyTypesig Declaration [ ipname ] ty
prettyPrint (EqualP _ ty ty') = do
pretty ty
operator Type "~"
pretty ty'
prettyPrint (ParenA _ asst) = parens $ pretty asst
prettyPrint (WildCardA _ mname) = do
write "_"
mapM_ pretty mname
#endif
instance Pretty Type where
prettyPrint :: Type NodeInfo -> Printer ()
prettyPrint Type NodeInfo
t = do
TypeLayout
layout <- (PrintState -> TypeLayout) -> Printer TypeLayout
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> TypeLayout
psTypeLayout
case TypeLayout
layout of
TypeLayout
TypeFree -> (LayoutConfig -> Layout) -> Printer () -> Printer () -> Printer ()
forall a.
(LayoutConfig -> Layout) -> Printer a -> Printer a -> Printer a
withLayout LayoutConfig -> Layout
cfgLayoutType Printer ()
flex Printer ()
vertical
TypeLayout
TypeFlex -> Type NodeInfo -> Printer ()
prettyF Type NodeInfo
t
TypeLayout
TypeVertical -> Type NodeInfo -> Printer ()
prettyV Type NodeInfo
t
where
flex :: Printer ()
flex = TypeLayout -> Printer () -> Printer ()
withTypeLayout TypeLayout
TypeFlex (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Type NodeInfo -> Printer ()
prettyF Type NodeInfo
t
vertical :: Printer ()
vertical = TypeLayout -> Printer () -> Printer ()
withTypeLayout TypeLayout
TypeVertical (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Type NodeInfo -> Printer ()
prettyV Type NodeInfo
t
withTypeLayout :: TypeLayout -> Printer () -> Printer ()
withTypeLayout :: TypeLayout -> Printer () -> Printer ()
withTypeLayout TypeLayout
l Printer ()
p = do
TypeLayout
layout <- (PrintState -> TypeLayout) -> Printer TypeLayout
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> TypeLayout
psTypeLayout
(PrintState -> PrintState) -> Printer ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((PrintState -> PrintState) -> Printer ())
-> (PrintState -> PrintState) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \PrintState
s -> PrintState
s { psTypeLayout :: TypeLayout
psTypeLayout = TypeLayout
l }
Printer ()
p
(PrintState -> PrintState) -> Printer ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((PrintState -> PrintState) -> Printer ())
-> (PrintState -> PrintState) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \PrintState
s -> PrintState
s { psTypeLayout :: TypeLayout
psTypeLayout = TypeLayout
layout }
prettyF :: Type NodeInfo -> Printer ()
prettyF (TyForall NodeInfo
_ Maybe [TyVarBind NodeInfo]
mtyvarbinds Maybe (Context NodeInfo)
mcontext Type NodeInfo
ty) = do
([TyVarBind NodeInfo] -> Printer ())
-> Maybe [TyVarBind NodeInfo] -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [TyVarBind NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
[ast NodeInfo] -> Printer ()
prettyForall Maybe [TyVarBind NodeInfo]
mtyvarbinds
(Context NodeInfo -> Printer ())
-> Maybe (Context NodeInfo) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Context NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Maybe (Context NodeInfo)
mcontext
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty
prettyF (TyFun NodeInfo
_ Type NodeInfo
ty Type NodeInfo
ty') = do
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty
LayoutContext -> ByteString -> Printer ()
operator LayoutContext
Type ByteString
"->"
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty'
prettyF (TyTuple NodeInfo
_ Boxed
boxed [Type NodeInfo]
tys) = case Boxed
boxed of
Boxed
Unboxed -> LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [Type NodeInfo]
-> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [ast NodeInfo]
-> Printer ()
list LayoutContext
Type ByteString
"(#" ByteString
"#)" ByteString
"," [Type NodeInfo]
tys
Boxed
Boxed -> LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [Type NodeInfo]
-> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [ast NodeInfo]
-> Printer ()
list LayoutContext
Type ByteString
"(" ByteString
")" ByteString
"," [Type NodeInfo]
tys
#if MIN_VERSION_haskell_src_exts(1,20,0)
prettyF (TyUnboxedSum NodeInfo
_ [Type NodeInfo]
tys) = LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [Type NodeInfo]
-> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [ast NodeInfo]
-> Printer ()
list LayoutContext
Type ByteString
"(#" ByteString
"#)" ByteString
"|" [Type NodeInfo]
tys
#endif
prettyF (TyList NodeInfo
_ Type NodeInfo
ty) = LayoutContext
-> ByteString -> ByteString -> Printer () -> Printer ()
group LayoutContext
Type ByteString
"[" ByteString
"]" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty
prettyF (TyParArray NodeInfo
_ Type NodeInfo
ty) = LayoutContext
-> ByteString -> ByteString -> Printer () -> Printer ()
group LayoutContext
Type ByteString
"[:" ByteString
":]" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty
prettyF ty :: Type NodeInfo
ty@TyApp{} = case (Type NodeInfo -> Maybe (Type NodeInfo, Type NodeInfo))
-> Type NodeInfo -> [Type NodeInfo]
forall (ast :: * -> *).
Annotated ast =>
(ast NodeInfo -> Maybe (ast NodeInfo, ast NodeInfo))
-> ast NodeInfo -> [ast NodeInfo]
flattenApp Type NodeInfo -> Maybe (Type NodeInfo, Type NodeInfo)
forall l. Type l -> Maybe (Type l, Type l)
flatten Type NodeInfo
ty of
Type NodeInfo
ctor : [Type NodeInfo]
args -> Type NodeInfo -> [Type NodeInfo] -> Printer ()
forall (ast1 :: * -> *) (ast2 :: * -> *).
(Annotated ast1, Annotated ast2, Pretty ast1, Pretty ast2) =>
ast1 NodeInfo -> [ast2 NodeInfo] -> Printer ()
prettyApp Type NodeInfo
ctor [Type NodeInfo]
args
[] -> String -> Printer ()
forall a. HasCallStack => String -> a
error String
"impossible"
where
flatten :: Type l -> Maybe (Type l, Type l)
flatten (TyApp l
_ Type l
a Type l
b) = (Type l, Type l) -> Maybe (Type l, Type l)
forall a. a -> Maybe a
Just (Type l
a, Type l
b)
flatten Type l
_ = Maybe (Type l, Type l)
forall a. Maybe a
Nothing
prettyF (TyVar NodeInfo
_ Name NodeInfo
name) = Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Name NodeInfo
name
prettyF (TyCon NodeInfo
_ QName NodeInfo
qname) = QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
qname
prettyF (TyParen NodeInfo
_ Type NodeInfo
ty) = Printer () -> Printer ()
parens (Printer () -> Printer ())
-> (Printer () -> Printer ()) -> Printer () -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeLayout -> Printer () -> Printer ()
withTypeLayout TypeLayout
TypeFree (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty
#if MIN_VERSION_haskell_src_exts(1,20,0)
prettyF (TyInfix NodeInfo
_ Type NodeInfo
ty MaybePromotedName NodeInfo
op Type NodeInfo
ty') = do
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty
LayoutContext
-> ByteString
-> Printer ()
-> (Printer () -> Printer ())
-> Printer ()
forall a.
LayoutContext
-> ByteString
-> Printer ()
-> (Printer () -> Printer a)
-> Printer a
withOperatorFormatting LayoutContext
Type ByteString
opname (MaybePromotedName NodeInfo -> Printer ()
forall (ast :: * -> *).
Pretty (ast NodeInfo) =>
ast NodeInfo -> Printer ()
prettyHSE MaybePromotedName NodeInfo
op) Printer () -> Printer ()
forall a. a -> a
id
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty'
where
opname :: ByteString
opname = QName NodeInfo -> ByteString
forall a. QName a -> ByteString
opName' (QName NodeInfo -> ByteString) -> QName NodeInfo -> ByteString
forall a b. (a -> b) -> a -> b
$ case MaybePromotedName NodeInfo
op of
PromotedName NodeInfo
_ QName NodeInfo
qname -> QName NodeInfo
qname
UnpromotedName NodeInfo
_ QName NodeInfo
qname -> QName NodeInfo
qname
#else
prettyF (TyInfix _ ty qname ty') = do
pretty ty
withOperatorFormatting Type (opName' qname) (prettyHSE qname) id
pretty ty'
#endif
prettyF (TyKind NodeInfo
_ Type NodeInfo
ty Type NodeInfo
kind) = do
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty
LayoutContext -> ByteString -> Printer ()
operator LayoutContext
Type ByteString
"::"
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
kind
prettyF (TyPromoted NodeInfo
_ Promoted NodeInfo
promoted) = Promoted NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Promoted NodeInfo
promoted
prettyF (TyEquals NodeInfo
_ Type NodeInfo
ty Type NodeInfo
ty') = do
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty
LayoutContext -> ByteString -> Printer ()
operator LayoutContext
Type ByteString
"~"
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty'
prettyF (TySplice NodeInfo
_ Splice NodeInfo
splice) = Splice NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Splice NodeInfo
splice
prettyF (TyBang NodeInfo
_ BangType NodeInfo
bangtype Unpackedness NodeInfo
unpackedness Type NodeInfo
ty) = do
Unpackedness NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Unpackedness NodeInfo
unpackedness
BangType NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty BangType NodeInfo
bangtype
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty
prettyF ty :: Type NodeInfo
ty@(TyWildCard NodeInfo
_ Maybe (Name NodeInfo)
_mname) = Type NodeInfo -> Printer ()
forall (ast :: * -> *).
Pretty (ast NodeInfo) =>
ast NodeInfo -> Printer ()
prettyHSE Type NodeInfo
ty
prettyF (TyQuasiQuote NodeInfo
_ String
str String
str') = do
ByteString -> Printer ()
write ByteString
"["
String -> Printer ()
string String
str
ByteString -> Printer ()
write ByteString
"|"
String -> Printer ()
string String
str'
ByteString -> Printer ()
write ByteString
"|]"
#if MIN_VERSION_haskell_src_exts(1,21,0)
prettyF (TyStar NodeInfo
_) = ByteString -> Printer ()
write ByteString
"*"
#endif
prettyV :: Type NodeInfo -> Printer ()
prettyV (TyForall NodeInfo
_ Maybe [TyVarBind NodeInfo]
mtyvarbinds Maybe (Context NodeInfo)
mcontext Type NodeInfo
ty) = do
Maybe [TyVarBind NodeInfo]
-> ([TyVarBind NodeInfo] -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe [TyVarBind NodeInfo]
mtyvarbinds (([TyVarBind NodeInfo] -> Printer ()) -> Printer ())
-> ([TyVarBind NodeInfo] -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \[TyVarBind NodeInfo]
tyvarbinds -> do
ByteString -> Printer ()
write ByteString
"forall "
Printer () -> [Printer ()] -> Printer ()
inter Printer ()
space ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (TyVarBind NodeInfo -> Printer ())
-> [TyVarBind NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map TyVarBind NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty [TyVarBind NodeInfo]
tyvarbinds
LayoutContext
-> ByteString
-> Printer ()
-> (Printer () -> Printer ())
-> Printer ()
forall a.
LayoutContext
-> ByteString
-> Printer ()
-> (Printer () -> Printer a)
-> Printer a
withOperatorFormattingV LayoutContext
Type ByteString
"." (ByteString -> Printer ()
write ByteString
"." Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space) Printer () -> Printer ()
forall a. a -> a
id
Maybe (Context NodeInfo)
-> (Context NodeInfo -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (Context NodeInfo)
mcontext ((Context NodeInfo -> Printer ()) -> Printer ())
-> (Context NodeInfo -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \Context NodeInfo
context -> do
case Context NodeInfo
context of
(CxSingle NodeInfo
_ Asst NodeInfo
asst) -> Asst NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Asst NodeInfo
asst
(CxTuple NodeInfo
_ [Asst NodeInfo]
assts) -> LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [Asst NodeInfo]
-> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [ast NodeInfo]
-> Printer ()
list LayoutContext
Type ByteString
"(" ByteString
")" ByteString
"," [Asst NodeInfo]
assts
(CxEmpty NodeInfo
_) -> ByteString -> Printer ()
write ByteString
"()"
LayoutContext -> ByteString -> Printer ()
operatorV LayoutContext
Type ByteString
"=>"
Type NodeInfo -> Printer ()
prettyV Type NodeInfo
ty
prettyV (TyFun NodeInfo
_ Type NodeInfo
ty Type NodeInfo
ty') = do
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty
LayoutContext -> ByteString -> Printer ()
operatorV LayoutContext
Type ByteString
"->"
Type NodeInfo -> Printer ()
prettyV Type NodeInfo
ty'
prettyV Type NodeInfo
ty = Type NodeInfo -> Printer ()
prettyF Type NodeInfo
ty
#if !MIN_VERSION_haskell_src_exts(1,21,0)
instance Pretty Kind where
prettyPrint (KindStar _) = write "*"
prettyPrint (KindFn _ kind kind') = do
pretty kind
operator Type "->"
pretty kind'
prettyPrint (KindParen _ kind) = parens $ pretty kind
prettyPrint (KindVar _ qname) = pretty qname
prettyPrint (KindApp _ kind kind') = do
pretty kind
space
pretty kind'
prettyPrint (KindTuple _ kinds) = list Type "'(" ")" "," kinds
prettyPrint (KindList _ kind) = group Type "'[" "]" $ pretty kind
#endif
instance Pretty Promoted where
prettyPrint :: Promoted NodeInfo -> Printer ()
prettyPrint (PromotedInteger NodeInfo
_ Integer
_ String
str) = String -> Printer ()
string String
str
prettyPrint (PromotedString NodeInfo
_ String
_ String
str) = do
ByteString -> Printer ()
write ByteString
"\""
String -> Printer ()
string String
str
ByteString -> Printer ()
write ByteString
"\""
prettyPrint (PromotedCon NodeInfo
_ Bool
quote QName NodeInfo
qname) = do
Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
quote (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Printer ()
write ByteString
"'"
QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
qname
prettyPrint (PromotedList NodeInfo
_ Bool
quote [Type NodeInfo]
tys) = do
Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
quote (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Printer ()
write ByteString
"'"
LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [Type NodeInfo]
-> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [ast NodeInfo]
-> Printer ()
list LayoutContext
Expression ByteString
"[" ByteString
"]" ByteString
"," [Type NodeInfo]
tys
prettyPrint (PromotedTuple NodeInfo
_ [Type NodeInfo]
tys) = do
ByteString -> Printer ()
write ByteString
"'"
LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [Type NodeInfo]
-> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [ast NodeInfo]
-> Printer ()
list LayoutContext
Expression ByteString
"(" ByteString
")" ByteString
"," [Type NodeInfo]
tys
prettyPrint (PromotedUnit NodeInfo
_) = ByteString -> Printer ()
write ByteString
"'()"
instance Pretty TyVarBind where
prettyPrint :: TyVarBind NodeInfo -> Printer ()
prettyPrint (KindedVar NodeInfo
_ Name NodeInfo
name Type NodeInfo
kind) = Printer () -> Printer ()
parens (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Name NodeInfo
name
LayoutContext -> ByteString -> Printer ()
operator LayoutContext
Type ByteString
"::"
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
kind
prettyPrint (UnkindedVar NodeInfo
_ Name NodeInfo
name) = Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Name NodeInfo
name
instance Pretty TypeEqn where
prettyPrint :: TypeEqn NodeInfo -> Printer ()
prettyPrint (TypeEqn NodeInfo
_ Type NodeInfo
ty Type NodeInfo
ty') = do
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty
LayoutContext -> ByteString -> Printer ()
operator LayoutContext
Type ByteString
"="
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty'
flexibleOneline :: Printer a -> Printer a
flexibleOneline :: Printer a -> Printer a
flexibleOneline Printer a
p = do
Bool
allowOneline <- (OptionConfig -> Bool) -> Printer Bool
forall a. (OptionConfig -> a) -> Printer a
getOption OptionConfig -> Bool
cfgOptionFlexibleOneline
if Bool
allowOneline then Printer a -> Printer a
forall a. Printer a -> Printer a
ignoreOneline Printer a
p else Printer a
p
instance Pretty Exp where
prettyPrint :: Exp NodeInfo -> Printer ()
prettyPrint (Var NodeInfo
_ QName NodeInfo
qname) = QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
qname
prettyPrint (OverloadedLabel NodeInfo
_ String
str) = do
ByteString -> Printer ()
write ByteString
"#"
String -> Printer ()
string String
str
prettyPrint (IPVar NodeInfo
_ IPName NodeInfo
ipname) = IPName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty IPName NodeInfo
ipname
prettyPrint (Con NodeInfo
_ QName NodeInfo
qname) = QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
qname
prettyPrint (Lit NodeInfo
_ Literal NodeInfo
literal) = Literal NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Literal NodeInfo
literal
prettyPrint e :: Exp NodeInfo
e@(InfixApp NodeInfo
_ Exp NodeInfo
_ QOp NodeInfo
qop Exp NodeInfo
_) =
(QOp NodeInfo -> ByteString)
-> LayoutContext
-> (Exp NodeInfo, [(QOp NodeInfo, Exp NodeInfo)])
-> Printer ()
forall (ast :: * -> *) (op :: * -> *).
(Annotated ast, Pretty ast, Annotated op, Pretty (op NodeInfo)) =>
(op NodeInfo -> ByteString)
-> LayoutContext
-> (ast NodeInfo, [(op NodeInfo, ast NodeInfo)])
-> Printer ()
prettyInfixApp QOp NodeInfo -> ByteString
forall a. QOp a -> ByteString
opName LayoutContext
Expression ((Exp NodeInfo, [(QOp NodeInfo, Exp NodeInfo)]) -> Printer ())
-> (Exp NodeInfo, [(QOp NodeInfo, Exp NodeInfo)]) -> Printer ()
forall a b. (a -> b) -> a -> b
$ (Exp NodeInfo -> Maybe (Exp NodeInfo, QOp NodeInfo, Exp NodeInfo))
-> Exp NodeInfo -> (Exp NodeInfo, [(QOp NodeInfo, Exp NodeInfo)])
forall (ast1 :: * -> *) (ast2 :: * -> *).
(Annotated ast1, Annotated ast2) =>
(ast1 NodeInfo
-> Maybe (ast1 NodeInfo, ast2 NodeInfo, ast1 NodeInfo))
-> ast1 NodeInfo
-> (ast1 NodeInfo, [(ast2 NodeInfo, ast1 NodeInfo)])
flattenInfix Exp NodeInfo -> Maybe (Exp NodeInfo, QOp NodeInfo, Exp NodeInfo)
flattenInfixApp Exp NodeInfo
e
where
flattenInfixApp :: Exp NodeInfo -> Maybe (Exp NodeInfo, QOp NodeInfo, Exp NodeInfo)
flattenInfixApp (InfixApp NodeInfo
_ Exp NodeInfo
lhs QOp NodeInfo
qop' Exp NodeInfo
rhs) =
if QOp NodeInfo -> QOp NodeInfo -> Ordering
forall (ast :: * -> *).
(Functor ast, Ord (ast ())) =>
ast NodeInfo -> ast NodeInfo -> Ordering
compareAST QOp NodeInfo
qop QOp NodeInfo
qop' Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ
then (Exp NodeInfo, QOp NodeInfo, Exp NodeInfo)
-> Maybe (Exp NodeInfo, QOp NodeInfo, Exp NodeInfo)
forall a. a -> Maybe a
Just (Exp NodeInfo
lhs, QOp NodeInfo
qop', Exp NodeInfo
rhs)
else Maybe (Exp NodeInfo, QOp NodeInfo, Exp NodeInfo)
forall a. Maybe a
Nothing
flattenInfixApp Exp NodeInfo
_ = Maybe (Exp NodeInfo, QOp NodeInfo, Exp NodeInfo)
forall a. Maybe a
Nothing
prettyPrint e :: Exp NodeInfo
e@App{} = case (Exp NodeInfo -> Maybe (Exp NodeInfo, Exp NodeInfo))
-> Exp NodeInfo -> [Exp NodeInfo]
forall (ast :: * -> *).
Annotated ast =>
(ast NodeInfo -> Maybe (ast NodeInfo, ast NodeInfo))
-> ast NodeInfo -> [ast NodeInfo]
flattenApp Exp NodeInfo -> Maybe (Exp NodeInfo, Exp NodeInfo)
forall l. Exp l -> Maybe (Exp l, Exp l)
flatten Exp NodeInfo
e of
Exp NodeInfo
fn : [Exp NodeInfo]
args -> Exp NodeInfo -> [Exp NodeInfo] -> Printer ()
forall (ast1 :: * -> *) (ast2 :: * -> *).
(Annotated ast1, Annotated ast2, Pretty ast1, Pretty ast2) =>
ast1 NodeInfo -> [ast2 NodeInfo] -> Printer ()
prettyApp Exp NodeInfo
fn [Exp NodeInfo]
args
[] -> String -> Printer ()
forall a. HasCallStack => String -> a
error String
"impossible"
where
flatten :: Exp l -> Maybe (Exp l, Exp l)
flatten (App l
_ Exp l
fn Exp l
arg) = (Exp l, Exp l) -> Maybe (Exp l, Exp l)
forall a. a -> Maybe a
Just (Exp l
fn, Exp l
arg)
flatten Exp l
_ = Maybe (Exp l, Exp l)
forall a. Maybe a
Nothing
prettyPrint (NegApp NodeInfo
_ Exp NodeInfo
expr) = do
ByteString -> Printer ()
write ByteString
"-"
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr
prettyPrint (Lambda NodeInfo
_ [Pat NodeInfo]
pats Exp NodeInfo
expr) = do
ByteString -> Printer ()
write ByteString
"\\"
Printer ()
maybeSpace
Printer () -> [Printer ()] -> Printer ()
inter Printer ()
space ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (Pat NodeInfo -> Printer ()) -> [Pat NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty [Pat NodeInfo]
pats
Printer () -> Printer ()
forall a. Printer a -> Printer a
flexibleOneline (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
LayoutContext -> ByteString -> Printer ()
operator LayoutContext
Expression ByteString
"->"
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr
where
maybeSpace :: Printer ()
maybeSpace = case [Pat NodeInfo]
pats of
PIrrPat{} : [Pat NodeInfo]
_ -> Printer ()
space
PBangPat{} : [Pat NodeInfo]
_ -> Printer ()
space
[Pat NodeInfo]
_ -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
prettyPrint (Let NodeInfo
_ Binds NodeInfo
binds Exp NodeInfo
expr) = (LayoutConfig -> Layout) -> Printer () -> Printer () -> Printer ()
forall a.
(LayoutConfig -> Layout) -> Printer a -> Printer a -> Printer a
withLayout LayoutConfig -> Layout
cfgLayoutLet Printer ()
flex Printer ()
vertical
where
flex :: Printer ()
flex = do
ByteString -> Printer ()
write ByteString
"let "
CompactBinds NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
prettyOnside (Binds NodeInfo -> CompactBinds NodeInfo
forall l. Binds l -> CompactBinds l
CompactBinds Binds NodeInfo
binds)
Printer ()
spaceOrNewline
Bool
nl <- (PrintState -> Bool) -> Printer Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Bool
psNewline
Bool
alignP <- (OptionConfig -> Bool) -> Printer Bool
forall a. (OptionConfig -> a) -> Printer a
getOption OptionConfig -> Bool
cfgOptionAlignLetBindsAndInExpr
ByteString -> Printer ()
write (ByteString -> Printer ()) -> ByteString -> Printer ()
forall a b. (a -> b) -> a -> b
$ if Bool
nl Bool -> Bool -> Bool
&& Bool
alignP then ByteString
"in " else ByteString
"in "
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
prettyOnside Exp NodeInfo
expr
vertical :: Printer ()
vertical = (IndentConfig -> Indent) -> Printer () -> Printer () -> Printer ()
forall a.
(IndentConfig -> Indent) -> Printer () -> Printer a -> Printer a
withIndentAfter
IndentConfig -> Indent
cfgIndentLet
(do
ByteString -> Printer ()
write ByteString
"let"
(IndentConfig -> Indent) -> Printer () -> Printer ()
forall a. (IndentConfig -> Indent) -> Printer a -> Printer a
withIndent IndentConfig -> Indent
cfgIndentLetBinds (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$
CompactBinds NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty (Binds NodeInfo -> CompactBinds NodeInfo
forall l. Binds l -> CompactBinds l
CompactBinds Binds NodeInfo
binds))
(do
Printer ()
newline
Bool
alignP <- (OptionConfig -> Bool) -> Printer Bool
forall a. (OptionConfig -> a) -> Printer a
getOption OptionConfig -> Bool
cfgOptionAlignLetBindsAndInExpr
ByteString -> Printer ()
write (ByteString -> Printer ()) -> ByteString -> Printer ()
forall a b. (a -> b) -> a -> b
$ if Bool
alignP then ByteString
"in " else ByteString
"in"
(IndentConfig -> Indent) -> Printer () -> Printer ()
forall a. (IndentConfig -> Indent) -> Printer a -> Printer a
withIndent IndentConfig -> Indent
cfgIndentLetIn (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr)
prettyPrint (If NodeInfo
_ Exp NodeInfo
expr Exp NodeInfo
expr' Exp NodeInfo
expr'') = (LayoutConfig -> Layout) -> Printer () -> Printer () -> Printer ()
forall a.
(LayoutConfig -> Layout) -> Printer a -> Printer a -> Printer a
withLayout LayoutConfig -> Layout
cfgLayoutIf Printer ()
flex Printer ()
vertical
where
flex :: Printer ()
flex = do
ByteString -> Printer ()
write ByteString
"if "
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
prettyOnside Exp NodeInfo
expr
Printer ()
spaceOrNewline
ByteString -> Printer ()
write ByteString
"then "
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
prettyOnside Exp NodeInfo
expr'
Printer ()
spaceOrNewline
ByteString -> Printer ()
write ByteString
"else "
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
prettyOnside Exp NodeInfo
expr''
vertical :: Printer ()
vertical = (IndentConfig -> Indent) -> Printer () -> Printer () -> Printer ()
forall a.
(IndentConfig -> Indent) -> Printer () -> Printer a -> Printer a
withIndentAfter IndentConfig -> Indent
cfgIndentIf
(do
ByteString -> Printer ()
write ByteString
"if "
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
prettyOnside Exp NodeInfo
expr)
(do
Printer ()
newline
ByteString -> Printer ()
write ByteString
"then "
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
prettyOnside Exp NodeInfo
expr'
Printer ()
newline
ByteString -> Printer ()
write ByteString
"else "
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
prettyOnside Exp NodeInfo
expr'')
prettyPrint (MultiIf NodeInfo
_ [GuardedRhs NodeInfo]
guardedrhss) = do
ByteString -> Printer ()
write ByteString
"if"
(IndentConfig -> Indent) -> Printer () -> Printer ()
forall a. (IndentConfig -> Indent) -> Printer a -> Printer a
withIndent IndentConfig -> Indent
cfgIndentMultiIf (Printer () -> Printer ())
-> ([GuardedAlt NodeInfo] -> Printer ())
-> [GuardedAlt NodeInfo]
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GuardedAlt NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
[ast NodeInfo] -> Printer ()
linedOnside ([GuardedAlt NodeInfo] -> Printer ())
-> [GuardedAlt NodeInfo] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GuardedRhs NodeInfo -> GuardedAlt NodeInfo)
-> [GuardedRhs NodeInfo] -> [GuardedAlt NodeInfo]
forall a b. (a -> b) -> [a] -> [b]
map GuardedRhs NodeInfo -> GuardedAlt NodeInfo
forall l. GuardedRhs l -> GuardedAlt l
GuardedAlt [GuardedRhs NodeInfo]
guardedrhss
prettyPrint (Case NodeInfo
_ Exp NodeInfo
expr [Alt NodeInfo]
alts) = do
ByteString -> Printer ()
write ByteString
"case "
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr
ByteString -> Printer ()
write ByteString
" of"
if [Alt NodeInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Alt NodeInfo]
alts
then ByteString -> Printer ()
write ByteString
" { }"
else Printer () -> Printer ()
forall a. Printer a -> Printer a
flexibleOneline (Printer () -> Printer ())
-> (Printer () -> Printer ()) -> Printer () -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IndentConfig -> Indent) -> Printer () -> Printer ()
forall a. (IndentConfig -> Indent) -> Printer a -> Printer a
withIndent IndentConfig -> Indent
cfgIndentCase
(Printer () -> Printer ())
-> (Printer () -> Printer ()) -> Printer () -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TabStop
-> (AlignConfig -> Bool)
-> (Alt NodeInfo -> Printer (Maybe [Int]))
-> [Alt NodeInfo]
-> Printer ()
-> Printer ()
forall a b.
TabStop
-> (AlignConfig -> Bool)
-> (a -> Printer (Maybe [Int]))
-> [a]
-> Printer b
-> Printer b
withComputedTabStop TabStop
stopRhs AlignConfig -> Bool
cfgAlignCase Alt NodeInfo -> Printer (Maybe [Int])
measureAlt [Alt NodeInfo]
alts (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$
[Alt NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
[ast NodeInfo] -> Printer ()
lined [Alt NodeInfo]
alts
prettyPrint (Do NodeInfo
_ [Stmt NodeInfo]
stmts) = Printer () -> Printer ()
forall a. Printer a -> Printer a
flexibleOneline (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
ByteString -> Printer ()
write ByteString
"do"
(IndentConfig -> Indent) -> Printer () -> Printer ()
forall a. (IndentConfig -> Indent) -> Printer a -> Printer a
withIndent IndentConfig -> Indent
cfgIndentDo (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ [Stmt NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
[ast NodeInfo] -> Printer ()
linedOnside [Stmt NodeInfo]
stmts
prettyPrint (MDo NodeInfo
_ [Stmt NodeInfo]
stmts) = Printer () -> Printer ()
forall a. Printer a -> Printer a
flexibleOneline (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
ByteString -> Printer ()
write ByteString
"mdo"
(IndentConfig -> Indent) -> Printer () -> Printer ()
forall a. (IndentConfig -> Indent) -> Printer a -> Printer a
withIndent IndentConfig -> Indent
cfgIndentDo (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ [Stmt NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
[ast NodeInfo] -> Printer ()
linedOnside [Stmt NodeInfo]
stmts
prettyPrint (Tuple NodeInfo
_ Boxed
boxed [Exp NodeInfo]
exprs) = case Boxed
boxed of
Boxed
Boxed -> LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [Exp NodeInfo]
-> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [ast NodeInfo]
-> Printer ()
list LayoutContext
Expression ByteString
"(" ByteString
")" ByteString
"," [Exp NodeInfo]
exprs
Boxed
Unboxed -> LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [Exp NodeInfo]
-> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [ast NodeInfo]
-> Printer ()
list LayoutContext
Expression ByteString
"(#" ByteString
"#)" ByteString
"," [Exp NodeInfo]
exprs
#if MIN_VERSION_haskell_src_exts(1,20,0)
prettyPrint (UnboxedSum NodeInfo
_ Int
before Int
after Exp NodeInfo
expr) = LayoutContext
-> ByteString -> ByteString -> Printer () -> Printer ()
group LayoutContext
Expression ByteString
"(#" ByteString
"#)"
(Printer () -> Printer ())
-> ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Printer () -> [Printer ()] -> Printer ()
inter Printer ()
space ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ Int -> Printer () -> [Printer ()]
forall a. Int -> a -> [a]
replicate Int
before (ByteString -> Printer ()
write ByteString
"|") [Printer ()] -> [Printer ()] -> [Printer ()]
forall a. [a] -> [a] -> [a]
++ [ Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr ]
[Printer ()] -> [Printer ()] -> [Printer ()]
forall a. [a] -> [a] -> [a]
++ Int -> Printer () -> [Printer ()]
forall a. Int -> a -> [a]
replicate Int
after (ByteString -> Printer ()
write ByteString
"|")
#endif
#if MIN_VERSION_haskell_src_exts(1,23,0)
prettyPrint (ArrOp NodeInfo
_ Exp NodeInfo
expr) = LayoutContext
-> ByteString -> ByteString -> Printer () -> Printer ()
group LayoutContext
Expression ByteString
"(|" ByteString
"|)" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr
#endif
prettyPrint (TupleSection NodeInfo
_ Boxed
boxed [Maybe (Exp NodeInfo)]
mexprs) = case Boxed
boxed of
Boxed
Boxed -> LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [MayAst Exp NodeInfo]
-> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [ast NodeInfo]
-> Printer ()
list LayoutContext
Expression ByteString
"(" ByteString
")" ByteString
"," ([MayAst Exp NodeInfo] -> Printer ())
-> [MayAst Exp NodeInfo] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (Maybe (Exp NodeInfo) -> MayAst Exp NodeInfo)
-> [Maybe (Exp NodeInfo)] -> [MayAst Exp NodeInfo]
forall a b. (a -> b) -> [a] -> [b]
map (NodeInfo -> Maybe (Exp NodeInfo) -> MayAst Exp NodeInfo
forall (a :: * -> *) l. l -> Maybe (a l) -> MayAst a l
MayAst NodeInfo
noNodeInfo) [Maybe (Exp NodeInfo)]
mexprs
Boxed
Unboxed -> LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [MayAst Exp NodeInfo]
-> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [ast NodeInfo]
-> Printer ()
list LayoutContext
Expression ByteString
"(#" ByteString
"#)" ByteString
"," ([MayAst Exp NodeInfo] -> Printer ())
-> [MayAst Exp NodeInfo] -> Printer ()
forall a b. (a -> b) -> a -> b
$
(Maybe (Exp NodeInfo) -> MayAst Exp NodeInfo)
-> [Maybe (Exp NodeInfo)] -> [MayAst Exp NodeInfo]
forall a b. (a -> b) -> [a] -> [b]
map (NodeInfo -> Maybe (Exp NodeInfo) -> MayAst Exp NodeInfo
forall (a :: * -> *) l. l -> Maybe (a l) -> MayAst a l
MayAst NodeInfo
noNodeInfo) [Maybe (Exp NodeInfo)]
mexprs
prettyPrint (List NodeInfo
_ [Exp NodeInfo]
exprs) = LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [Exp NodeInfo]
-> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [ast NodeInfo]
-> Printer ()
list LayoutContext
Expression ByteString
"[" ByteString
"]" ByteString
"," [Exp NodeInfo]
exprs
prettyPrint (ParArray NodeInfo
_ [Exp NodeInfo]
exprs) = LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [Exp NodeInfo]
-> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [ast NodeInfo]
-> Printer ()
list LayoutContext
Expression ByteString
"[:" ByteString
":]" ByteString
"," [Exp NodeInfo]
exprs
prettyPrint (Paren NodeInfo
_ Exp NodeInfo
expr) = Printer () -> Printer ()
parens (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr
prettyPrint (LeftSection NodeInfo
_ Exp NodeInfo
expr QOp NodeInfo
qop) = Printer () -> Printer ()
parens (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr
LayoutContext -> ByteString -> Printer () -> Printer ()
operatorSectionL LayoutContext
Expression (QOp NodeInfo -> ByteString
forall a. QOp a -> ByteString
opName QOp NodeInfo
qop) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ QOp NodeInfo -> Printer ()
forall (ast :: * -> *).
Pretty (ast NodeInfo) =>
ast NodeInfo -> Printer ()
prettyHSE QOp NodeInfo
qop
prettyPrint (RightSection NodeInfo
_ QOp NodeInfo
qop Exp NodeInfo
expr) = Printer () -> Printer ()
parens (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
LayoutContext -> ByteString -> Printer () -> Printer ()
operatorSectionR LayoutContext
Expression (QOp NodeInfo -> ByteString
forall a. QOp a -> ByteString
opName QOp NodeInfo
qop) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ QOp NodeInfo -> Printer ()
forall (ast :: * -> *).
Pretty (ast NodeInfo) =>
ast NodeInfo -> Printer ()
prettyHSE QOp NodeInfo
qop
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr
prettyPrint (RecConstr NodeInfo
_ QName NodeInfo
qname [FieldUpdate NodeInfo]
fieldupdates) =
(FieldUpdate NodeInfo -> Printer (Maybe Int))
-> LayoutContext
-> QName NodeInfo
-> [FieldUpdate NodeInfo]
-> Printer ()
forall (ast1 :: * -> *) (ast2 :: * -> *).
(Annotated ast1, Pretty ast1, Annotated ast2, Pretty ast2) =>
(ast2 NodeInfo -> Printer (Maybe Int))
-> LayoutContext -> ast1 NodeInfo -> [ast2 NodeInfo] -> Printer ()
prettyRecord FieldUpdate NodeInfo -> Printer (Maybe Int)
len LayoutContext
Expression QName NodeInfo
qname [FieldUpdate NodeInfo]
fieldupdates
where
len :: FieldUpdate NodeInfo -> Printer (Maybe Int)
len (FieldUpdate NodeInfo
_ QName NodeInfo
n Exp NodeInfo
_) = Printer () -> Printer (Maybe Int)
forall a. Printer a -> Printer (Maybe Int)
measure (Printer () -> Printer (Maybe Int))
-> Printer () -> Printer (Maybe Int)
forall a b. (a -> b) -> a -> b
$ QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
n
len (FieldPun NodeInfo
_ QName NodeInfo
n) = Printer () -> Printer (Maybe Int)
forall a. Printer a -> Printer (Maybe Int)
measure (Printer () -> Printer (Maybe Int))
-> Printer () -> Printer (Maybe Int)
forall a b. (a -> b) -> a -> b
$ QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
n
len (FieldWildcard NodeInfo
_) = Printer () -> Printer (Maybe Int)
forall a. Printer a -> Printer (Maybe Int)
measure (Printer () -> Printer (Maybe Int))
-> Printer () -> Printer (Maybe Int)
forall a b. (a -> b) -> a -> b
$ ByteString -> Printer ()
write ByteString
".."
prettyPrint (RecUpdate NodeInfo
_ Exp NodeInfo
expr [FieldUpdate NodeInfo]
fieldupdates) =
(FieldUpdate NodeInfo -> Printer (Maybe Int))
-> LayoutContext
-> Exp NodeInfo
-> [FieldUpdate NodeInfo]
-> Printer ()
forall (ast1 :: * -> *) (ast2 :: * -> *).
(Annotated ast1, Pretty ast1, Annotated ast2, Pretty ast2) =>
(ast2 NodeInfo -> Printer (Maybe Int))
-> LayoutContext -> ast1 NodeInfo -> [ast2 NodeInfo] -> Printer ()
prettyRecord FieldUpdate NodeInfo -> Printer (Maybe Int)
len LayoutContext
Expression Exp NodeInfo
expr [FieldUpdate NodeInfo]
fieldupdates
where
len :: FieldUpdate NodeInfo -> Printer (Maybe Int)
len (FieldUpdate NodeInfo
_ QName NodeInfo
n Exp NodeInfo
_) = Printer () -> Printer (Maybe Int)
forall a. Printer a -> Printer (Maybe Int)
measure (Printer () -> Printer (Maybe Int))
-> Printer () -> Printer (Maybe Int)
forall a b. (a -> b) -> a -> b
$ QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
n
len (FieldPun NodeInfo
_ QName NodeInfo
n) = Printer () -> Printer (Maybe Int)
forall a. Printer a -> Printer (Maybe Int)
measure (Printer () -> Printer (Maybe Int))
-> Printer () -> Printer (Maybe Int)
forall a b. (a -> b) -> a -> b
$ QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
n
len (FieldWildcard NodeInfo
_) = Printer () -> Printer (Maybe Int)
forall a. Printer a -> Printer (Maybe Int)
measure (Printer () -> Printer (Maybe Int))
-> Printer () -> Printer (Maybe Int)
forall a b. (a -> b) -> a -> b
$ ByteString -> Printer ()
write ByteString
".."
prettyPrint (EnumFrom NodeInfo
_ Exp NodeInfo
expr) = LayoutContext
-> ByteString -> ByteString -> Printer () -> Printer ()
group LayoutContext
Expression ByteString
"[" ByteString
"]" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr
LayoutContext -> ByteString -> Printer () -> Printer ()
operatorSectionL LayoutContext
Expression ByteString
".." (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Printer ()
write ByteString
".."
prettyPrint (EnumFromTo NodeInfo
_ Exp NodeInfo
expr Exp NodeInfo
expr') = LayoutContext
-> ByteString -> ByteString -> Printer () -> Printer ()
group LayoutContext
Expression ByteString
"[" ByteString
"]" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr
LayoutContext -> ByteString -> Printer ()
operator LayoutContext
Expression ByteString
".."
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr'
prettyPrint (EnumFromThen NodeInfo
_ Exp NodeInfo
expr Exp NodeInfo
expr') = LayoutContext
-> ByteString -> ByteString -> Printer () -> Printer ()
group LayoutContext
Expression ByteString
"[" ByteString
"]" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr
Printer ()
comma
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr'
LayoutContext -> ByteString -> Printer () -> Printer ()
operatorSectionL LayoutContext
Expression ByteString
".." (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Printer ()
write ByteString
".."
prettyPrint (EnumFromThenTo NodeInfo
_ Exp NodeInfo
expr Exp NodeInfo
expr' Exp NodeInfo
expr'') =
LayoutContext
-> ByteString -> ByteString -> Printer () -> Printer ()
group LayoutContext
Expression ByteString
"[" ByteString
"]" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr
Printer ()
comma
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr'
LayoutContext -> ByteString -> Printer ()
operator LayoutContext
Expression ByteString
".."
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr''
prettyPrint (ParArrayFromTo NodeInfo
_ Exp NodeInfo
expr Exp NodeInfo
expr') = LayoutContext
-> ByteString -> ByteString -> Printer () -> Printer ()
group LayoutContext
Expression ByteString
"[:" ByteString
":]" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr
LayoutContext -> ByteString -> Printer ()
operator LayoutContext
Expression ByteString
".."
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr'
prettyPrint (ParArrayFromThenTo NodeInfo
_ Exp NodeInfo
expr Exp NodeInfo
expr' Exp NodeInfo
expr'') =
LayoutContext
-> ByteString -> ByteString -> Printer () -> Printer ()
group LayoutContext
Expression ByteString
"[:" ByteString
":]" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr
Printer ()
comma
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr'
LayoutContext -> ByteString -> Printer ()
operator LayoutContext
Expression ByteString
".."
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr''
prettyPrint (ListComp NodeInfo
_ Exp NodeInfo
expr [QualStmt NodeInfo]
qualstmts) =
(LayoutConfig -> Layout) -> Printer () -> Printer () -> Printer ()
forall a.
(LayoutConfig -> Layout) -> Printer a -> Printer a -> Printer a
withLayout LayoutConfig -> Layout
cfgLayoutListComp Printer ()
flex Printer ()
vertical
where
flex :: Printer ()
flex = LayoutContext
-> ByteString -> ByteString -> Printer () -> Printer ()
group LayoutContext
Expression ByteString
"[" ByteString
"]" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
prettyOnside Exp NodeInfo
expr
LayoutContext -> ByteString -> Printer ()
operator LayoutContext
Expression ByteString
"|"
LayoutContext -> ByteString -> [QualStmt NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
LayoutContext -> ByteString -> [ast NodeInfo] -> Printer ()
list' LayoutContext
Expression ByteString
"," [QualStmt NodeInfo]
qualstmts
vertical :: Printer ()
vertical = LayoutContext
-> ByteString -> ByteString -> Printer () -> Printer ()
groupV LayoutContext
Expression ByteString
"[" ByteString
"]" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
prettyOnside Exp NodeInfo
expr
LayoutContext -> ByteString -> Printer ()
operatorV LayoutContext
Expression ByteString
"|"
LayoutContext -> ByteString -> [QualStmt NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
LayoutContext -> ByteString -> [ast NodeInfo] -> Printer ()
listV' LayoutContext
Expression ByteString
"," [QualStmt NodeInfo]
qualstmts
prettyPrint (ParComp NodeInfo
_ Exp NodeInfo
expr [[QualStmt NodeInfo]]
qualstmtss) =
(LayoutConfig -> Layout) -> Printer () -> Printer () -> Printer ()
forall a.
(LayoutConfig -> Layout) -> Printer a -> Printer a -> Printer a
withLayout LayoutConfig -> Layout
cfgLayoutListComp Printer ()
flex Printer ()
vertical
where
flex :: Printer ()
flex = LayoutContext
-> ByteString -> ByteString -> Printer () -> Printer ()
group LayoutContext
Expression ByteString
"[" ByteString
"]" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
prettyOnside Exp NodeInfo
expr
[[QualStmt NodeInfo]]
-> ([QualStmt NodeInfo] -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [[QualStmt NodeInfo]]
qualstmtss (([QualStmt NodeInfo] -> Printer ()) -> Printer ())
-> ([QualStmt NodeInfo] -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \[QualStmt NodeInfo]
qualstmts -> Printer () -> Printer ()
forall a. Printer a -> Printer a
cut (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
LayoutContext -> ByteString -> Printer ()
operator LayoutContext
Expression ByteString
"|"
LayoutContext -> ByteString -> [QualStmt NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
LayoutContext -> ByteString -> [ast NodeInfo] -> Printer ()
list' LayoutContext
Expression ByteString
"," [QualStmt NodeInfo]
qualstmts
vertical :: Printer ()
vertical = LayoutContext
-> ByteString -> ByteString -> Printer () -> Printer ()
groupV LayoutContext
Expression ByteString
"[" ByteString
"]" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
prettyOnside Exp NodeInfo
expr
[[QualStmt NodeInfo]]
-> ([QualStmt NodeInfo] -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [[QualStmt NodeInfo]]
qualstmtss (([QualStmt NodeInfo] -> Printer ()) -> Printer ())
-> ([QualStmt NodeInfo] -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \[QualStmt NodeInfo]
qualstmts -> Printer () -> Printer ()
forall a. Printer a -> Printer a
cut (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
LayoutContext -> ByteString -> Printer ()
operatorV LayoutContext
Expression ByteString
"|"
LayoutContext -> ByteString -> [QualStmt NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
LayoutContext -> ByteString -> [ast NodeInfo] -> Printer ()
listV' LayoutContext
Expression ByteString
"," [QualStmt NodeInfo]
qualstmts
prettyPrint (ParArrayComp NodeInfo
_ Exp NodeInfo
expr [[QualStmt NodeInfo]]
qualstmtss) =
(LayoutConfig -> Layout) -> Printer () -> Printer () -> Printer ()
forall a.
(LayoutConfig -> Layout) -> Printer a -> Printer a -> Printer a
withLayout LayoutConfig -> Layout
cfgLayoutListComp Printer ()
flex Printer ()
vertical
where
flex :: Printer ()
flex = LayoutContext
-> ByteString -> ByteString -> Printer () -> Printer ()
group LayoutContext
Expression ByteString
"[:" ByteString
":]" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
prettyOnside Exp NodeInfo
expr
[[QualStmt NodeInfo]]
-> ([QualStmt NodeInfo] -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [[QualStmt NodeInfo]]
qualstmtss (([QualStmt NodeInfo] -> Printer ()) -> Printer ())
-> ([QualStmt NodeInfo] -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \[QualStmt NodeInfo]
qualstmts -> Printer () -> Printer ()
forall a. Printer a -> Printer a
cut (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
LayoutContext -> ByteString -> Printer ()
operator LayoutContext
Expression ByteString
"|"
LayoutContext -> ByteString -> [QualStmt NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
LayoutContext -> ByteString -> [ast NodeInfo] -> Printer ()
list' LayoutContext
Expression ByteString
"," [QualStmt NodeInfo]
qualstmts
vertical :: Printer ()
vertical = LayoutContext
-> ByteString -> ByteString -> Printer () -> Printer ()
groupV LayoutContext
Expression ByteString
"[:" ByteString
":]" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
prettyOnside Exp NodeInfo
expr
[[QualStmt NodeInfo]]
-> ([QualStmt NodeInfo] -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [[QualStmt NodeInfo]]
qualstmtss (([QualStmt NodeInfo] -> Printer ()) -> Printer ())
-> ([QualStmt NodeInfo] -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \[QualStmt NodeInfo]
qualstmts -> Printer () -> Printer ()
forall a. Printer a -> Printer a
cut (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
LayoutContext -> ByteString -> Printer ()
operatorV LayoutContext
Expression ByteString
"|"
LayoutContext -> ByteString -> [QualStmt NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
LayoutContext -> ByteString -> [ast NodeInfo] -> Printer ()
listV' LayoutContext
Expression ByteString
"," [QualStmt NodeInfo]
qualstmts
prettyPrint (ExpTypeSig NodeInfo
_ Exp NodeInfo
expr Type NodeInfo
typ) = LayoutContext -> [Exp NodeInfo] -> Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
LayoutContext -> [ast NodeInfo] -> Type NodeInfo -> Printer ()
prettyTypesig LayoutContext
Expression [ Exp NodeInfo
expr ] Type NodeInfo
typ
prettyPrint (VarQuote NodeInfo
_ QName NodeInfo
qname) = do
ByteString -> Printer ()
write ByteString
"'"
QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
qname
prettyPrint (TypQuote NodeInfo
_ QName NodeInfo
qname) = do
ByteString -> Printer ()
write ByteString
"''"
QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
qname
prettyPrint (BracketExp NodeInfo
_ Bracket NodeInfo
bracket) = Bracket NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Bracket NodeInfo
bracket
prettyPrint (SpliceExp NodeInfo
_ Splice NodeInfo
splice) = Splice NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Splice NodeInfo
splice
prettyPrint (QuasiQuote NodeInfo
_ String
str String
str') = do
ByteString -> Printer ()
write ByteString
"["
String -> Printer ()
string String
str
ByteString -> Printer ()
write ByteString
"|"
String -> Printer ()
string String
str'
ByteString -> Printer ()
write ByteString
"|]"
prettyPrint (TypeApp NodeInfo
_ Type NodeInfo
typ) = do
ByteString -> Printer ()
write ByteString
"@"
Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
typ
prettyPrint (XTag NodeInfo
_ XName NodeInfo
xname [XAttr NodeInfo]
xattrs Maybe (Exp NodeInfo)
mexpr [Exp NodeInfo]
exprs) = do
ByteString -> Printer ()
write ByteString
"<"
XName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty XName NodeInfo
xname
[XAttr NodeInfo] -> (XAttr NodeInfo -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [XAttr NodeInfo]
xattrs ((XAttr NodeInfo -> Printer ()) -> Printer ())
-> (XAttr NodeInfo -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ Printer ()
-> (XAttr NodeInfo -> Printer ()) -> XAttr NodeInfo -> Printer ()
forall (f :: * -> *) a x b.
Applicative f =>
f a -> (x -> f b) -> x -> f b
withPrefix Printer ()
space XAttr NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty
Maybe (Exp NodeInfo) -> (Exp NodeInfo -> Printer ()) -> Printer ()
forall a. Maybe a -> (a -> Printer ()) -> Printer ()
mayM_ Maybe (Exp NodeInfo)
mexpr ((Exp NodeInfo -> Printer ()) -> Printer ())
-> (Exp NodeInfo -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ Printer ()
-> (Exp NodeInfo -> Printer ()) -> Exp NodeInfo -> Printer ()
forall (f :: * -> *) a x b.
Applicative f =>
f a -> (x -> f b) -> x -> f b
withPrefix Printer ()
space Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty
ByteString -> Printer ()
write ByteString
">"
(Exp NodeInfo -> Printer ()) -> [Exp NodeInfo] -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty [Exp NodeInfo]
exprs
ByteString -> Printer ()
write ByteString
"</"
XName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty XName NodeInfo
xname
ByteString -> Printer ()
write ByteString
">"
prettyPrint (XETag NodeInfo
_ XName NodeInfo
xname [XAttr NodeInfo]
xattrs Maybe (Exp NodeInfo)
mexpr) = do
ByteString -> Printer ()
write ByteString
"<"
XName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty XName NodeInfo
xname
[XAttr NodeInfo] -> (XAttr NodeInfo -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [XAttr NodeInfo]
xattrs ((XAttr NodeInfo -> Printer ()) -> Printer ())
-> (XAttr NodeInfo -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ Printer ()
-> (XAttr NodeInfo -> Printer ()) -> XAttr NodeInfo -> Printer ()
forall (f :: * -> *) a x b.
Applicative f =>
f a -> (x -> f b) -> x -> f b
withPrefix Printer ()
space XAttr NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty
Maybe (Exp NodeInfo) -> (Exp NodeInfo -> Printer ()) -> Printer ()
forall a. Maybe a -> (a -> Printer ()) -> Printer ()
mayM_ Maybe (Exp NodeInfo)
mexpr ((Exp NodeInfo -> Printer ()) -> Printer ())
-> (Exp NodeInfo -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ Printer ()
-> (Exp NodeInfo -> Printer ()) -> Exp NodeInfo -> Printer ()
forall (f :: * -> *) a x b.
Applicative f =>
f a -> (x -> f b) -> x -> f b
withPrefix Printer ()
space Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty
ByteString -> Printer ()
write ByteString
"/>"
prettyPrint (XPcdata NodeInfo
_ String
str) = String -> Printer ()
string String
str
prettyPrint (XExpTag NodeInfo
_ Exp NodeInfo
expr) = do
ByteString -> Printer ()
write ByteString
"<% "
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr
ByteString -> Printer ()
write ByteString
" %>"
prettyPrint (XChildTag NodeInfo
_ [Exp NodeInfo]
exprs) = do
ByteString -> Printer ()
write ByteString
"<%>"
Printer () -> [Printer ()] -> Printer ()
inter Printer ()
space ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (Exp NodeInfo -> Printer ()) -> [Exp NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty [Exp NodeInfo]
exprs
ByteString -> Printer ()
write ByteString
"</%>"
prettyPrint (CorePragma NodeInfo
_ String
str Exp NodeInfo
expr) = do
ByteString -> Printer () -> Printer ()
prettyPragma ByteString
"CORE" (Printer () -> Printer ())
-> (String -> Printer ()) -> String -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Printer ()
string (String -> Printer ()) -> String -> Printer ()
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. Show a => a -> String
show String
str
Printer ()
space
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr
prettyPrint (SCCPragma NodeInfo
_ String
str Exp NodeInfo
expr) = do
ByteString -> Printer () -> Printer ()
prettyPragma ByteString
"SCC" (Printer () -> Printer ())
-> (String -> Printer ()) -> String -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Printer ()
string (String -> Printer ()) -> String -> Printer ()
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. Show a => a -> String
show String
str
Printer ()
space
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr
prettyPrint (GenPragma NodeInfo
_ String
str (Int
a, Int
b) (Int
c, Int
d) Exp NodeInfo
expr) = do
ByteString -> Printer () -> Printer ()
prettyPragma ByteString
"GENERATED" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$
Printer () -> [Printer ()] -> Printer ()
inter Printer ()
space
[ String -> Printer ()
string (String -> Printer ()) -> String -> Printer ()
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. Show a => a -> String
show String
str
, Int -> Printer ()
int Int
a
, ByteString -> Printer ()
write ByteString
":"
, Int -> Printer ()
int Int
b
, ByteString -> Printer ()
write ByteString
"-"
, Int -> Printer ()
int Int
c
, ByteString -> Printer ()
write ByteString
":"
, Int -> Printer ()
int Int
d
]
Printer ()
space
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr
prettyPrint (Proc NodeInfo
_ Pat NodeInfo
pat Exp NodeInfo
expr) = do
ByteString -> Printer ()
write ByteString
"proc "
Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
pat
LayoutContext -> ByteString -> Printer ()
operator LayoutContext
Expression ByteString
"->"
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr
prettyPrint (LeftArrApp NodeInfo
_ Exp NodeInfo
expr Exp NodeInfo
expr') = do
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr
LayoutContext -> ByteString -> Printer ()
operator LayoutContext
Expression ByteString
"-<"
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr'
prettyPrint (RightArrApp NodeInfo
_ Exp NodeInfo
expr Exp NodeInfo
expr') = do
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr
LayoutContext -> ByteString -> Printer ()
operator LayoutContext
Expression ByteString
">-"
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr'
prettyPrint (LeftArrHighApp NodeInfo
_ Exp NodeInfo
expr Exp NodeInfo
expr') = do
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr
LayoutContext -> ByteString -> Printer ()
operator LayoutContext
Expression ByteString
"-<<"
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr'
prettyPrint (RightArrHighApp NodeInfo
_ Exp NodeInfo
expr Exp NodeInfo
expr') = do
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr
LayoutContext -> ByteString -> Printer ()
operator LayoutContext
Expression ByteString
">>-"
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr'
prettyPrint (LCase NodeInfo
_ [Alt NodeInfo]
alts) = Printer () -> Printer ()
forall a. Printer a -> Printer a
flexibleOneline (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
ByteString -> Printer ()
write ByteString
"\\case"
if [Alt NodeInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Alt NodeInfo]
alts
then ByteString -> Printer ()
write ByteString
" { }"
else (IndentConfig -> Indent) -> Printer () -> Printer ()
forall a. (IndentConfig -> Indent) -> Printer a -> Printer a
withIndent IndentConfig -> Indent
cfgIndentCase (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$
TabStop
-> (AlignConfig -> Bool)
-> (Alt NodeInfo -> Printer (Maybe [Int]))
-> [Alt NodeInfo]
-> Printer ()
-> Printer ()
forall a b.
TabStop
-> (AlignConfig -> Bool)
-> (a -> Printer (Maybe [Int]))
-> [a]
-> Printer b
-> Printer b
withComputedTabStop TabStop
stopRhs AlignConfig -> Bool
cfgAlignCase Alt NodeInfo -> Printer (Maybe [Int])
measureAlt [Alt NodeInfo]
alts (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$
[Alt NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
[ast NodeInfo] -> Printer ()
lined [Alt NodeInfo]
alts
#if !MIN_VERSION_haskell_src_exts(1,20,0)
prettyPrint (ExprHole _) = write "_"
#endif
instance Pretty Alt where
prettyPrint :: Alt NodeInfo -> Printer ()
prettyPrint (Alt NodeInfo
_ Pat NodeInfo
pat Rhs NodeInfo
rhs Maybe (Binds NodeInfo)
mbinds) = do
Printer () -> Printer ()
forall a. Printer a -> Printer a
onside (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
pat
TabStop -> Printer ()
atTabStop TabStop
stopRhs
GuardedAlts NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty (GuardedAlts NodeInfo -> Printer ())
-> GuardedAlts NodeInfo -> Printer ()
forall a b. (a -> b) -> a -> b
$ Rhs NodeInfo -> GuardedAlts NodeInfo
forall l. Rhs l -> GuardedAlts l
GuardedAlts Rhs NodeInfo
rhs
(Binds NodeInfo -> Printer ())
-> Maybe (Binds NodeInfo) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Binds NodeInfo -> Printer ()
prettyBinds Maybe (Binds NodeInfo)
mbinds
instance Pretty XAttr where
prettyPrint :: XAttr NodeInfo -> Printer ()
prettyPrint (XAttr NodeInfo
_ XName NodeInfo
xname Exp NodeInfo
expr) = do
XName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty XName NodeInfo
xname
LayoutContext -> ByteString -> Printer ()
operator LayoutContext
Expression ByteString
"="
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr
instance Pretty Pat where
prettyPrint :: Pat NodeInfo -> Printer ()
prettyPrint (PVar NodeInfo
_ Name NodeInfo
name) = Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Name NodeInfo
name
prettyPrint (PLit NodeInfo
_ Sign NodeInfo
sign Literal NodeInfo
literal) = do
case Sign NodeInfo
sign of
Signless NodeInfo
_ -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Negative NodeInfo
_ -> ByteString -> Printer ()
write ByteString
"-"
Literal NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Literal NodeInfo
literal
prettyPrint (PNPlusK NodeInfo
_ Name NodeInfo
name Integer
integer) = do
Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Name NodeInfo
name
LayoutContext -> ByteString -> Printer ()
operator LayoutContext
Pattern ByteString
"+"
Int -> Printer ()
int (Int -> Printer ()) -> Int -> Printer ()
forall a b. (a -> b) -> a -> b
$ Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
integer
prettyPrint p :: Pat NodeInfo
p@(PInfixApp NodeInfo
_ Pat NodeInfo
_ QName NodeInfo
qname Pat NodeInfo
_) =
(QOp NodeInfo -> ByteString)
-> LayoutContext
-> (Pat NodeInfo, [(QOp NodeInfo, Pat NodeInfo)])
-> Printer ()
forall (ast :: * -> *) (op :: * -> *).
(Annotated ast, Pretty ast, Annotated op, Pretty (op NodeInfo)) =>
(op NodeInfo -> ByteString)
-> LayoutContext
-> (ast NodeInfo, [(op NodeInfo, ast NodeInfo)])
-> Printer ()
prettyInfixApp QOp NodeInfo -> ByteString
forall a. QOp a -> ByteString
opName LayoutContext
Pattern ((Pat NodeInfo, [(QOp NodeInfo, Pat NodeInfo)]) -> Printer ())
-> (Pat NodeInfo, [(QOp NodeInfo, Pat NodeInfo)]) -> Printer ()
forall a b. (a -> b) -> a -> b
$ (Pat NodeInfo -> Maybe (Pat NodeInfo, QOp NodeInfo, Pat NodeInfo))
-> Pat NodeInfo -> (Pat NodeInfo, [(QOp NodeInfo, Pat NodeInfo)])
forall (ast1 :: * -> *) (ast2 :: * -> *).
(Annotated ast1, Annotated ast2) =>
(ast1 NodeInfo
-> Maybe (ast1 NodeInfo, ast2 NodeInfo, ast1 NodeInfo))
-> ast1 NodeInfo
-> (ast1 NodeInfo, [(ast2 NodeInfo, ast1 NodeInfo)])
flattenInfix Pat NodeInfo -> Maybe (Pat NodeInfo, QOp NodeInfo, Pat NodeInfo)
flattenPInfixApp Pat NodeInfo
p
where
flattenPInfixApp :: Pat NodeInfo -> Maybe (Pat NodeInfo, QOp NodeInfo, Pat NodeInfo)
flattenPInfixApp (PInfixApp NodeInfo
_ Pat NodeInfo
lhs QName NodeInfo
qname' Pat NodeInfo
rhs) =
if QName NodeInfo -> QName NodeInfo -> Ordering
forall (ast :: * -> *).
(Functor ast, Ord (ast ())) =>
ast NodeInfo -> ast NodeInfo -> Ordering
compareAST QName NodeInfo
qname QName NodeInfo
qname' Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ
then (Pat NodeInfo, QOp NodeInfo, Pat NodeInfo)
-> Maybe (Pat NodeInfo, QOp NodeInfo, Pat NodeInfo)
forall a. a -> Maybe a
Just (Pat NodeInfo
lhs, NodeInfo -> QName NodeInfo -> QOp NodeInfo
forall l. l -> QName l -> QOp l
QConOp NodeInfo
noNodeInfo QName NodeInfo
qname', Pat NodeInfo
rhs)
else Maybe (Pat NodeInfo, QOp NodeInfo, Pat NodeInfo)
forall a. Maybe a
Nothing
flattenPInfixApp Pat NodeInfo
_ = Maybe (Pat NodeInfo, QOp NodeInfo, Pat NodeInfo)
forall a. Maybe a
Nothing
prettyPrint (PApp NodeInfo
_ QName NodeInfo
qname [Pat NodeInfo]
pats) = QName NodeInfo -> [Pat NodeInfo] -> Printer ()
forall (ast1 :: * -> *) (ast2 :: * -> *).
(Annotated ast1, Annotated ast2, Pretty ast1, Pretty ast2) =>
ast1 NodeInfo -> [ast2 NodeInfo] -> Printer ()
prettyApp QName NodeInfo
qname [Pat NodeInfo]
pats
prettyPrint (PTuple NodeInfo
_ Boxed
boxed [Pat NodeInfo]
pats) = case Boxed
boxed of
Boxed
Boxed -> LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [Pat NodeInfo]
-> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [ast NodeInfo]
-> Printer ()
list LayoutContext
Pattern ByteString
"(" ByteString
")" ByteString
"," [Pat NodeInfo]
pats
Boxed
Unboxed -> LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [Pat NodeInfo]
-> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [ast NodeInfo]
-> Printer ()
list LayoutContext
Pattern ByteString
"(#" ByteString
"#)" ByteString
"," [Pat NodeInfo]
pats
#if MIN_VERSION_haskell_src_exts(1,20,0)
prettyPrint (PUnboxedSum NodeInfo
_ Int
before Int
after Pat NodeInfo
pat) = LayoutContext
-> ByteString -> ByteString -> Printer () -> Printer ()
group LayoutContext
Pattern ByteString
"(#" ByteString
"#)"
(Printer () -> Printer ())
-> ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Printer () -> [Printer ()] -> Printer ()
inter Printer ()
space ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ Int -> Printer () -> [Printer ()]
forall a. Int -> a -> [a]
replicate Int
before (ByteString -> Printer ()
write ByteString
"|") [Printer ()] -> [Printer ()] -> [Printer ()]
forall a. [a] -> [a] -> [a]
++ [ Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
pat ]
[Printer ()] -> [Printer ()] -> [Printer ()]
forall a. [a] -> [a] -> [a]
++ Int -> Printer () -> [Printer ()]
forall a. Int -> a -> [a]
replicate Int
after (ByteString -> Printer ()
write ByteString
"|")
#endif
prettyPrint (PList NodeInfo
_ [Pat NodeInfo]
pats) = LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [Pat NodeInfo]
-> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [ast NodeInfo]
-> Printer ()
list LayoutContext
Pattern ByteString
"[" ByteString
"]" ByteString
"," [Pat NodeInfo]
pats
prettyPrint (PParen NodeInfo
_ Pat NodeInfo
pat) = Printer () -> Printer ()
parens (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
pat
prettyPrint (PRec NodeInfo
_ QName NodeInfo
qname [PatField NodeInfo]
patfields) = do
LayoutContext
-> ByteString
-> Printer ()
-> (Printer () -> Printer ())
-> Printer ()
forall a.
LayoutContext
-> ByteString
-> Printer ()
-> (Printer () -> Printer a)
-> Printer a
withOperatorFormatting LayoutContext
Pattern ByteString
"record" (QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
qname) Printer () -> Printer ()
forall a. a -> a
id
LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [PatField NodeInfo]
-> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [ast NodeInfo]
-> Printer ()
list LayoutContext
Pattern ByteString
"{" ByteString
"}" ByteString
"," [PatField NodeInfo]
patfields
prettyPrint (PAsPat NodeInfo
_ Name NodeInfo
name Pat NodeInfo
pat) = do
Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Name NodeInfo
name
LayoutContext -> ByteString -> Printer ()
operator LayoutContext
Pattern ByteString
"@"
Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
pat
prettyPrint (PWildCard NodeInfo
_) = ByteString -> Printer ()
write ByteString
"_"
prettyPrint (PIrrPat NodeInfo
_ Pat NodeInfo
pat) = do
ByteString -> Printer ()
write ByteString
"~"
Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
pat
prettyPrint (PatTypeSig NodeInfo
_ Pat NodeInfo
pat Type NodeInfo
ty) = LayoutContext -> [Pat NodeInfo] -> Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
LayoutContext -> [ast NodeInfo] -> Type NodeInfo -> Printer ()
prettyTypesig LayoutContext
Pattern [ Pat NodeInfo
pat ] Type NodeInfo
ty
prettyPrint (PViewPat NodeInfo
_ Exp NodeInfo
expr Pat NodeInfo
pat) = do
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr
LayoutContext -> ByteString -> Printer ()
operator LayoutContext
Pattern ByteString
"->"
Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
pat
prettyPrint (PRPat NodeInfo
_ [RPat NodeInfo]
rpats) = LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [RPat NodeInfo]
-> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
LayoutContext
-> ByteString
-> ByteString
-> ByteString
-> [ast NodeInfo]
-> Printer ()
list LayoutContext
Pattern ByteString
"[" ByteString
"]" ByteString
"," [RPat NodeInfo]
rpats
prettyPrint (PXTag NodeInfo
_ XName NodeInfo
xname [PXAttr NodeInfo]
pxattrs Maybe (Pat NodeInfo)
mpat [Pat NodeInfo]
pats) = do
ByteString -> Printer ()
write ByteString
"<"
XName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty XName NodeInfo
xname
[PXAttr NodeInfo] -> (PXAttr NodeInfo -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [PXAttr NodeInfo]
pxattrs ((PXAttr NodeInfo -> Printer ()) -> Printer ())
-> (PXAttr NodeInfo -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ Printer ()
-> (PXAttr NodeInfo -> Printer ()) -> PXAttr NodeInfo -> Printer ()
forall (f :: * -> *) a x b.
Applicative f =>
f a -> (x -> f b) -> x -> f b
withPrefix Printer ()
space PXAttr NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty
Maybe (Pat NodeInfo) -> (Pat NodeInfo -> Printer ()) -> Printer ()
forall a. Maybe a -> (a -> Printer ()) -> Printer ()
mayM_ Maybe (Pat NodeInfo)
mpat ((Pat NodeInfo -> Printer ()) -> Printer ())
-> (Pat NodeInfo -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ Printer ()
-> (Pat NodeInfo -> Printer ()) -> Pat NodeInfo -> Printer ()
forall (f :: * -> *) a x b.
Applicative f =>
f a -> (x -> f b) -> x -> f b
withPrefix Printer ()
space Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty
ByteString -> Printer ()
write ByteString
">"
(Pat NodeInfo -> Printer ()) -> [Pat NodeInfo] -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty [Pat NodeInfo]
pats
ByteString -> Printer ()
write ByteString
"<"
XName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty XName NodeInfo
xname
ByteString -> Printer ()
write ByteString
">"
prettyPrint (PXETag NodeInfo
_ XName NodeInfo
xname [PXAttr NodeInfo]
pxattrs Maybe (Pat NodeInfo)
mpat) = do
ByteString -> Printer ()
write ByteString
"<"
XName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty XName NodeInfo
xname
[PXAttr NodeInfo] -> (PXAttr NodeInfo -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [PXAttr NodeInfo]
pxattrs ((PXAttr NodeInfo -> Printer ()) -> Printer ())
-> (PXAttr NodeInfo -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ Printer ()
-> (PXAttr NodeInfo -> Printer ()) -> PXAttr NodeInfo -> Printer ()
forall (f :: * -> *) a x b.
Applicative f =>
f a -> (x -> f b) -> x -> f b
withPrefix Printer ()
space PXAttr NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty
Maybe (Pat NodeInfo) -> (Pat NodeInfo -> Printer ()) -> Printer ()
forall a. Maybe a -> (a -> Printer ()) -> Printer ()
mayM_ Maybe (Pat NodeInfo)
mpat ((Pat NodeInfo -> Printer ()) -> Printer ())
-> (Pat NodeInfo -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ Printer ()
-> (Pat NodeInfo -> Printer ()) -> Pat NodeInfo -> Printer ()
forall (f :: * -> *) a x b.
Applicative f =>
f a -> (x -> f b) -> x -> f b
withPrefix Printer ()
space Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty
ByteString -> Printer ()
write ByteString
"/>"
prettyPrint (PXPcdata NodeInfo
_ String
str) = String -> Printer ()
string String
str
prettyPrint (PXPatTag NodeInfo
_ Pat NodeInfo
pat) = do
ByteString -> Printer ()
write ByteString
"<%"
Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
pat
ByteString -> Printer ()
write ByteString
"%>"
prettyPrint (PXRPats NodeInfo
_ [RPat NodeInfo]
rpats) = do
ByteString -> Printer ()
write ByteString
"<["
Printer () -> [Printer ()] -> Printer ()
inter Printer ()
space ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (RPat NodeInfo -> Printer ()) -> [RPat NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map RPat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty [RPat NodeInfo]
rpats
ByteString -> Printer ()
write ByteString
"%>"
#if MIN_VERSION_haskell_src_exts(1,20,0)
prettyPrint (PSplice NodeInfo
_ Splice NodeInfo
splice) = Splice NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Splice NodeInfo
splice
#endif
prettyPrint (PQuasiQuote NodeInfo
_ String
str String
str') = do
ByteString -> Printer ()
write ByteString
"[$"
String -> Printer ()
string String
str
ByteString -> Printer ()
write ByteString
"|"
String -> Printer ()
string String
str'
ByteString -> Printer ()
write ByteString
"|]"
prettyPrint (PBangPat NodeInfo
_ Pat NodeInfo
pat) = do
ByteString -> Printer ()
write ByteString
"!"
Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
pat
instance Pretty PatField where
prettyPrint :: PatField NodeInfo -> Printer ()
prettyPrint (PFieldPat NodeInfo
_ QName NodeInfo
qname Pat NodeInfo
pat) = do
QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
qname
LayoutContext -> ByteString -> Printer ()
operator LayoutContext
Pattern ByteString
"="
Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
pat
prettyPrint (PFieldPun NodeInfo
_ QName NodeInfo
qname) = QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
qname
prettyPrint (PFieldWildcard NodeInfo
_) = ByteString -> Printer ()
write ByteString
".."
instance Pretty PXAttr where
prettyPrint :: PXAttr NodeInfo -> Printer ()
prettyPrint (PXAttr NodeInfo
_ XName NodeInfo
xname Pat NodeInfo
pat) = do
XName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty XName NodeInfo
xname
LayoutContext -> ByteString -> Printer ()
operator LayoutContext
Pattern ByteString
"="
Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
pat
instance Pretty Literal where
prettyPrint :: Literal NodeInfo -> Printer ()
prettyPrint (Char NodeInfo
_ Char
_ String
str) = do
ByteString -> Printer ()
write ByteString
"'"
String -> Printer ()
string String
str
ByteString -> Printer ()
write ByteString
"'"
prettyPrint (String NodeInfo
_ String
_ String
str) = do
ByteString -> Printer ()
write ByteString
"\""
String -> Printer ()
string String
str
ByteString -> Printer ()
write ByteString
"\""
prettyPrint (Int NodeInfo
_ Integer
_ String
str) = String -> Printer ()
string String
str
prettyPrint (Frac NodeInfo
_ Rational
_ String
str) = String -> Printer ()
string String
str
prettyPrint (PrimInt NodeInfo
_ Integer
_ String
str) = do
String -> Printer ()
string String
str
ByteString -> Printer ()
write ByteString
"#"
prettyPrint (PrimWord NodeInfo
_ Integer
_ String
str) = do
String -> Printer ()
string String
str
ByteString -> Printer ()
write ByteString
"##"
prettyPrint (PrimFloat NodeInfo
_ Rational
_ String
str) = do
String -> Printer ()
string String
str
ByteString -> Printer ()
write ByteString
"#"
prettyPrint (PrimDouble NodeInfo
_ Rational
_ String
str) = do
String -> Printer ()
string String
str
ByteString -> Printer ()
write ByteString
"##"
prettyPrint (PrimChar NodeInfo
_ Char
_ String
str) = do
ByteString -> Printer ()
write ByteString
"'"
String -> Printer ()
string String
str
ByteString -> Printer ()
write ByteString
"'#"
prettyPrint (PrimString NodeInfo
_ String
_ String
str) = do
ByteString -> Printer ()
write ByteString
"\""
String -> Printer ()
string String
str
ByteString -> Printer ()
write ByteString
"\"#"
instance Pretty QualStmt where
prettyPrint :: QualStmt NodeInfo -> Printer ()
prettyPrint (QualStmt NodeInfo
_ Stmt NodeInfo
stmt) = Stmt NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Stmt NodeInfo
stmt
prettyPrint (ThenTrans NodeInfo
_ Exp NodeInfo
expr) = do
ByteString -> Printer ()
write ByteString
"then "
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr
prettyPrint (ThenBy NodeInfo
_ Exp NodeInfo
expr Exp NodeInfo
expr') = do
ByteString -> Printer ()
write ByteString
"then "
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr
ByteString -> Printer ()
write ByteString
" by "
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr'
prettyPrint (GroupBy NodeInfo
_ Exp NodeInfo
expr) = do
ByteString -> Printer ()
write ByteString
"then group by "
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr
prettyPrint (GroupUsing NodeInfo
_ Exp NodeInfo
expr) = do
ByteString -> Printer ()
write ByteString
"then group using "
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr
prettyPrint (GroupByUsing NodeInfo
_ Exp NodeInfo
expr Exp NodeInfo
expr') = do
ByteString -> Printer ()
write ByteString
"then group by "
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr
ByteString -> Printer ()
write ByteString
" using "
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr'
instance Pretty Stmt where
prettyPrint :: Stmt NodeInfo -> Printer ()
prettyPrint (Generator NodeInfo
_ Pat NodeInfo
pat Exp NodeInfo
expr) = do
Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
pat
LayoutContext -> ByteString -> Printer ()
operator LayoutContext
Expression ByteString
"<-"
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr
prettyPrint (Qualifier NodeInfo
_ Exp NodeInfo
expr) = Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr
prettyPrint (LetStmt NodeInfo
_ Binds NodeInfo
binds) = do
ByteString -> Printer ()
write ByteString
"let "
CompactBinds NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty (CompactBinds NodeInfo -> Printer ())
-> CompactBinds NodeInfo -> Printer ()
forall a b. (a -> b) -> a -> b
$ Binds NodeInfo -> CompactBinds NodeInfo
forall l. Binds l -> CompactBinds l
CompactBinds Binds NodeInfo
binds
prettyPrint (RecStmt NodeInfo
_ [Stmt NodeInfo]
stmts) = do
ByteString -> Printer ()
write ByteString
"rec "
Printer () -> Printer ()
forall a. Printer a -> Printer a
aligned (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ [Stmt NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
[ast NodeInfo] -> Printer ()
linedOnside [Stmt NodeInfo]
stmts
instance Pretty FieldUpdate where
prettyPrint :: FieldUpdate NodeInfo -> Printer ()
prettyPrint (FieldUpdate NodeInfo
_ QName NodeInfo
qname Exp NodeInfo
expr) = do
QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
qname
Printer () -> Printer ()
forall a. Printer a -> Printer a
onside (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
TabStop -> Printer ()
atTabStop TabStop
stopRecordField
LayoutContext -> ByteString -> Printer ()
operator LayoutContext
Expression ByteString
"="
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr
prettyPrint (FieldPun NodeInfo
_ QName NodeInfo
qname) = QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
qname
prettyPrint (FieldWildcard NodeInfo
_) = ByteString -> Printer ()
write ByteString
".."
instance Pretty QOp where
prettyPrint :: QOp NodeInfo -> Printer ()
prettyPrint QOp NodeInfo
qop =
LayoutContext
-> ByteString
-> Printer ()
-> (Printer () -> Printer ())
-> Printer ()
forall a.
LayoutContext
-> ByteString
-> Printer ()
-> (Printer () -> Printer a)
-> Printer a
withOperatorFormatting LayoutContext
Expression (QOp NodeInfo -> ByteString
forall a. QOp a -> ByteString
opName QOp NodeInfo
qop) (QOp NodeInfo -> Printer ()
forall (ast :: * -> *).
Pretty (ast NodeInfo) =>
ast NodeInfo -> Printer ()
prettyHSE QOp NodeInfo
qop) Printer () -> Printer ()
forall a. a -> a
id
instance Pretty Op where
prettyPrint :: Op NodeInfo -> Printer ()
prettyPrint (VarOp NodeInfo
l Name NodeInfo
name) = QOp NodeInfo -> Printer ()
forall (ast :: * -> *). Pretty ast => ast NodeInfo -> Printer ()
prettyPrint (NodeInfo -> QName NodeInfo -> QOp NodeInfo
forall l. l -> QName l -> QOp l
QVarOp NodeInfo
l (NodeInfo -> Name NodeInfo -> QName NodeInfo
forall l. l -> Name l -> QName l
UnQual NodeInfo
noNodeInfo Name NodeInfo
name))
prettyPrint (ConOp NodeInfo
l Name NodeInfo
name) = QOp NodeInfo -> Printer ()
forall (ast :: * -> *). Pretty ast => ast NodeInfo -> Printer ()
prettyPrint (NodeInfo -> QName NodeInfo -> QOp NodeInfo
forall l. l -> QName l -> QOp l
QConOp NodeInfo
l (NodeInfo -> Name NodeInfo -> QName NodeInfo
forall l. l -> Name l -> QName l
UnQual NodeInfo
noNodeInfo Name NodeInfo
name))
instance Pretty Bracket where
prettyPrint :: Bracket NodeInfo -> Printer ()
prettyPrint (ExpBracket NodeInfo
_ Exp NodeInfo
expr) = LayoutContext
-> ByteString -> ByteString -> Printer () -> Printer ()
group LayoutContext
Expression ByteString
"[|" ByteString
"|]" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr
#if MIN_VERSION_haskell_src_exts(1,22,0)
prettyPrint (TExpBracket NodeInfo
_ Exp NodeInfo
expr) =
LayoutContext
-> ByteString -> ByteString -> Printer () -> Printer ()
group LayoutContext
Expression ByteString
"[||" ByteString
"||]" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr
#endif
prettyPrint (PatBracket NodeInfo
_ Pat NodeInfo
pat) = LayoutContext
-> ByteString -> ByteString -> Printer () -> Printer ()
group LayoutContext
Expression ByteString
"[p|" ByteString
"|]" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
pat
prettyPrint (TypeBracket NodeInfo
_ Type NodeInfo
ty) = LayoutContext
-> ByteString -> ByteString -> Printer () -> Printer ()
group LayoutContext
Expression ByteString
"[t|" ByteString
"|]" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty
prettyPrint (DeclBracket NodeInfo
_ [Decl NodeInfo]
decls) =
LayoutContext
-> ByteString -> ByteString -> Printer () -> Printer ()
group LayoutContext
Expression ByteString
"[d|" ByteString
"|]" (Printer () -> Printer ())
-> (Printer () -> Printer ()) -> Printer () -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Printer () -> Printer ()
forall a. Printer a -> Printer a
aligned (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ [Decl NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
[ast NodeInfo] -> Printer ()
lined [Decl NodeInfo]
decls
instance Pretty Splice where
prettyPrint :: Splice NodeInfo -> Printer ()
prettyPrint (IdSplice NodeInfo
_ String
str) = do
ByteString -> Printer ()
write ByteString
"$"
String -> Printer ()
string String
str
prettyPrint (ParenSplice NodeInfo
_ Exp NodeInfo
expr) = LayoutContext
-> ByteString -> ByteString -> Printer () -> Printer ()
group LayoutContext
Expression ByteString
"$(" ByteString
")" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr
#if MIN_VERSION_haskell_src_exts(1,22,0)
prettyPrint (TIdSplice NodeInfo
_ String
str) = do
ByteString -> Printer ()
write ByteString
"$$"
String -> Printer ()
string String
str
prettyPrint (TParenSplice NodeInfo
_ Exp NodeInfo
expr) = LayoutContext
-> ByteString -> ByteString -> Printer () -> Printer ()
group LayoutContext
Expression ByteString
"$$(" ByteString
")" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr
#endif
instance Pretty ModulePragma where
prettyPrint :: ModulePragma NodeInfo -> Printer ()
prettyPrint (LanguagePragma NodeInfo
_ [Name NodeInfo]
names) =
ByteString -> Printer () -> Printer ()
prettyPragma ByteString
"LANGUAGE" (Printer () -> Printer ())
-> ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Printer () -> [Printer ()] -> Printer ()
inter Printer ()
comma ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (Name NodeInfo -> Printer ()) -> [Name NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty [Name NodeInfo]
names
prettyPrint (OptionsPragma NodeInfo
_ Maybe Tool
mtool String
str) = ByteString -> Printer () -> Printer ()
prettyPragma ByteString
name (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$
String -> Printer ()
string (String -> String
trim String
str)
where
name :: ByteString
name = case Maybe Tool
mtool of
Just Tool
tool -> ByteString
"OPTIONS_" ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
`mappend` String -> ByteString
BS8.pack (Tool -> String
forall a. Pretty a => a -> String
HSE.prettyPrint Tool
tool)
Maybe Tool
Nothing -> ByteString
"OPTIONS"
trim :: String -> String
trim = String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ')
prettyPrint (AnnModulePragma NodeInfo
_ Annotation NodeInfo
annotation) =
ByteString -> Printer () -> Printer ()
prettyPragma ByteString
"ANN" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Annotation NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Annotation NodeInfo
annotation
instance Pretty Rule where
prettyPrint :: Rule NodeInfo -> Printer ()
prettyPrint (Rule NodeInfo
_ String
str Maybe (Activation NodeInfo)
mactivation Maybe [RuleVar NodeInfo]
mrulevars Exp NodeInfo
expr Exp NodeInfo
expr') = do
String -> Printer ()
string (String -> String
forall a. Show a => a -> String
show String
str)
Printer ()
space
Maybe (Activation NodeInfo)
-> (Activation NodeInfo -> Printer ()) -> Printer ()
forall a. Maybe a -> (a -> Printer ()) -> Printer ()
mayM_ Maybe (Activation NodeInfo)
mactivation ((Activation NodeInfo -> Printer ()) -> Printer ())
-> (Activation NodeInfo -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ Printer ()
-> (Activation NodeInfo -> Printer ())
-> Activation NodeInfo
-> Printer ()
forall (f :: * -> *) a x b.
Applicative f =>
f a -> (x -> f b) -> x -> f b
withPostfix Printer ()
space Activation NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty
([RuleVar NodeInfo] -> Printer ())
-> Maybe [RuleVar NodeInfo] -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [RuleVar NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
[ast NodeInfo] -> Printer ()
prettyForall Maybe [RuleVar NodeInfo]
mrulevars
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr
LayoutContext -> ByteString -> Printer ()
operator LayoutContext
Expression ByteString
"="
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr'
instance Pretty RuleVar where
prettyPrint :: RuleVar NodeInfo -> Printer ()
prettyPrint (RuleVar NodeInfo
_ Name NodeInfo
name) = Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Name NodeInfo
name
prettyPrint (TypedRuleVar NodeInfo
_ Name NodeInfo
name Type NodeInfo
ty) =
Printer () -> Printer ()
parens (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ LayoutContext -> [Name NodeInfo] -> Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
LayoutContext -> [ast NodeInfo] -> Type NodeInfo -> Printer ()
prettyTypesig LayoutContext
Declaration [ Name NodeInfo
name ] Type NodeInfo
ty
instance Pretty Activation where
prettyPrint :: Activation NodeInfo -> Printer ()
prettyPrint (ActiveFrom NodeInfo
_ Int
pass) = Printer () -> Printer ()
brackets (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Int -> Printer ()
int Int
pass
prettyPrint (ActiveUntil NodeInfo
_ Int
pass) = Printer () -> Printer ()
brackets (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
ByteString -> Printer ()
write ByteString
"~"
Int -> Printer ()
int Int
pass
instance Pretty Annotation where
prettyPrint :: Annotation NodeInfo -> Printer ()
prettyPrint (Ann NodeInfo
_ Name NodeInfo
name Exp NodeInfo
expr) = do
Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Name NodeInfo
name
Printer ()
space
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr
prettyPrint (TypeAnn NodeInfo
_ Name NodeInfo
name Exp NodeInfo
expr) = do
ByteString -> Printer ()
write ByteString
"type "
Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Name NodeInfo
name
Printer ()
space
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr
prettyPrint (ModuleAnn NodeInfo
_ Exp NodeInfo
expr) = do
ByteString -> Printer ()
write ByteString
"module "
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr
instance Pretty BooleanFormula where
prettyPrint :: BooleanFormula NodeInfo -> Printer ()
prettyPrint (VarFormula NodeInfo
_ Name NodeInfo
name) = Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Name NodeInfo
name
prettyPrint (AndFormula NodeInfo
_ [BooleanFormula NodeInfo]
booleanformulas) =
Printer () -> [Printer ()] -> Printer ()
inter Printer ()
comma ([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 :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty [BooleanFormula NodeInfo]
booleanformulas
prettyPrint (OrFormula NodeInfo
_ [BooleanFormula NodeInfo]
booleanformulas) =
Printer () -> [Printer ()] -> Printer ()
inter (LayoutContext -> ByteString -> Printer ()
operator LayoutContext
Expression ByteString
"|") ([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 :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty [BooleanFormula NodeInfo]
booleanformulas
prettyPrint (ParenFormula NodeInfo
_ BooleanFormula NodeInfo
booleanformula) = Printer () -> Printer ()
parens (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ BooleanFormula NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty BooleanFormula NodeInfo
booleanformula
#if MIN_VERSION_haskell_src_exts(1,20,0)
instance Pretty DerivStrategy
#endif
instance Pretty DataOrNew
instance Pretty BangType
instance Pretty Unpackedness
instance Pretty RPat
instance Pretty ModuleName
instance Pretty QName
instance Pretty Name
instance Pretty IPName
instance Pretty XName
instance Pretty Safety
instance Pretty CallConv
instance Pretty Overlap
newtype GuardedAlt l = GuardedAlt (GuardedRhs l)
deriving ( a -> GuardedAlt b -> GuardedAlt a
(a -> b) -> GuardedAlt a -> GuardedAlt b
(forall a b. (a -> b) -> GuardedAlt a -> GuardedAlt b)
-> (forall a b. a -> GuardedAlt b -> GuardedAlt a)
-> Functor GuardedAlt
forall a b. a -> GuardedAlt b -> GuardedAlt a
forall a b. (a -> b) -> GuardedAlt a -> GuardedAlt b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> GuardedAlt b -> GuardedAlt a
$c<$ :: forall a b. a -> GuardedAlt b -> GuardedAlt a
fmap :: (a -> b) -> GuardedAlt a -> GuardedAlt b
$cfmap :: forall a b. (a -> b) -> GuardedAlt a -> GuardedAlt b
Functor, Functor GuardedAlt
Functor GuardedAlt
-> (forall l. GuardedAlt l -> l)
-> (forall l. (l -> l) -> GuardedAlt l -> GuardedAlt l)
-> Annotated GuardedAlt
GuardedAlt l -> l
(l -> l) -> GuardedAlt l -> GuardedAlt l
forall l. GuardedAlt l -> l
forall l. (l -> l) -> GuardedAlt l -> GuardedAlt l
forall (ast :: * -> *).
Functor ast
-> (forall l. ast l -> l)
-> (forall l. (l -> l) -> ast l -> ast l)
-> Annotated ast
amap :: (l -> l) -> GuardedAlt l -> GuardedAlt l
$camap :: forall l. (l -> l) -> GuardedAlt l -> GuardedAlt l
ann :: GuardedAlt l -> l
$cann :: forall l. GuardedAlt l -> l
$cp1Annotated :: Functor GuardedAlt
Annotated )
instance Pretty GuardedAlt where
prettyPrint :: GuardedAlt NodeInfo -> Printer ()
prettyPrint (GuardedAlt (GuardedRhs NodeInfo
_ [Stmt NodeInfo]
stmts Exp NodeInfo
expr)) = Printer () -> Printer ()
forall a. Printer a -> Printer a
cut (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
LayoutContext -> ByteString -> Printer () -> Printer ()
operatorSectionR LayoutContext
Pattern ByteString
"|" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Printer ()
write ByteString
"|"
Printer () -> [Printer ()] -> Printer ()
inter Printer ()
comma ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (Stmt NodeInfo -> Printer ()) -> [Stmt NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Stmt NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty [Stmt NodeInfo]
stmts
LayoutContext -> ByteString -> Printer ()
operator LayoutContext
Expression ByteString
"->"
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr
newtype GuardedAlts l = GuardedAlts (Rhs l)
deriving ( a -> GuardedAlts b -> GuardedAlts a
(a -> b) -> GuardedAlts a -> GuardedAlts b
(forall a b. (a -> b) -> GuardedAlts a -> GuardedAlts b)
-> (forall a b. a -> GuardedAlts b -> GuardedAlts a)
-> Functor GuardedAlts
forall a b. a -> GuardedAlts b -> GuardedAlts a
forall a b. (a -> b) -> GuardedAlts a -> GuardedAlts b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> GuardedAlts b -> GuardedAlts a
$c<$ :: forall a b. a -> GuardedAlts b -> GuardedAlts a
fmap :: (a -> b) -> GuardedAlts a -> GuardedAlts b
$cfmap :: forall a b. (a -> b) -> GuardedAlts a -> GuardedAlts b
Functor, Functor GuardedAlts
Functor GuardedAlts
-> (forall l. GuardedAlts l -> l)
-> (forall l. (l -> l) -> GuardedAlts l -> GuardedAlts l)
-> Annotated GuardedAlts
GuardedAlts l -> l
(l -> l) -> GuardedAlts l -> GuardedAlts l
forall l. GuardedAlts l -> l
forall l. (l -> l) -> GuardedAlts l -> GuardedAlts l
forall (ast :: * -> *).
Functor ast
-> (forall l. ast l -> l)
-> (forall l. (l -> l) -> ast l -> ast l)
-> Annotated ast
amap :: (l -> l) -> GuardedAlts l -> GuardedAlts l
$camap :: forall l. (l -> l) -> GuardedAlts l -> GuardedAlts l
ann :: GuardedAlts l -> l
$cann :: forall l. GuardedAlts l -> l
$cp1Annotated :: Functor GuardedAlts
Annotated )
instance Pretty GuardedAlts where
prettyPrint :: GuardedAlts NodeInfo -> Printer ()
prettyPrint (GuardedAlts (UnGuardedRhs NodeInfo
_ Exp NodeInfo
expr)) = Printer () -> Printer ()
forall a. Printer a -> Printer a
cut (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
LayoutContext -> ByteString -> Printer ()
operator LayoutContext
Expression ByteString
"->"
Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr
prettyPrint (GuardedAlts (GuardedRhss NodeInfo
_ [GuardedRhs NodeInfo]
guardedrhss)) =
(IndentConfig -> Indent) -> Printer () -> Printer ()
forall a. (IndentConfig -> Indent) -> Printer a -> Printer a
withIndent IndentConfig -> Indent
cfgIndentMultiIf (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ [GuardedAlt NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
[ast NodeInfo] -> Printer ()
linedOnside ([GuardedAlt NodeInfo] -> Printer ())
-> [GuardedAlt NodeInfo] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GuardedRhs NodeInfo -> GuardedAlt NodeInfo)
-> [GuardedRhs NodeInfo] -> [GuardedAlt NodeInfo]
forall a b. (a -> b) -> [a] -> [b]
map GuardedRhs NodeInfo -> GuardedAlt NodeInfo
forall l. GuardedRhs l -> GuardedAlt l
GuardedAlt [GuardedRhs NodeInfo]
guardedrhss
newtype CompactBinds l = CompactBinds (Binds l)
deriving ( a -> CompactBinds b -> CompactBinds a
(a -> b) -> CompactBinds a -> CompactBinds b
(forall a b. (a -> b) -> CompactBinds a -> CompactBinds b)
-> (forall a b. a -> CompactBinds b -> CompactBinds a)
-> Functor CompactBinds
forall a b. a -> CompactBinds b -> CompactBinds a
forall a b. (a -> b) -> CompactBinds a -> CompactBinds b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> CompactBinds b -> CompactBinds a
$c<$ :: forall a b. a -> CompactBinds b -> CompactBinds a
fmap :: (a -> b) -> CompactBinds a -> CompactBinds b
$cfmap :: forall a b. (a -> b) -> CompactBinds a -> CompactBinds b
Functor, Functor CompactBinds
Functor CompactBinds
-> (forall l. CompactBinds l -> l)
-> (forall l. (l -> l) -> CompactBinds l -> CompactBinds l)
-> Annotated CompactBinds
CompactBinds l -> l
(l -> l) -> CompactBinds l -> CompactBinds l
forall l. CompactBinds l -> l
forall l. (l -> l) -> CompactBinds l -> CompactBinds l
forall (ast :: * -> *).
Functor ast
-> (forall l. ast l -> l)
-> (forall l. (l -> l) -> ast l -> ast l)
-> Annotated ast
amap :: (l -> l) -> CompactBinds l -> CompactBinds l
$camap :: forall l. (l -> l) -> CompactBinds l -> CompactBinds l
ann :: CompactBinds l -> l
$cann :: forall l. CompactBinds l -> l
$cp1Annotated :: Functor CompactBinds
Annotated )
instance Pretty CompactBinds where
prettyPrint :: CompactBinds NodeInfo -> Printer ()
prettyPrint (CompactBinds (BDecls NodeInfo
_ [Decl NodeInfo]
decls)) = Printer () -> Printer ()
forall a. Printer a -> Printer a
aligned (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$
TabStop
-> (AlignConfig -> Bool)
-> (Decl NodeInfo -> Printer (Maybe [Int]))
-> [Decl NodeInfo]
-> Printer ()
-> Printer ()
forall a b.
TabStop
-> (AlignConfig -> Bool)
-> (a -> Printer (Maybe [Int]))
-> [a]
-> Printer b
-> Printer b
withComputedTabStop TabStop
stopRhs AlignConfig -> Bool
cfgAlignLetBinds Decl NodeInfo -> Printer (Maybe [Int])
measureDecl [Decl NodeInfo]
decls (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$
[Decl NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
[ast NodeInfo] -> Printer ()
lined [Decl NodeInfo]
decls
prettyPrint (CompactBinds (IPBinds NodeInfo
_ [IPBind NodeInfo]
ipbinds)) =
Printer () -> Printer ()
forall a. Printer a -> Printer a
aligned (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ [IPBind NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
[ast NodeInfo] -> Printer ()
linedOnside [IPBind NodeInfo]
ipbinds
data MayAst a l = MayAst l (Maybe (a l))
instance Functor a => Functor (MayAst a) where
fmap :: (a -> b) -> MayAst a a -> MayAst a b
fmap a -> b
f (MayAst a
l Maybe (a a)
x) = b -> Maybe (a b) -> MayAst a b
forall (a :: * -> *) l. l -> Maybe (a l) -> MayAst a l
MayAst (a -> b
f a
l) ((a a -> a b) -> Maybe (a a) -> Maybe (a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> a a -> a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) Maybe (a a)
x)
instance Annotated a => Annotated (MayAst a) where
ann :: MayAst a l -> l
ann (MayAst l
l Maybe (a l)
x) = l -> (a l -> l) -> Maybe (a l) -> l
forall b a. b -> (a -> b) -> Maybe a -> b
maybe l
l a l -> l
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann Maybe (a l)
x
amap :: (l -> l) -> MayAst a l -> MayAst a l
amap l -> l
f (MayAst l
l Maybe (a l)
x) = l -> Maybe (a l) -> MayAst a l
forall (a :: * -> *) l. l -> Maybe (a l) -> MayAst a l
MayAst (l -> l
f l
l) ((a l -> a l) -> Maybe (a l) -> Maybe (a l)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((l -> l) -> a l -> a l
forall (ast :: * -> *) l.
Annotated ast =>
(l -> l) -> ast l -> ast l
amap l -> l
f) Maybe (a l)
x)
instance (Annotated a, Pretty a) => Pretty (MayAst a) where
prettyPrint :: MayAst a NodeInfo -> Printer ()
prettyPrint (MayAst NodeInfo
_ Maybe (a NodeInfo)
x) = (a NodeInfo -> Printer ()) -> Maybe (a NodeInfo) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ a NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Maybe (a NodeInfo)
x
{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}