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