{-# LANGUAGE CPP #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Language.Haskell.Exts.Pretty
-- Copyright   :  (c) Niklas Broberg 2004-2009,
--                (c) The GHC Team, Noel Winstanley 1997-2000
-- License     :  BSD-style (see the file LICENSE.txt)
--
-- Maintainer  :  Niklas Broberg, d00nibro@chalmers.se
-- Stability   :  stable
-- Portability :  portable
--
-- Pretty printer for Haskell with extensions.
--
-----------------------------------------------------------------------------

module Language.Haskell.Exts.Pretty (
                -- * Pretty printing
                Pretty,
                prettyPrintStyleMode, prettyPrintWithMode, prettyPrint,
                -- * Pretty-printing styles (from "Text.PrettyPrint.HughesPJ")
                P.Style(..), P.style, P.Mode(..),
                -- * Haskell formatting modes
                PPHsMode(..), Indent, PPLayout(..), defaultMode
                -- * Primitive Printers
                , prettyPrim, prettyPrimWithMode
                ) where

import Language.Haskell.Exts.Syntax
import qualified Language.Haskell.Exts.ParseSyntax as P

import Language.Haskell.Exts.SrcLoc hiding (loc)

import Prelude hiding ( exp
#if MIN_VERSION_base(4,11,0)
                      , (<>)
#endif
                      )
import qualified Text.PrettyPrint as P
import Data.List (intersperse)
import Data.Maybe (isJust , fromMaybe)
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative (Applicative(..), (<$>))
#endif
import qualified Control.Monad as M (ap)

infixl 5 $$$

-----------------------------------------------------------------------------

-- | Varieties of layout we can use.
data PPLayout = PPOffsideRule   -- ^ classical layout
              | PPSemiColon     -- ^ classical layout made explicit
              | PPInLine        -- ^ inline decls, with newlines between them
              | PPNoLayout      -- ^ everything on a single line
              deriving PPLayout -> PPLayout -> Bool
(PPLayout -> PPLayout -> Bool)
-> (PPLayout -> PPLayout -> Bool) -> Eq PPLayout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PPLayout -> PPLayout -> Bool
$c/= :: PPLayout -> PPLayout -> Bool
== :: PPLayout -> PPLayout -> Bool
$c== :: PPLayout -> PPLayout -> Bool
Eq

type Indent = Int

-- | Pretty-printing parameters.
--
-- /Note:/ the 'onsideIndent' must be positive and less than all other indents.
data PPHsMode = PPHsMode {
                                -- | indentation of a class or instance
                PPHsMode -> Indent
classIndent :: Indent,
                                -- | indentation of a @do@-expression
                PPHsMode -> Indent
doIndent :: Indent,
                                -- | indentation of the body of a
                                -- @case@ expression
                PPHsMode -> Indent
multiIfIndent :: Indent,
                                -- | indentation of the body of a
                                -- multi-@if@ expression
                PPHsMode -> Indent
caseIndent :: Indent,
                                -- | indentation of the declarations in a
                                -- @let@ expression
                PPHsMode -> Indent
letIndent :: Indent,
                                -- | indentation of the declarations in a
                                -- @where@ clause
                PPHsMode -> Indent
whereIndent :: Indent,
                                -- | indentation added for continuation
                                -- lines that would otherwise be offside
                PPHsMode -> Indent
onsideIndent :: Indent,
                                -- | blank lines between statements?
                PPHsMode -> Bool
spacing :: Bool,
                                -- | Pretty-printing style to use
                PPHsMode -> PPLayout
layout :: PPLayout,
                                -- | add GHC-style @LINE@ pragmas to output?
                PPHsMode -> Bool
linePragmas :: Bool
                }

-- | The default mode: pretty-print using the offside rule and sensible
-- defaults.
defaultMode :: PPHsMode
defaultMode :: PPHsMode
defaultMode = PPHsMode :: Indent
-> Indent
-> Indent
-> Indent
-> Indent
-> Indent
-> Indent
-> Bool
-> PPLayout
-> Bool
-> PPHsMode
PPHsMode{
                      classIndent :: Indent
classIndent = Indent
8,
                      doIndent :: Indent
doIndent = Indent
3,
                      multiIfIndent :: Indent
multiIfIndent = Indent
3,
                      caseIndent :: Indent
caseIndent = Indent
4,
                      letIndent :: Indent
letIndent = Indent
4,
                      whereIndent :: Indent
whereIndent = Indent
6,
                      onsideIndent :: Indent
onsideIndent = Indent
2,
                      spacing :: Bool
spacing = Bool
True,
                      layout :: PPLayout
layout = PPLayout
PPOffsideRule,
                      linePragmas :: Bool
linePragmas = Bool
False
                      }

-- | Pretty printing monad
newtype DocM s a = DocM (s -> a)

instance Functor (DocM s) where
         fmap :: (a -> b) -> DocM s a -> DocM s b
fmap a -> b
f DocM s a
xs = do a
x <- DocM s a
xs; b -> DocM s b
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b
f a
x)

instance Applicative (DocM s) where
        pure :: a -> DocM s a
pure = a -> DocM s a
forall a s. a -> DocM s a
retDocM
        <*> :: DocM s (a -> b) -> DocM s a -> DocM s b
(<*>) = DocM s (a -> b) -> DocM s a -> DocM s b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
M.ap

instance Monad (DocM s) where
        >>= :: DocM s a -> (a -> DocM s b) -> DocM s b
(>>=) = DocM s a -> (a -> DocM s b) -> DocM s b
forall s a b. DocM s a -> (a -> DocM s b) -> DocM s b
thenDocM
        >> :: DocM s a -> DocM s b -> DocM s b
(>>) = DocM s a -> DocM s b -> DocM s b
forall s a b. DocM s a -> DocM s b -> DocM s b
then_DocM
        return :: a -> DocM s a
return = a -> DocM s a
forall a s. a -> DocM s a
retDocM

{-# INLINE thenDocM #-}
{-# INLINE then_DocM #-}
{-# INLINE retDocM #-}
{-# INLINE unDocM #-}
{-# INLINE getPPEnv #-}

thenDocM :: DocM s a -> (a -> DocM s b) -> DocM s b
thenDocM :: DocM s a -> (a -> DocM s b) -> DocM s b
thenDocM DocM s a
m a -> DocM s b
k = (s -> b) -> DocM s b
forall s a. (s -> a) -> DocM s a
DocM ((s -> b) -> DocM s b) -> (s -> b) -> DocM s b
forall a b. (a -> b) -> a -> b
$ \s
s -> case DocM s a -> s -> a
forall s a. DocM s a -> s -> a
unDocM DocM s a
m s
s of a
a -> DocM s b -> s -> b
forall s a. DocM s a -> s -> a
unDocM (a -> DocM s b
k a
a) s
s

then_DocM :: DocM s a -> DocM s b -> DocM s b
then_DocM :: DocM s a -> DocM s b -> DocM s b
then_DocM DocM s a
m DocM s b
k = (s -> b) -> DocM s b
forall s a. (s -> a) -> DocM s a
DocM ((s -> b) -> DocM s b) -> (s -> b) -> DocM s b
forall a b. (a -> b) -> a -> b
$ \s
s -> case DocM s a -> s -> a
forall s a. DocM s a -> s -> a
unDocM DocM s a
m s
s of a
_ -> DocM s b -> s -> b
forall s a. DocM s a -> s -> a
unDocM DocM s b
k s
s

retDocM :: a -> DocM s a
retDocM :: a -> DocM s a
retDocM a
a = (s -> a) -> DocM s a
forall s a. (s -> a) -> DocM s a
DocM ((s -> a) -> DocM s a) -> (s -> a) -> DocM s a
forall a b. (a -> b) -> a -> b
$ a -> s -> a
forall a b. a -> b -> a
const a
a

unDocM :: DocM s a -> s -> a
unDocM :: DocM s a -> s -> a
unDocM (DocM s -> a
f) = s -> a
f

-- all this extra stuff, just for this one function.
getPPEnv :: DocM s s
getPPEnv :: DocM s s
getPPEnv = (s -> s) -> DocM s s
forall s a. (s -> a) -> DocM s a
DocM s -> s
forall a. a -> a
id

-- So that pp code still looks the same
-- this means we lose some generality though

-- | The document type produced by these pretty printers uses a 'PPHsMode'
-- environment.
type Doc = DocM PPHsMode P.Doc

-- | Things that can be pretty-printed, including all the syntactic objects
-- in "Language.Haskell.Exts.Syntax".
class Pretty a where
        -- | Pretty-print something in isolation.
        pretty :: a -> Doc
        -- | Pretty-print something in a precedence context.
        prettyPrec :: Int -> a -> Doc
        pretty = Indent -> a -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
0
        prettyPrec Indent
_ = a -> Doc
forall a. Pretty a => a -> Doc
pretty

-- The pretty printing combinators

empty :: Doc
empty :: Doc
empty = Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return Doc
P.empty

nest :: Int -> Doc -> Doc
nest :: Indent -> Doc -> Doc
nest Indent
i Doc
m = Doc
m Doc -> (Doc -> Doc) -> Doc
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Indent -> Doc -> Doc
P.nest Indent
i


-- Literals

text :: String -> Doc
text :: String -> Doc
text = Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> Doc) -> (String -> Doc) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
P.text

char :: Char -> Doc
char :: Char -> Doc
char = Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> Doc) -> (Char -> Doc) -> Char -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Doc
P.char

int :: Int -> Doc
int :: Indent -> Doc
int = Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> Doc) -> (Indent -> Doc) -> Indent -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Indent -> Doc
P.int

integer :: Integer -> Doc
integer :: Integer -> Doc
integer = Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> Doc) -> (Integer -> Doc) -> Integer -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Doc
P.integer

float :: Float -> Doc
float :: Float -> Doc
float = Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> Doc) -> (Float -> Doc) -> Float -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Doc
P.float

double :: Double -> Doc
double :: Double -> Doc
double = Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> Doc) -> (Double -> Doc) -> Double -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Doc
P.double

-- rational :: Rational -> Doc
-- rational = return . P.rational

-- Simple Combining Forms

parens, brackets, braces, doubleQuotes :: Doc -> Doc
parens :: Doc -> Doc
parens Doc
d = Doc
d Doc -> (Doc -> Doc) -> Doc
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
P.parens
brackets :: Doc -> Doc
brackets Doc
d = Doc
d Doc -> (Doc -> Doc) -> Doc
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
P.brackets
braces :: Doc -> Doc
braces Doc
d = Doc
d Doc -> (Doc -> Doc) -> Doc
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
P.braces
-- quotes :: Doc -> Doc
-- quotes d = d >>= return . P.quotes
doubleQuotes :: Doc -> Doc
doubleQuotes Doc
d = Doc
d Doc -> (Doc -> Doc) -> Doc
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
P.doubleQuotes

parensIf :: Bool -> Doc -> Doc
parensIf :: Bool -> Doc -> Doc
parensIf Bool
True = Doc -> Doc
parens
parensIf Bool
False = Doc -> Doc
forall a. a -> a
id

-- Constants

semi,comma,space,equals :: Doc
semi :: Doc
semi = Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return Doc
P.semi
comma :: Doc
comma = Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return Doc
P.comma
-- colon :: Doc
-- colon = return P.colon
space :: Doc
space = Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return Doc
P.space
equals :: Doc
equals = Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return Doc
P.equals

{-
lparen,rparen,lbrack,rbrack,lbrace,rbrace :: Doc
lparen = return  P.lparen
rparen = return  P.rparen
lbrack = return  P.lbrack
rbrack = return  P.rbrack
lbrace = return  P.lbrace
rbrace = return  P.rbrace
-}

-- Combinators

(<>),(<+>),($$) :: Doc -> Doc -> Doc
Doc
aM <> :: Doc -> Doc -> Doc
<> Doc
bM = do{Doc
a<-Doc
aM;Doc
b<-Doc
bM;Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc
a Doc -> Doc -> Doc
P.<> Doc
b)}
Doc
aM <+> :: Doc -> Doc -> Doc
<+> Doc
bM = do{Doc
a<-Doc
aM;Doc
b<-Doc
bM;Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc
a Doc -> Doc -> Doc
P.<+> Doc
b)}
Doc
aM $$ :: Doc -> Doc -> Doc
$$ Doc
bM = do{Doc
a<-Doc
aM;Doc
b<-Doc
bM;Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc
a Doc -> Doc -> Doc
P.$$ Doc
b)}
($+$) :: Doc -> Doc -> Doc
Doc
aM $+$ :: Doc -> Doc -> Doc
$+$ Doc
bM = do{Doc
a<-Doc
aM;Doc
b<-Doc
bM;Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc
a Doc -> Doc -> Doc
P.$+$ Doc
b)}

hcat,hsep,vcat,fsep :: [Doc] -> Doc
hcat :: [Doc] -> Doc
hcat [Doc]
dl = [Doc] -> DocM PPHsMode [Doc]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Doc]
dl DocM PPHsMode [Doc] -> ([Doc] -> Doc) -> Doc
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
P.hcat
hsep :: [Doc] -> Doc
hsep [Doc]
dl = [Doc] -> DocM PPHsMode [Doc]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Doc]
dl DocM PPHsMode [Doc] -> ([Doc] -> Doc) -> Doc
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
P.hsep
vcat :: [Doc] -> Doc
vcat [Doc]
dl = [Doc] -> DocM PPHsMode [Doc]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Doc]
dl DocM PPHsMode [Doc] -> ([Doc] -> Doc) -> Doc
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
P.vcat
-- sep, cat, fcat :: [Doc] -> Doc
-- sep dl = sequence dl >>= return . P.sep
-- cat dl = sequence dl >>= return . P.cat
fsep :: [Doc] -> Doc
fsep [Doc]
dl = [Doc] -> DocM PPHsMode [Doc]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Doc]
dl DocM PPHsMode [Doc] -> ([Doc] -> Doc) -> Doc
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
P.fsep
-- fcat dl = sequence dl >>= return . P.fcat

-- Some More

-- hang :: Doc -> Int -> Doc -> Doc
-- hang dM i rM = do{d<-dM;r<-rM;return $ P.hang d i r}

-- Yuk, had to cut-n-paste this one from Pretty.hs
punctuate :: Doc -> [Doc] -> [Doc]
punctuate :: Doc -> [Doc] -> [Doc]
punctuate Doc
_ []     = []
punctuate Doc
p (Doc
d1:[Doc]
ds) = Doc -> [Doc] -> [Doc]
go Doc
d1 [Doc]
ds
                   where
                     go :: Doc -> [Doc] -> [Doc]
go Doc
d [] = [Doc
d]
                     go Doc
d (Doc
e:[Doc]
es) = (Doc
d Doc -> Doc -> Doc
<> Doc
p) Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: Doc -> [Doc] -> [Doc]
go Doc
e [Doc]
es

-- | render the document with a given style and mode.
renderStyleMode :: P.Style -> PPHsMode -> Doc -> String
renderStyleMode :: Style -> PPHsMode -> Doc -> String
renderStyleMode Style
ppStyle PPHsMode
ppMode Doc
d = Style -> Doc -> String
P.renderStyle Style
ppStyle (Doc -> String) -> (PPHsMode -> Doc) -> PPHsMode -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> PPHsMode -> Doc
forall s a. DocM s a -> s -> a
unDocM Doc
d (PPHsMode -> String) -> PPHsMode -> String
forall a b. (a -> b) -> a -> b
$ PPHsMode
ppMode

-- | render the document with a given mode.
-- renderWithMode :: PPHsMode -> Doc -> String
-- renderWithMode = renderStyleMode P.style

-- | render the document with 'defaultMode'.
-- render :: Doc -> String
-- render = renderWithMode defaultMode

-- | pretty-print with a given style and mode.
prettyPrintStyleMode :: Pretty a => P.Style -> PPHsMode -> a -> String
prettyPrintStyleMode :: Style -> PPHsMode -> a -> String
prettyPrintStyleMode Style
ppStyle PPHsMode
ppMode = Style -> PPHsMode -> Doc -> String
renderStyleMode Style
ppStyle PPHsMode
ppMode (Doc -> String) -> (a -> Doc) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Doc
forall a. Pretty a => a -> Doc
pretty

-- | pretty-print with the default style and a given mode.
prettyPrintWithMode :: Pretty a => PPHsMode -> a -> String
prettyPrintWithMode :: PPHsMode -> a -> String
prettyPrintWithMode = Style -> PPHsMode -> a -> String
forall a. Pretty a => Style -> PPHsMode -> a -> String
prettyPrintStyleMode Style
P.style

-- | pretty-print with the default style and 'defaultMode'.
prettyPrint :: Pretty a => a -> String
prettyPrint :: a -> String
prettyPrint = PPHsMode -> a -> String
forall a. Pretty a => PPHsMode -> a -> String
prettyPrintWithMode PPHsMode
defaultMode

-- fullRenderWithMode :: PPHsMode -> P.Mode -> Int -> Float ->
--                       (P.TextDetails -> a -> a) -> a -> Doc -> a
-- fullRenderWithMode ppMode m i f fn e mD =
--                   P.fullRender m i f fn e $ (unDocM mD) ppMode


-- fullRender :: P.Mode -> Int -> Float -> (P.TextDetails -> a -> a)
--               -> a -> Doc -> a
-- fullRender = fullRenderWithMode defaultMode

-- | pretty-print with the default style and 'defaultMode'.
prettyPrim :: Pretty a => a -> P.Doc
prettyPrim :: a -> Doc
prettyPrim = PPHsMode -> a -> Doc
forall a. Pretty a => PPHsMode -> a -> Doc
prettyPrimWithMode PPHsMode
defaultMode

-- | pretty-print with the default style and a given mode.
prettyPrimWithMode :: Pretty a => PPHsMode -> a -> P.Doc
prettyPrimWithMode :: PPHsMode -> a -> Doc
prettyPrimWithMode PPHsMode
pphs a
doc = Doc -> PPHsMode -> Doc
forall s a. DocM s a -> s -> a
unDocM (a -> Doc
forall a. Pretty a => a -> Doc
pretty a
doc) PPHsMode
pphs


-------------------------  Pretty-Print a Module --------------------
{-
instance  Pretty (Module l) where
        pretty (Module pos m os mbWarn mbExports imp decls) =
                markLine pos $ (myVcat $ map pretty os) $$
                myVcat (
                    (if m == ModuleName "" then id
                     else \x -> [topLevel (ppModuleHeader m mbWarn mbExports) x])
                    (map pretty imp ++
                      ppDecls (m /= ModuleName "" ||
                               not (null imp) ||
                               not (null os))
                              decls]-}

--------------------------  Module Header ------------------------------
instance Pretty (ModuleHead l) where
  pretty :: ModuleHead l -> Doc
pretty (ModuleHead l
_ ModuleName l
m Maybe (WarningText l)
mbWarn Maybe (ExportSpecList l)
mbExportList) =
    [Doc] -> Doc
mySep [
        String -> Doc
text String
"module",
        ModuleName l -> Doc
forall a. Pretty a => a -> Doc
pretty ModuleName l
m,
        (WarningText l -> Doc) -> Maybe (WarningText l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP WarningText l -> Doc
forall l. WarningText l -> Doc
ppWarnTxt Maybe (WarningText l)
mbWarn,
        (ExportSpecList l -> Doc) -> Maybe (ExportSpecList l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP ExportSpecList l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (ExportSpecList l)
mbExportList,
        String -> Doc
text String
"where"]

instance Pretty (ExportSpecList l) where
        pretty :: ExportSpecList l -> Doc
pretty (ExportSpecList l
_ [ExportSpec l]
especs)  = [Doc] -> Doc
parenList ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (ExportSpec l -> Doc) -> [ExportSpec l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ExportSpec l -> Doc
forall a. Pretty a => a -> Doc
pretty [ExportSpec l]
especs

ppWarnTxt :: WarningText l -> Doc
ppWarnTxt :: WarningText l -> Doc
ppWarnTxt (DeprText l
_ String
s) = [Doc] -> Doc
mySep [String -> Doc
text String
"{-# DEPRECATED", String -> Doc
text (String -> String
forall a. Show a => a -> String
show String
s), String -> Doc
text String
"#-}"]
ppWarnTxt (WarnText l
_ String
s) = [Doc] -> Doc
mySep [String -> Doc
text String
"{-# WARNING",    String -> Doc
text (String -> String
forall a. Show a => a -> String
show String
s), String -> Doc
text String
"#-}"]

instance  Pretty (ModuleName l) where
        pretty :: ModuleName l -> Doc
pretty (ModuleName l
_ String
modName) = String -> Doc
text String
modName

instance  Pretty (Namespace l) where
        pretty :: Namespace l -> Doc
pretty NoNamespace {}     = Doc
empty
        pretty TypeNamespace {}   = String -> Doc
text String
"type"
        pretty PatternNamespace {} = String -> Doc
text String
"pattern"

instance  Pretty (ExportSpec l) where
        pretty :: ExportSpec l -> Doc
pretty (EVar l
_ QName l
name)                = QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
name
        pretty (EAbs l
_ Namespace l
ns QName l
name)             = Namespace l -> Doc
forall a. Pretty a => a -> Doc
pretty Namespace l
ns Doc -> Doc -> Doc
<+> QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
name
        pretty (EThingWith l
_ EWildcard l
wc QName l
name [CName l]
nameList) =
          let prettyNames :: [Doc]
prettyNames = (CName l -> Doc) -> [CName l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CName l -> Doc
forall a. Pretty a => a -> Doc
pretty [CName l]
nameList
              names :: [Doc]
names = case EWildcard l
wc of
                        NoWildcard {} -> [Doc]
prettyNames
                        EWildcard l
_ Indent
n  ->
                          let ([Doc]
before,[Doc]
after) = Indent -> [Doc] -> ([Doc], [Doc])
forall a. Indent -> [a] -> ([a], [a])
splitAt Indent
n [Doc]
prettyNames
                          in [Doc]
before [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
".."] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc]
after
           in QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
name Doc -> Doc -> Doc
<> ([Doc] -> Doc
parenList [Doc]
names)
        pretty (EModuleContents l
_ ModuleName l
m)        = String -> Doc
text String
"module" Doc -> Doc -> Doc
<+> ModuleName l -> Doc
forall a. Pretty a => a -> Doc
pretty ModuleName l
m

instance  Pretty (ImportDecl l) where
        pretty :: ImportDecl l -> Doc
pretty (ImportDecl l
_ ModuleName l
m Bool
qual Bool
src Bool
safe Maybe String
mbPkg Maybe (ModuleName l)
mbName Maybe (ImportSpecList l)
mbSpecs) =
                [Doc] -> Doc
mySep [String -> Doc
text String
"import",
                       if Bool
src  then String -> Doc
text String
"{-# SOURCE #-}" else Doc
empty,
                       if Bool
safe then String -> Doc
text String
"safe" else Doc
empty,
                       if Bool
qual then String -> Doc
text String
"qualified" else Doc
empty,
                       (String -> Doc) -> Maybe String -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP (\String
s -> String -> Doc
text (String -> String
forall a. Show a => a -> String
show String
s)) Maybe String
mbPkg,
                       ModuleName l -> Doc
forall a. Pretty a => a -> Doc
pretty ModuleName l
m,
                       (ModuleName l -> Doc) -> Maybe (ModuleName l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP (\ModuleName l
m' -> String -> Doc
text String
"as" Doc -> Doc -> Doc
<+> ModuleName l -> Doc
forall a. Pretty a => a -> Doc
pretty ModuleName l
m') Maybe (ModuleName l)
mbName,
                       (ImportSpecList l -> Doc) -> Maybe (ImportSpecList l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP ImportSpecList l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (ImportSpecList l)
mbSpecs]

instance Pretty (ImportSpecList l) where
        pretty :: ImportSpecList l -> Doc
pretty (ImportSpecList l
_ Bool
b [ImportSpec l]
ispecs)  =
            (if Bool
b then String -> Doc
text String
"hiding" else Doc
empty)
                Doc -> Doc -> Doc
<+> [Doc] -> Doc
parenList ((ImportSpec l -> Doc) -> [ImportSpec l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ImportSpec l -> Doc
forall a. Pretty a => a -> Doc
pretty [ImportSpec l]
ispecs)

instance  Pretty (ImportSpec l) where
        pretty :: ImportSpec l -> Doc
pretty (IVar l
_ Name l
name  )              = Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
name
        pretty (IAbs l
_ Namespace l
ns Name l
name)             = Namespace l -> Doc
forall a. Pretty a => a -> Doc
pretty Namespace l
ns Doc -> Doc -> Doc
<+> Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
name
        pretty (IThingAll l
_ Name l
name)           = Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
name Doc -> Doc -> Doc
<> String -> Doc
text String
"(..)"
        pretty (IThingWith l
_ Name l
name [CName l]
nameList) =
                Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
name Doc -> Doc -> Doc
<> ([Doc] -> Doc
parenList ([Doc] -> Doc) -> ([CName l] -> [Doc]) -> [CName l] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CName l -> Doc) -> [CName l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CName l -> Doc
forall a. Pretty a => a -> Doc
pretty ([CName l] -> Doc) -> [CName l] -> Doc
forall a b. (a -> b) -> a -> b
$ [CName l]
nameList)

instance  Pretty (TypeEqn l) where
        pretty :: TypeEqn l -> Doc
pretty (TypeEqn l
_ Type l
pat Type l
eqn) = [Doc] -> Doc
mySep [Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
pat, Doc
equals, Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
eqn]

-------------------------  Declarations ------------------------------
class Pretty a => PrettyDeclLike a where
  wantsBlankline :: a -> Bool

instance  PrettyDeclLike (Decl l) where
  wantsBlankline :: Decl l -> Bool
wantsBlankline (FunBind {}) = Bool
False
  wantsBlankline (PatBind {}) = Bool
False
  wantsBlankline Decl l
_ = Bool
True

condBlankline :: PrettyDeclLike a => a -> Doc
condBlankline :: a -> Doc
condBlankline a
d = (if a -> Bool
forall a. PrettyDeclLike a => a -> Bool
wantsBlankline a
d then Doc -> Doc
blankline else Doc -> Doc
forall a. a -> a
id) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ a -> Doc
forall a. Pretty a => a -> Doc
pretty a
d

ppDecls :: PrettyDeclLike a => Bool -> [a] -> [Doc]
ppDecls :: Bool -> [a] -> [Doc]
ppDecls Bool
True  [a]
ds     = (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
forall a. PrettyDeclLike a => a -> Doc
condBlankline [a]
ds
ppDecls Bool
False (a
d:[a]
ds) = a -> Doc
forall a. Pretty a => a -> Doc
pretty a
d Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
forall a. PrettyDeclLike a => a -> Doc
condBlankline [a]
ds
ppDecls Bool
_ [a]
_ = []
--ppDecls = map condBlankline

instance Pretty (InjectivityInfo l) where
  pretty :: InjectivityInfo l -> Doc
pretty (InjectivityInfo l
_ Name l
from [Name l]
to) =
    Char -> Doc
char Char
'|' Doc -> Doc -> Doc
<+> Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
from Doc -> Doc -> Doc
<+> String -> Doc
text String
"->" Doc -> Doc -> Doc
<+> [Doc] -> Doc
hsep ((Name l -> Doc) -> [Name l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Name l -> Doc
forall a. Pretty a => a -> Doc
pretty [Name l]
to)

instance Pretty (ResultSig l) where
  pretty :: ResultSig l -> Doc
pretty (KindSig l
_ Kind l
kind) = String -> Doc
text String
"::" Doc -> Doc -> Doc
<+> Kind l -> Doc
forall a. Pretty a => a -> Doc
pretty Kind l
kind
  pretty (TyVarSig l
_ TyVarBind l
tv)  = Char -> Doc
char Char
'='  Doc -> Doc -> Doc
<+> TyVarBind l -> Doc
forall a. Pretty a => a -> Doc
pretty TyVarBind l
tv

instance  Pretty (Decl l) where
        pretty :: Decl l -> Doc
pretty (TypeDecl l
_ DeclHead l
dHead Type l
htype) =
                [Doc] -> Doc
mySep ( [String -> Doc
text String
"type", DeclHead l -> Doc
forall a. Pretty a => a -> Doc
pretty DeclHead l
dHead]
                        [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc
equals, Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
htype])

        pretty (DataDecl l
_ DataOrNew l
don Maybe (Context l)
context DeclHead l
dHead [QualConDecl l]
constrList [Deriving l]
derives) =
                [Doc] -> Doc
mySep ( [DataOrNew l -> Doc
forall a. Pretty a => a -> Doc
pretty DataOrNew l
don, (Context l -> Doc) -> Maybe (Context l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP Context l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (Context l)
context, DeclHead l -> Doc
forall a. Pretty a => a -> Doc
pretty DeclHead l
dHead])

                  Doc -> Doc -> Doc
<+> ([Doc] -> Doc
myVcat ((Doc -> Doc -> Doc) -> [Doc] -> [Doc] -> [Doc]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Doc -> Doc -> Doc
(<+>) (Doc
equals Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: Doc -> [Doc]
forall a. a -> [a]
repeat (Char -> Doc
char Char
'|'))
                                             ((QualConDecl l -> Doc) -> [QualConDecl l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map QualConDecl l -> Doc
forall a. Pretty a => a -> Doc
pretty [QualConDecl l]
constrList))
                        Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppIndent PPHsMode -> Indent
letIndent ((Deriving l -> Doc) -> [Deriving l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Deriving l -> Doc
forall a. Pretty a => a -> Doc
pretty [Deriving l]
derives))

        pretty (GDataDecl l
_ DataOrNew l
don Maybe (Context l)
context DeclHead l
dHead Maybe (Type l)
optkind [GadtDecl l]
gadtList [Deriving l]
derives) =
                [Doc] -> Doc
mySep ( [DataOrNew l -> Doc
forall a. Pretty a => a -> Doc
pretty DataOrNew l
don, (Context l -> Doc) -> Maybe (Context l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP Context l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (Context l)
context, DeclHead l -> Doc
forall a. Pretty a => a -> Doc
pretty DeclHead l
dHead]
                        [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ Maybe (Type l) -> [Doc]
forall l. Maybe (Kind l) -> [Doc]
ppOptKind Maybe (Type l)
optkind [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"where"])
                        Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
classIndent ((GadtDecl l -> Doc) -> [GadtDecl l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map GadtDecl l -> Doc
forall a. Pretty a => a -> Doc
pretty [GadtDecl l]
gadtList)
                        Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppIndent PPHsMode -> Indent
letIndent ((Deriving l -> Doc) -> [Deriving l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Deriving l -> Doc
forall a. Pretty a => a -> Doc
pretty [Deriving l]
derives)

        pretty (TypeFamDecl l
_ DeclHead l
dHead Maybe (ResultSig l)
optkind Maybe (InjectivityInfo l)
optinj) =
                [Doc] -> Doc
mySep ([String -> Doc
text String
"type", String -> Doc
text String
"family", DeclHead l -> Doc
forall a. Pretty a => a -> Doc
pretty DeclHead l
dHead
                       , (ResultSig l -> Doc) -> Maybe (ResultSig l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP ResultSig l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (ResultSig l)
optkind, (InjectivityInfo l -> Doc) -> Maybe (InjectivityInfo l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP InjectivityInfo l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (InjectivityInfo l)
optinj])

        pretty (ClosedTypeFamDecl l
_ DeclHead l
dHead Maybe (ResultSig l)
optkind Maybe (InjectivityInfo l)
optinj [TypeEqn l]
eqns) =
                [Doc] -> Doc
mySep ([String -> Doc
text String
"type", String -> Doc
text String
"family", DeclHead l -> Doc
forall a. Pretty a => a -> Doc
pretty DeclHead l
dHead
                       , (ResultSig l -> Doc) -> Maybe (ResultSig l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP ResultSig l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (ResultSig l)
optkind ,(InjectivityInfo l -> Doc) -> Maybe (InjectivityInfo l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP InjectivityInfo l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (InjectivityInfo l)
optinj
                       , String -> Doc
text String
"where"]) Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
classIndent ((TypeEqn l -> Doc) -> [TypeEqn l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map TypeEqn l -> Doc
forall a. Pretty a => a -> Doc
pretty [TypeEqn l]
eqns)

        pretty (DataFamDecl l
_ Maybe (Context l)
context DeclHead l
dHead Maybe (ResultSig l)
optkind) =
                [Doc] -> Doc
mySep ( [String -> Doc
text String
"data", String -> Doc
text String
"family", (Context l -> Doc) -> Maybe (Context l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP Context l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (Context l)
context, DeclHead l -> Doc
forall a. Pretty a => a -> Doc
pretty DeclHead l
dHead
                        , (ResultSig l -> Doc) -> Maybe (ResultSig l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP ResultSig l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (ResultSig l)
optkind])

        pretty (TypeInsDecl l
_ Type l
ntype Type l
htype) =
                [Doc] -> Doc
mySep [String -> Doc
text String
"type", String -> Doc
text String
"instance", Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
ntype, Doc
equals, Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
htype]

        pretty (DataInsDecl l
_ DataOrNew l
don Type l
ntype [QualConDecl l]
constrList [Deriving l]
derives) =
                [Doc] -> Doc
mySep [DataOrNew l -> Doc
forall a. Pretty a => a -> Doc
pretty DataOrNew l
don, String -> Doc
text String
"instance ", Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
ntype]
                        Doc -> Doc -> Doc
<+> ([Doc] -> Doc
myVcat ((Doc -> Doc -> Doc) -> [Doc] -> [Doc] -> [Doc]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Doc -> Doc -> Doc
(<+>) (Doc
equals Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: Doc -> [Doc]
forall a. a -> [a]
repeat (Char -> Doc
char Char
'|'))
                                                   ((QualConDecl l -> Doc) -> [QualConDecl l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map QualConDecl l -> Doc
forall a. Pretty a => a -> Doc
pretty [QualConDecl l]
constrList))
                              Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppIndent PPHsMode -> Indent
letIndent ((Deriving l -> Doc) -> [Deriving l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Deriving l -> Doc
forall a. Pretty a => a -> Doc
pretty [Deriving l]
derives))

        pretty (GDataInsDecl l
_ DataOrNew l
don Type l
ntype Maybe (Type l)
optkind [GadtDecl l]
gadtList [Deriving l]
derives) =
                [Doc] -> Doc
mySep ( [DataOrNew l -> Doc
forall a. Pretty a => a -> Doc
pretty DataOrNew l
don, String -> Doc
text String
"instance ", Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
ntype]
                        [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ Maybe (Type l) -> [Doc]
forall l. Maybe (Kind l) -> [Doc]
ppOptKind Maybe (Type l)
optkind [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"where"])
                        Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
classIndent ((GadtDecl l -> Doc) -> [GadtDecl l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map GadtDecl l -> Doc
forall a. Pretty a => a -> Doc
pretty [GadtDecl l]
gadtList)
                        Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppIndent PPHsMode -> Indent
letIndent ((Deriving l -> Doc) -> [Deriving l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Deriving l -> Doc
forall a. Pretty a => a -> Doc
pretty [Deriving l]
derives)

        --m{spacing=False}
        -- special case for empty class declaration
        pretty (ClassDecl l
_ Maybe (Context l)
context DeclHead l
dHead [FunDep l]
fundeps Maybe [ClassDecl l]
Nothing) =
                [Doc] -> Doc
mySep ( [String -> Doc
text String
"class", (Context l -> Doc) -> Maybe (Context l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP Context l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (Context l)
context, DeclHead l -> Doc
forall a. Pretty a => a -> Doc
pretty DeclHead l
dHead
                        , [FunDep l] -> Doc
forall l. [FunDep l] -> Doc
ppFunDeps [FunDep l]
fundeps])
        pretty (ClassDecl l
_ Maybe (Context l)
context DeclHead l
dHead [FunDep l]
fundeps Maybe [ClassDecl l]
declList) =
                [Doc] -> Doc
mySep ( [String -> Doc
text String
"class", (Context l -> Doc) -> Maybe (Context l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP Context l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (Context l)
context, DeclHead l -> Doc
forall a. Pretty a => a -> Doc
pretty DeclHead l
dHead
                        , [FunDep l] -> Doc
forall l. [FunDep l] -> Doc
ppFunDeps [FunDep l]
fundeps, String -> Doc
text String
"where"])
                Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
classIndent ([Doc] -> Maybe [Doc] -> [Doc]
forall a. a -> Maybe a -> a
fromMaybe [] ((Bool -> [ClassDecl l] -> [Doc]
forall a. PrettyDeclLike a => Bool -> [a] -> [Doc]
ppDecls Bool
False) ([ClassDecl l] -> [Doc]) -> Maybe [ClassDecl l] -> Maybe [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [ClassDecl l]
declList))

        -- m{spacing=False}
        -- special case for empty instance  declaration
        pretty (InstDecl l
_ Maybe (Overlap l)
moverlap InstRule l
iHead Maybe [InstDecl l]
Nothing) =
                  [Doc] -> Doc
mySep ( [String -> Doc
text String
"instance", (Overlap l -> Doc) -> Maybe (Overlap l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP Overlap l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (Overlap l)
moverlap, InstRule l -> Doc
forall a. Pretty a => a -> Doc
pretty InstRule l
iHead])
        pretty (InstDecl l
_ Maybe (Overlap l)
overlap InstRule l
iHead Maybe [InstDecl l]
declList) =
                [Doc] -> Doc
mySep ( [ String -> Doc
text String
"instance", (Overlap l -> Doc) -> Maybe (Overlap l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP Overlap l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (Overlap l)
overlap
                           , InstRule l -> Doc
forall a. Pretty a => a -> Doc
pretty InstRule l
iHead, String -> Doc
text String
"where"])
                Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
classIndent ([Doc] -> Maybe [Doc] -> [Doc]
forall a. a -> Maybe a -> a
fromMaybe [] ((Bool -> [InstDecl l] -> [Doc]
forall a. PrettyDeclLike a => Bool -> [a] -> [Doc]
ppDecls Bool
False) ([InstDecl l] -> [Doc]) -> Maybe [InstDecl l] -> Maybe [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [InstDecl l]
declList))

        pretty (DerivDecl l
_ Maybe (DerivStrategy l)
mds Maybe (Overlap l)
overlap InstRule l
irule) =
                  [Doc] -> Doc
mySep ( [ String -> Doc
text String
"deriving"
                          , (DerivStrategy l -> Doc) -> Maybe (DerivStrategy l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP DerivStrategy l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (DerivStrategy l)
mds
                          , String -> Doc
text String
"instance"
                          , (Overlap l -> Doc) -> Maybe (Overlap l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP Overlap l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (Overlap l)
overlap
                          , InstRule l -> Doc
forall a. Pretty a => a -> Doc
pretty InstRule l
irule])
        pretty (DefaultDecl l
_ [Type l]
htypes) =
                String -> Doc
text String
"default" Doc -> Doc -> Doc
<+> [Doc] -> Doc
parenList ((Type l -> Doc) -> [Type l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Type l -> Doc
forall a. Pretty a => a -> Doc
pretty [Type l]
htypes)

        pretty (SpliceDecl l
_ Exp l
splice) =
                Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
splice

        pretty (TSpliceDecl l
_ Exp l
splice) =
                Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
splice

        pretty (TypeSig l
_ [Name l]
nameList Type l
qualType) =
                [Doc] -> Doc
mySep ((Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> ([Name l] -> [Doc]) -> [Name l] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name l -> Doc) -> [Name l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Name l -> Doc
forall a. Pretty a => a -> Doc
pretty ([Name l] -> [Doc]) -> [Name l] -> [Doc]
forall a b. (a -> b) -> a -> b
$ [Name l]
nameList)
                      [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"::", Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
qualType])

        --  Req can be ommitted if it is empty
        --  We must print prov if req is nonempty
        pretty (PatSynSig l
_ [Name l]
ns Maybe [TyVarBind l]
mtvs Maybe (Context l)
prov Maybe [TyVarBind l]
mtvs2 Maybe (Context l)
req Type l
t) =
                let contexts :: [Doc]
contexts = [(Context l -> Doc) -> Maybe (Context l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP Context l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (Context l)
prov, Maybe [TyVarBind l] -> Doc
forall l. Maybe [TyVarBind l] -> Doc
ppForall Maybe [TyVarBind l]
mtvs2, (Context l -> Doc) -> Maybe (Context l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP Context l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (Context l)
req]
                 in
                  [Doc] -> Doc
mySep ( [String -> Doc
text String
"pattern" ]
                           [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ Doc -> [Doc] -> [Doc]
punctuate Doc
comma ((Name l -> Doc) -> [Name l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Name l -> Doc
forall a. Pretty a => a -> Doc
pretty [Name l]
ns)
                           [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [ String -> Doc
text String
"::", Maybe [TyVarBind l] -> Doc
forall l. Maybe [TyVarBind l] -> Doc
ppForall Maybe [TyVarBind l]
mtvs] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++
                          [Doc]
contexts [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
t] )


        pretty (FunBind l
_ [Match l]
matches) = do
                PPLayout
e <- (PPHsMode -> PPLayout)
-> DocM PPHsMode PPHsMode -> DocM PPHsMode PPLayout
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PPHsMode -> PPLayout
layout DocM PPHsMode PPHsMode
forall s. DocM s s
getPPEnv
                case PPLayout
e of PPLayout
PPOffsideRule -> (Doc -> Doc -> Doc) -> Doc -> [Doc] -> Doc
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Doc -> Doc -> Doc
($$$) Doc
empty ((Match l -> Doc) -> [Match l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Match l -> Doc
forall a. Pretty a => a -> Doc
pretty [Match l]
matches)
                          PPLayout
_ -> [Doc] -> Doc
hsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
semi ((Match l -> Doc) -> [Match l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Match l -> Doc
forall a. Pretty a => a -> Doc
pretty [Match l]
matches)

        pretty (PatBind l
_ Pat l
pat Rhs l
rhs Maybe (Binds l)
whereBinds) =
                [Doc] -> Doc
myFsep [Pat l -> Doc
forall a. Pretty a => a -> Doc
pretty Pat l
pat, Rhs l -> Doc
forall a. Pretty a => a -> Doc
pretty Rhs l
rhs] Doc -> Doc -> Doc
$$$ Maybe (Binds l) -> Doc
forall l. Maybe (Binds l) -> Doc
ppWhere Maybe (Binds l)
whereBinds

        pretty (InfixDecl l
_ Assoc l
assoc Maybe Indent
prec [Op l]
opList) =
                [Doc] -> Doc
mySep ([Assoc l -> Doc
forall a. Pretty a => a -> Doc
pretty Assoc l
assoc, (Indent -> Doc) -> Maybe Indent -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP Indent -> Doc
int Maybe Indent
prec]
                       [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> ([Op l] -> [Doc]) -> [Op l] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Op l -> Doc) -> [Op l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Op l -> Doc
forall a. Pretty a => a -> Doc
pretty ([Op l] -> [Doc]) -> [Op l] -> [Doc]
forall a b. (a -> b) -> a -> b
$ [Op l]
opList))

        pretty (PatSyn l
_ Pat l
pat Pat l
rhs PatternSynDirection l
dir) =
                let sep :: String
sep = case PatternSynDirection l
dir of
                            ImplicitBidirectional {}   -> String
"="
                            ExplicitBidirectional {}   -> String
"<-"
                            Unidirectional {}          -> String
"<-"
                in
                 ([Doc] -> Doc
mySep ([String -> Doc
text String
"pattern", Pat l -> Doc
forall a. Pretty a => a -> Doc
pretty Pat l
pat, String -> Doc
text String
sep, Pat l -> Doc
forall a. Pretty a => a -> Doc
pretty Pat l
rhs])) Doc -> Doc -> Doc
$$$
                    (case PatternSynDirection l
dir of
                      ExplicitBidirectional l
_ [Decl l]
ds ->
                        Indent -> Doc -> Doc
nest Indent
2 (String -> Doc
text String
"where" Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
whereIndent (Bool -> [Decl l] -> [Doc]
forall a. PrettyDeclLike a => Bool -> [a] -> [Doc]
ppDecls Bool
False [Decl l]
ds))
                      PatternSynDirection l
_ -> Doc
empty)

        pretty (ForImp l
_ CallConv l
cconv Maybe (Safety l)
saf Maybe String
str Name l
name Type l
typ) =
                [Doc] -> Doc
mySep [String -> Doc
text String
"foreign import", CallConv l -> Doc
forall a. Pretty a => a -> Doc
pretty CallConv l
cconv, (Safety l -> Doc) -> Maybe (Safety l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP Safety l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (Safety l)
saf,
                       Doc -> (String -> Doc) -> Maybe String -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty (String -> Doc
text (String -> Doc) -> (String -> String) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. Show a => a -> String
show) Maybe String
str, Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
name, String -> Doc
text String
"::", Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
typ]

        pretty (ForExp l
_ CallConv l
cconv Maybe String
str Name l
name Type l
typ) =
                [Doc] -> Doc
mySep [String -> Doc
text String
"foreign export", CallConv l -> Doc
forall a. Pretty a => a -> Doc
pretty CallConv l
cconv,
                       String -> Doc
text (Maybe String -> String
forall a. Show a => a -> String
show Maybe String
str), Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
name, String -> Doc
text String
"::", Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
typ]

        pretty (RulePragmaDecl l
_ [Rule l]
rules) =
                [Doc] -> Doc
myVcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"{-# RULES" Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (Rule l -> Doc) -> [Rule l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Rule l -> Doc
forall a. Pretty a => a -> Doc
pretty [Rule l]
rules [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
" #-}"]

        pretty (DeprPragmaDecl l
_ [([Name l], String)]
deprs) =
                [Doc] -> Doc
myVcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"{-# DEPRECATED" Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (([Name l], String) -> Doc) -> [([Name l], String)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ([Name l], String) -> Doc
forall l. ([Name l], String) -> Doc
ppWarnDepr [([Name l], String)]
deprs [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
" #-}"]

        pretty (WarnPragmaDecl l
_ [([Name l], String)]
deprs) =
                [Doc] -> Doc
myVcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"{-# WARNING" Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (([Name l], String) -> Doc) -> [([Name l], String)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ([Name l], String) -> Doc
forall l. ([Name l], String) -> Doc
ppWarnDepr [([Name l], String)]
deprs [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
" #-}"]

        pretty (InlineSig l
_ Bool
inl Maybe (Activation l)
activ QName l
name) =
                [Doc] -> Doc
mySep [String -> Doc
text (if Bool
inl then String
"{-# INLINE" else String
"{-# NOINLINE")
                      , (Activation l -> Doc) -> Maybe (Activation l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP Activation l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (Activation l)
activ, QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
name, String -> Doc
text String
"#-}"]

        pretty (InlineConlikeSig l
_ Maybe (Activation l)
activ QName l
name) =
                [Doc] -> Doc
mySep [ String -> Doc
text String
"{-# INLINE CONLIKE", (Activation l -> Doc) -> Maybe (Activation l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP Activation l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (Activation l)
activ
                      , QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
name, String -> Doc
text String
"#-}"]

        pretty (SpecSig l
_ Maybe (Activation l)
activ QName l
name [Type l]
types) =
                [Doc] -> Doc
mySep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [String -> Doc
text String
"{-# SPECIALISE", (Activation l -> Doc) -> Maybe (Activation l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP Activation l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (Activation l)
activ
                        , QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
name, String -> Doc
text String
"::"]
                         [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ Doc -> [Doc] -> [Doc]
punctuate Doc
comma ((Type l -> Doc) -> [Type l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Type l -> Doc
forall a. Pretty a => a -> Doc
pretty [Type l]
types) [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"#-}"]

        pretty (SpecInlineSig l
_ Bool
inl Maybe (Activation l)
activ QName l
name [Type l]
types) =
                [Doc] -> Doc
mySep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [String -> Doc
text String
"{-# SPECIALISE", String -> Doc
text (if Bool
inl then String
"INLINE" else String
"NOINLINE"),
                        (Activation l -> Doc) -> Maybe (Activation l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP Activation l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (Activation l)
activ, QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
name, String -> Doc
text String
"::"]
                        [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (Type l -> Doc) -> [Type l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Type l -> Doc
forall a. Pretty a => a -> Doc
pretty [Type l]
types) [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"#-}"]

        pretty (InstSig l
_ InstRule l
irule) =
                [Doc] -> Doc
mySep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [ String -> Doc
text String
"{-# SPECIALISE", String -> Doc
text String
"instance", InstRule l -> Doc
forall a. Pretty a => a -> Doc
pretty InstRule l
irule
                        , String -> Doc
text String
"#-}"]

        pretty (AnnPragma l
_ Annotation l
annp) =
                [Doc] -> Doc
mySep [String -> Doc
text String
"{-# ANN", Annotation l -> Doc
forall a. Pretty a => a -> Doc
pretty Annotation l
annp, String -> Doc
text String
"#-}"]

        pretty (MinimalPragma l
_ Maybe (BooleanFormula l)
b) =
                let bs :: Doc
bs = case Maybe (BooleanFormula l)
b of { Just BooleanFormula l
b' -> BooleanFormula l -> Doc
forall a. Pretty a => a -> Doc
pretty BooleanFormula l
b'; Maybe (BooleanFormula l)
_ -> Doc
empty }
                in [Doc] -> Doc
myFsep [String -> Doc
text String
"{-# MINIMAL", Doc
bs, String -> Doc
text String
"#-}"]

        pretty (RoleAnnotDecl l
_ QName l
qn [Role l]
rs) =
                [Doc] -> Doc
mySep ( [String -> Doc
text String
"type", String -> Doc
text String
"role", QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
qn]
                        [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ (Role l -> Doc) -> [Role l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Role l -> Doc
forall a. Pretty a => a -> Doc
pretty [Role l]
rs )
        pretty (CompletePragma l
_ [Name l]
cls Maybe (QName l)
opt_ts) =
                let cls_p :: [Doc]
cls_p = Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (Name l -> Doc) -> [Name l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Name l -> Doc
forall a. Pretty a => a -> Doc
pretty [Name l]
cls
                    ts_p :: Doc
ts_p  = Doc -> (QName l -> Doc) -> Maybe (QName l) -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty (\QName l
tc -> String -> Doc
text String
"::" Doc -> Doc -> Doc
<+> QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
tc) Maybe (QName l)
opt_ts
                in [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [String -> Doc
text String
"{-# COMPLETE"] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc]
cls_p [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc
ts_p, String -> Doc
text String
"#-}"]

instance Pretty (InstRule l) where
    pretty :: InstRule l -> Doc
pretty (IRule l
_ Maybe [TyVarBind l]
tvs Maybe (Context l)
mctxt InstHead l
qn)  =
            [Doc] -> Doc
mySep [Maybe [TyVarBind l] -> Doc
forall l. Maybe [TyVarBind l] -> Doc
ppForall Maybe [TyVarBind l]
tvs
                  , (Context l -> Doc) -> Maybe (Context l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP Context l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (Context l)
mctxt, InstHead l -> Doc
forall a. Pretty a => a -> Doc
pretty InstHead l
qn]
    pretty (IParen l
_ InstRule l
ih)        = Doc -> Doc
parens (InstRule l -> Doc
forall a. Pretty a => a -> Doc
pretty InstRule l
ih)

instance  Pretty (InstHead l) where
    pretty :: InstHead l -> Doc
pretty (IHCon l
_ QName l
qn)          = QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
qn
    pretty (IHInfix l
_ Type l
ta QName l
qn)     = [Doc] -> Doc
mySep [Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
ta, QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
qn]
    pretty (IHParen l
_ InstHead l
ih)        = Doc -> Doc
parens (InstHead l -> Doc
forall a. Pretty a => a -> Doc
pretty InstHead l
ih)
    pretty (IHApp l
_ InstHead l
ih Type l
t)        = [Doc] -> Doc
myFsep [InstHead l -> Doc
forall a. Pretty a => a -> Doc
pretty InstHead l
ih, Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
t]


instance  Pretty (Annotation l) where
        pretty :: Annotation l -> Doc
pretty (Ann l
_ Name l
n Exp l
e) = [Doc] -> Doc
myFsep [Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
n, Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e]
        pretty (TypeAnn l
_ Name l
n Exp l
e) = [Doc] -> Doc
myFsep [String -> Doc
text String
"type", Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
n, Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e]
        pretty (ModuleAnn l
_ Exp l
e) = [Doc] -> Doc
myFsep [String -> Doc
text String
"module", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e]

instance  Pretty (BooleanFormula l) where
        pretty :: BooleanFormula l -> Doc
pretty (VarFormula l
_ Name l
n)   = Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
n
        pretty (AndFormula l
_ [BooleanFormula l]
bs)  = [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate (String -> Doc
text String
" ,") ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (BooleanFormula l -> Doc) -> [BooleanFormula l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map BooleanFormula l -> Doc
forall a. Pretty a => a -> Doc
pretty [BooleanFormula l]
bs
        pretty (OrFormula l
_ [BooleanFormula l]
bs)   = [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate (String -> Doc
text String
" |") ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (BooleanFormula l -> Doc) -> [BooleanFormula l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map BooleanFormula l -> Doc
forall a. Pretty a => a -> Doc
pretty [BooleanFormula l]
bs
        pretty (ParenFormula l
_ BooleanFormula l
b) = Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ BooleanFormula l -> Doc
forall a. Pretty a => a -> Doc
pretty BooleanFormula l
b

instance  Pretty (Role l) where
        pretty :: Role l -> Doc
pretty RoleWildcard{}     = Char -> Doc
char Char
'_'
        pretty Nominal{}          = String -> Doc
text String
"nominal"
        pretty Representational{} = String -> Doc
text String
"representational"
        pretty Phantom{}          = String -> Doc
text String
"phantom"

instance  Pretty (DataOrNew l) where
        pretty :: DataOrNew l -> Doc
pretty DataType{} = String -> Doc
text String
"data"
        pretty NewType{}  = String -> Doc
text String
"newtype"

instance  Pretty (Assoc l) where
        pretty :: Assoc l -> Doc
pretty AssocNone{}  = String -> Doc
text String
"infix"
        pretty AssocLeft{}  = String -> Doc
text String
"infixl"
        pretty AssocRight{} = String -> Doc
text String
"infixr"

instance  Pretty (Match l) where
        pretty :: Match l -> Doc
pretty (InfixMatch l
_ Pat l
l Name l
op [Pat l]
rs Rhs l
rhs Maybe (Binds l)
wbinds) =
          let
              lhs :: [Doc]
lhs = case [Pat l]
rs of
                      []  -> [] -- Should never reach
                      (Pat l
r:[Pat l]
rs') ->
                        let hd :: [Doc]
hd = [Indent -> Pat l -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
2 Pat l
l, Name l -> Doc
forall l. Name l -> Doc
ppNameInfix Name l
op, Indent -> Pat l -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
2 Pat l
r]
                        in if [Pat l] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Pat l]
rs'
                            then [Doc]
hd
                            else Doc -> Doc
parens ([Doc] -> Doc
myFsep [Doc]
hd) Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (Pat l -> Doc) -> [Pat l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Indent -> Pat l -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
3) [Pat l]
rs'

          in [Doc] -> Doc
myFsep ([Doc]
lhs [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Rhs l -> Doc
forall a. Pretty a => a -> Doc
pretty Rhs l
rhs]) Doc -> Doc -> Doc
$$$ Maybe (Binds l) -> Doc
forall l. Maybe (Binds l) -> Doc
ppWhere Maybe (Binds l)
wbinds
        pretty (Match l
_ Name l
f [Pat l]
ps Rhs l
rhs Maybe (Binds l)
whereBinds) =
                [Doc] -> Doc
myFsep (Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
f Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (Pat l -> Doc) -> [Pat l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Indent -> Pat l -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
3) [Pat l]
ps [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Rhs l -> Doc
forall a. Pretty a => a -> Doc
pretty Rhs l
rhs])
                Doc -> Doc -> Doc
$$$ Maybe (Binds l) -> Doc
forall l. Maybe (Binds l) -> Doc
ppWhere Maybe (Binds l)
whereBinds

ppWhere :: Maybe (Binds l) -> Doc
ppWhere :: Maybe (Binds l) -> Doc
ppWhere Maybe (Binds l)
Nothing            = Doc
empty
ppWhere (Just (BDecls l
_ [Decl l]
l))  = Indent -> Doc -> Doc
nest Indent
2 (String -> Doc
text String
"where" Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
whereIndent (Bool -> [Decl l] -> [Doc]
forall a. PrettyDeclLike a => Bool -> [a] -> [Doc]
ppDecls Bool
False [Decl l]
l))
ppWhere (Just (IPBinds l
_ [IPBind l]
b)) = Indent -> Doc -> Doc
nest Indent
2 (String -> Doc
text String
"where" Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
whereIndent (Bool -> [IPBind l] -> [Doc]
forall a. PrettyDeclLike a => Bool -> [a] -> [Doc]
ppDecls Bool
False [IPBind l]
b))

instance  PrettyDeclLike (ClassDecl l) where
    wantsBlankline :: ClassDecl l -> Bool
wantsBlankline (ClsDecl l
_ Decl l
d) = Decl l -> Bool
forall a. PrettyDeclLike a => a -> Bool
wantsBlankline Decl l
d
    wantsBlankline (ClsDefSig {}) = Bool
True
    wantsBlankline ClassDecl l
_ = Bool
False

instance  Pretty (ClassDecl l) where
    pretty :: ClassDecl l -> Doc
pretty (ClsDecl l
_ Decl l
decl) = Decl l -> Doc
forall a. Pretty a => a -> Doc
pretty Decl l
decl

    pretty (ClsDataFam l
_ Maybe (Context l)
context DeclHead l
declHead Maybe (ResultSig l)
optkind) =
                [Doc] -> Doc
mySep ( [String -> Doc
text String
"data", (Context l -> Doc) -> Maybe (Context l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP Context l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (Context l)
context, DeclHead l -> Doc
forall a. Pretty a => a -> Doc
pretty DeclHead l
declHead
                        , (ResultSig l -> Doc) -> Maybe (ResultSig l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP ResultSig l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (ResultSig l)
optkind])

    pretty (ClsTyFam l
_ DeclHead l
declHead Maybe (ResultSig l)
optkind Maybe (InjectivityInfo l)
optinj) =
                [Doc] -> Doc
mySep ( [String -> Doc
text String
"type", DeclHead l -> Doc
forall a. Pretty a => a -> Doc
pretty DeclHead l
declHead
                        , (ResultSig l -> Doc) -> Maybe (ResultSig l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP ResultSig l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (ResultSig l)
optkind, (InjectivityInfo l -> Doc) -> Maybe (InjectivityInfo l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP InjectivityInfo l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (InjectivityInfo l)
optinj])

    pretty (ClsTyDef l
_ TypeEqn l
ntype) =
                [Doc] -> Doc
mySep [String -> Doc
text String
"type", TypeEqn l -> Doc
forall a. Pretty a => a -> Doc
pretty TypeEqn l
ntype]

    pretty (ClsDefSig l
_ Name l
name Type l
typ) =
                [Doc] -> Doc
mySep [
                    String -> Doc
text String
"default",
                    Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
name,
                    String -> Doc
text String
"::",
                    Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
typ]

instance Pretty (DeclHead l) where
  pretty :: DeclHead l -> Doc
pretty (DHead l
_ Name l
n) = Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
n
  pretty (DHInfix l
_ TyVarBind l
tv Name l
n) =  TyVarBind l -> Doc
forall a. Pretty a => a -> Doc
pretty TyVarBind l
tv Doc -> Doc -> Doc
<+> Name l -> Doc
forall l. Name l -> Doc
ppNameInfix Name l
n
  pretty (DHParen l
_ DeclHead l
d) = Doc -> Doc
parens (DeclHead l -> Doc
forall a. Pretty a => a -> Doc
pretty DeclHead l
d)
  pretty (DHApp l
_ DeclHead l
dh TyVarBind l
tv) = DeclHead l -> Doc
forall a. Pretty a => a -> Doc
pretty DeclHead l
dh Doc -> Doc -> Doc
<+> TyVarBind l -> Doc
forall a. Pretty a => a -> Doc
pretty TyVarBind l
tv



instance  PrettyDeclLike (InstDecl l) where
    wantsBlankline :: InstDecl l -> Bool
wantsBlankline (InsDecl l
_ Decl l
d) = Decl l -> Bool
forall a. PrettyDeclLike a => a -> Bool
wantsBlankline Decl l
d
    wantsBlankline InstDecl l
_ = Bool
False

instance  Pretty (InstDecl l) where
        pretty :: InstDecl l -> Doc
pretty (InsDecl l
_ Decl l
decl) = Decl l -> Doc
forall a. Pretty a => a -> Doc
pretty Decl l
decl

        pretty (InsType l
_ Type l
ntype Type l
htype) =
                [Doc] -> Doc
mySep [String -> Doc
text String
"type", Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
ntype, Doc
equals, Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
htype]

        pretty (InsData l
_ DataOrNew l
don Type l
ntype [QualConDecl l]
constrList [Deriving l]
derives) =
                [Doc] -> Doc
mySep [DataOrNew l -> Doc
forall a. Pretty a => a -> Doc
pretty DataOrNew l
don, Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
ntype]
                        Doc -> Doc -> Doc
<+> ([Doc] -> Doc
myVcat ((Doc -> Doc -> Doc) -> [Doc] -> [Doc] -> [Doc]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Doc -> Doc -> Doc
(<+>) (Doc
equals Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: Doc -> [Doc]
forall a. a -> [a]
repeat (Char -> Doc
char Char
'|'))
                                                   ((QualConDecl l -> Doc) -> [QualConDecl l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map QualConDecl l -> Doc
forall a. Pretty a => a -> Doc
pretty [QualConDecl l]
constrList))
                              Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppIndent PPHsMode -> Indent
letIndent ((Deriving l -> Doc) -> [Deriving l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Deriving l -> Doc
forall a. Pretty a => a -> Doc
pretty [Deriving l]
derives))

        pretty (InsGData l
_ DataOrNew l
don Type l
ntype Maybe (Type l)
optkind [GadtDecl l]
gadtList [Deriving l]
derives) =
                [Doc] -> Doc
mySep ( [DataOrNew l -> Doc
forall a. Pretty a => a -> Doc
pretty DataOrNew l
don, Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
ntype]
                        [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ Maybe (Type l) -> [Doc]
forall l. Maybe (Kind l) -> [Doc]
ppOptKind Maybe (Type l)
optkind [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"where"])
                        Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
classIndent ((GadtDecl l -> Doc) -> [GadtDecl l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map GadtDecl l -> Doc
forall a. Pretty a => a -> Doc
pretty [GadtDecl l]
gadtList)
                        Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppIndent PPHsMode -> Indent
letIndent ((Deriving l -> Doc) -> [Deriving l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Deriving l -> Doc
forall a. Pretty a => a -> Doc
pretty [Deriving l]
derives)

--        pretty (InsInline loc inl activ name) =
--                markLine loc $
--                mySep [text (if inl then "{-# INLINE" else "{-# NOINLINE"), pretty activ, pretty name, text "#-}"]


------------------------- FFI stuff -------------------------------------
instance  Pretty (Safety l) where
        pretty :: Safety l -> Doc
pretty PlayRisky {}        = String -> Doc
text String
"unsafe"
        pretty (PlaySafe l
_ Bool
b)      = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ if Bool
b then String
"threadsafe" else String
"safe"
        pretty PlayInterruptible {} = String -> Doc
text String
"interruptible"

instance  Pretty (CallConv l) where
        pretty :: CallConv l -> Doc
pretty StdCall {}    = String -> Doc
text String
"stdcall"
        pretty CCall {}     = String -> Doc
text String
"ccall"
        pretty CPlusPlus {}  = String -> Doc
text String
"cplusplus"
        pretty DotNet {}     = String -> Doc
text String
"dotnet"
        pretty Jvm {}        = String -> Doc
text String
"jvm"
        pretty Js {}         = String -> Doc
text String
"js"
        pretty JavaScript {} = String -> Doc
text String
"javascript"
        pretty CApi {}       = String -> Doc
text String
"capi"

------------------------- Pragmas ---------------------------------------
ppWarnDepr :: ([Name l], String) -> Doc
ppWarnDepr :: ([Name l], String) -> Doc
ppWarnDepr ([Name l]
names, String
txt) = [Doc] -> Doc
mySep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
comma ((Name l -> Doc) -> [Name l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Name l -> Doc
forall a. Pretty a => a -> Doc
pretty [Name l]
names) [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. Show a => a -> String
show String
txt]

instance  Pretty (Rule l) where
        pretty :: Rule l -> Doc
pretty (Rule l
_ String
tag Maybe (Activation l)
activ Maybe [RuleVar l]
rvs Exp l
rhs Exp l
lhs) =
            [Doc] -> Doc
mySep [String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. Show a => a -> String
show String
tag, (Activation l -> Doc) -> Maybe (Activation l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP Activation l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (Activation l)
activ,
                        ([RuleVar l] -> Doc) -> Maybe [RuleVar l] -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP [RuleVar l] -> Doc
forall l. [RuleVar l] -> Doc
ppRuleVars Maybe [RuleVar l]
rvs,
                        Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
rhs, Char -> Doc
char Char
'=', Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
lhs]

ppRuleVars :: [RuleVar l] -> Doc
ppRuleVars :: [RuleVar l] -> Doc
ppRuleVars []  = Doc
empty
ppRuleVars [RuleVar l]
rvs = [Doc] -> Doc
mySep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"forall" Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (RuleVar l -> Doc) -> [RuleVar l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map RuleVar l -> Doc
forall a. Pretty a => a -> Doc
pretty [RuleVar l]
rvs [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Char -> Doc
char Char
'.']

instance  Pretty (Activation l) where
    pretty :: Activation l -> Doc
pretty (ActiveFrom l
_ Indent
i)  = Char -> Doc
char Char
'['  Doc -> Doc -> Doc
<> Indent -> Doc
int Indent
i Doc -> Doc -> Doc
<> Char -> Doc
char Char
']'
    pretty (ActiveUntil l
_ Indent
i) = String -> Doc
text String
"[~" Doc -> Doc -> Doc
<> Indent -> Doc
int Indent
i Doc -> Doc -> Doc
<> Char -> Doc
char Char
']'

instance  Pretty (Overlap l) where
    pretty :: Overlap l -> Doc
pretty Overlap {}   = String -> Doc
text String
"{-# OVERLAP #-}"
    pretty Overlaps {}   = String -> Doc
text String
"{-# OVERLAPS #-}"
    pretty Overlapping {}   = String -> Doc
text String
"{-# OVERLAPPING #-}"
    pretty Overlappable {}   = String -> Doc
text String
"{-# OVERLAPPABLE #-}"
    pretty NoOverlap {}  = String -> Doc
text String
"{-# NO_OVERLAP #-}"
    pretty Incoherent {} = String -> Doc
text String
"{-# INCOHERENT #-}"

instance  Pretty (RuleVar l) where
    pretty :: RuleVar l -> Doc
pretty (RuleVar l
_ Name l
n) = Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
n
    pretty (TypedRuleVar l
_ Name l
n Type l
t) = Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
mySep [Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
n, String -> Doc
text String
"::", Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
t]

-- Spaces are stripped from the pragma text but other whitespace
-- is not.
ppOptionsPragma :: Doc -> String -> Doc
ppOptionsPragma :: Doc -> String -> Doc
ppOptionsPragma Doc
opt String
s =
  case String
s of
    (Char
'\n':String
_) -> Doc
opt Doc -> Doc -> Doc
<> String -> Doc
text String
s Doc -> Doc -> Doc
<> String -> Doc
text String
"#-}"
    String
_ ->  [Doc] -> Doc
myFsep [Doc
opt, String -> Doc
text String
s Doc -> Doc -> Doc
<> String -> Doc
text String
"#-}"]

instance  Pretty (ModulePragma l) where
    pretty :: ModulePragma l -> Doc
pretty (LanguagePragma l
_ [Name l]
ns) =
        [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"{-# LANGUAGE" Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: Doc -> [Doc] -> [Doc]
punctuate (Char -> Doc
char Char
',') ((Name l -> Doc) -> [Name l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Name l -> Doc
forall a. Pretty a => a -> Doc
pretty [Name l]
ns) [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"#-}"]
    pretty (OptionsPragma l
_ (Just Tool
tool) String
s) =
        Doc -> String -> Doc
ppOptionsPragma (String -> Doc
text String
"{-# OPTIONS_" Doc -> Doc -> Doc
<> Tool -> Doc
forall a. Pretty a => a -> Doc
pretty Tool
tool) String
s
    pretty (OptionsPragma l
_ Maybe Tool
_ String
s) =
        Doc -> String -> Doc
ppOptionsPragma (String -> Doc
text String
"{-# OPTIONS") String
s
    pretty (AnnModulePragma l
_ Annotation l
mann) =
        [Doc] -> Doc
myFsep [String -> Doc
text String
"{-# ANN", Annotation l -> Doc
forall a. Pretty a => a -> Doc
pretty Annotation l
mann, String -> Doc
text String
"#-}"]


instance Pretty Tool where
    pretty :: Tool -> Doc
pretty (UnknownTool String
s) = String -> Doc
text String
s
    pretty Tool
t               = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Tool -> String
forall a. Show a => a -> String
show Tool
t

------------------------- Data & Newtype Bodies -------------------------
instance  Pretty (QualConDecl l) where
        pretty :: QualConDecl l -> Doc
pretty (QualConDecl l
_pos Maybe [TyVarBind l]
tvs Maybe (Context l)
ctxt ConDecl l
con) =
                [Doc] -> Doc
myFsep [Maybe [TyVarBind l] -> Doc
forall l. Maybe [TyVarBind l] -> Doc
ppForall Maybe [TyVarBind l]
tvs, (Context l -> Doc) -> Maybe (Context l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP Context l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (Context l)
ctxt, ConDecl l -> Doc
forall a. Pretty a => a -> Doc
pretty ConDecl l
con]

instance  Pretty (GadtDecl l) where
        pretty :: GadtDecl l -> Doc
pretty (GadtDecl l
_pos Name l
name Maybe [TyVarBind l]
tvs Maybe (Context l)
ctxt Maybe [FieldDecl l]
names Type l
ty) =
            case Maybe [FieldDecl l]
names of
                Maybe [FieldDecl l]
Nothing ->
                    [Doc] -> Doc
myFsep [Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
name, String -> Doc
text String
"::", Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
ty]
                Just [FieldDecl l]
ts' ->
                    [Doc] -> Doc
myFsep [Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
name, String -> Doc
text String
"::" , Maybe [TyVarBind l] -> Doc
forall l. Maybe [TyVarBind l] -> Doc
ppForall Maybe [TyVarBind l]
tvs, (Context l -> Doc) -> Maybe (Context l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP Context l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (Context l)
ctxt,
                         [Doc] -> Doc
braceList ([Doc] -> Doc) -> ([FieldDecl l] -> [Doc]) -> [FieldDecl l] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FieldDecl l -> Doc) -> [FieldDecl l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map FieldDecl l -> Doc
forall a. Pretty a => a -> Doc
pretty ([FieldDecl l] -> Doc) -> [FieldDecl l] -> Doc
forall a b. (a -> b) -> a -> b
$ [FieldDecl l]
ts', String -> Doc
text String
"->", Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
ty]

instance  Pretty (ConDecl l) where
        pretty :: ConDecl l -> Doc
pretty (RecDecl l
_ Name l
name [FieldDecl l]
fieldList) =
                Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
name Doc -> Doc -> Doc
<> [Doc] -> Doc
braceList ((FieldDecl l -> Doc) -> [FieldDecl l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map FieldDecl l -> Doc
forall a. Pretty a => a -> Doc
pretty [FieldDecl l]
fieldList)

{-        pretty (ConDecl name@(Symbol _) [l, r]) =
                myFsep [prettyPrec prec_btype l, ppName name,
                        prettyPrec prec_btype r] -}
        pretty (ConDecl l
_ Name l
name [Type l]
typeList) =
                [Doc] -> Doc
mySep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
name Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (Type l -> Doc) -> [Type l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Indent -> Type l -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
prec_atype) [Type l]
typeList
        pretty (InfixConDecl l
_ Type l
l Name l
name Type l
r) =
                [Doc] -> Doc
myFsep [Indent -> Type l -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
prec_btype Type l
l, Name l -> Doc
forall l. Name l -> Doc
ppNameInfix Name l
name,
                         Indent -> Type l -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
prec_btype Type l
r]


instance Pretty (FieldDecl l) where
  pretty :: FieldDecl l -> Doc
pretty (FieldDecl l
_ [Name l]
names Type l
ty) =
        [Doc] -> Doc
myFsepSimple ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> ([Name l] -> [Doc]) -> [Name l] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name l -> Doc) -> [Name l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Name l -> Doc
forall a. Pretty a => a -> Doc
pretty ([Name l] -> [Doc]) -> [Name l] -> [Doc]
forall a b. (a -> b) -> a -> b
$ [Name l]
names) [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++
                       [String -> Doc
text String
"::", Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
ty]

instance  Pretty (BangType l) where
        pretty :: BangType l -> Doc
pretty BangedTy {}  = Char -> Doc
char Char
'!'
        pretty LazyTy {}    = Char -> Doc
char Char
'~'
        pretty NoStrictAnnot {} = Doc
empty

instance Pretty (Unpackedness l) where
        pretty :: Unpackedness l -> Doc
pretty Unpack {}  = String -> Doc
text String
"{-# UNPACK #-} "
        pretty NoUnpack {} = String -> Doc
text String
"{-# NOUNPACK #-} "
        pretty NoUnpackPragma {} = Doc
empty

instance Pretty (Deriving l) where
  pretty :: Deriving l -> Doc
pretty (Deriving l
_ Maybe (DerivStrategy l)
mds [InstRule l]
d) =
    [Doc] -> Doc
hsep [ String -> Doc
text String
"deriving"
         , Doc
pp_strat_before
         , Doc
pp_dct
         , Doc
pp_strat_after ]
    where
      pp_dct :: Doc
pp_dct =
        case [InstRule l]
d of
          [InstRule l
d'] -> InstRule l -> Doc
forall a. Pretty a => a -> Doc
pretty InstRule l
d'
          [InstRule l]
_    -> [Doc] -> Doc
parenList ((InstRule l -> Doc) -> [InstRule l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map InstRule l -> Doc
forall a. Pretty a => a -> Doc
pretty [InstRule l]
d)

      -- @via@ is unique in that in comes /after/ the class being derived,
      -- so we must special-case it.
      (Doc
pp_strat_before, Doc
pp_strat_after) =
        case Maybe (DerivStrategy l)
mds of
          Just (via :: DerivStrategy l
via@DerivVia{}) -> (Doc
empty, DerivStrategy l -> Doc
forall a. Pretty a => a -> Doc
pretty DerivStrategy l
via)
          Maybe (DerivStrategy l)
_                     -> ((DerivStrategy l -> Doc) -> Maybe (DerivStrategy l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP DerivStrategy l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (DerivStrategy l)
mds, Doc
empty)

instance Pretty (DerivStrategy l) where
  pretty :: DerivStrategy l -> Doc
pretty DerivStrategy l
ds =
    case DerivStrategy l
ds of
      DerivStock l
_    -> String -> Doc
text String
"stock"
      DerivAnyclass l
_ -> String -> Doc
text String
"anyclass"
      DerivNewtype l
_  -> String -> Doc
text String
"newtype"
      DerivVia l
_ Type l
ty   -> String -> Doc
text String
"via" Doc -> Doc -> Doc
<+> Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
ty

------------------------- Types -------------------------
ppBType :: Type l -> Doc
ppBType :: Type l -> Doc
ppBType = Indent -> Type l -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
prec_btype

ppAType :: Type l -> Doc
ppAType :: Type l -> Doc
ppAType = Indent -> Type l -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
prec_atype

-- precedences for types
prec_btype, prec_atype :: Int
prec_btype :: Indent
prec_btype = Indent
1  -- left argument of ->,
                -- or either argument of an infix data constructor
prec_atype :: Indent
prec_atype = Indent
2  -- argument of type or data constructor, or of a class

instance  Pretty (Type l) where
        prettyPrec :: Indent -> Type l -> Doc
prettyPrec Indent
p (TyForall l
_ Maybe [TyVarBind l]
mtvs Maybe (Context l)
ctxt Type l
htype) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
0) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
                [Doc] -> Doc
myFsep [Maybe [TyVarBind l] -> Doc
forall l. Maybe [TyVarBind l] -> Doc
ppForall Maybe [TyVarBind l]
mtvs, (Context l -> Doc) -> Maybe (Context l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP Context l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (Context l)
ctxt, Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
htype]
        prettyPrec Indent
_ (TyStar l
_) = String -> Doc
text String
"*"
        prettyPrec Indent
p (TyFun l
_ Type l
a Type l
b) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
0) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
                [Doc] -> Doc
myFsep [Type l -> Doc
forall l. Type l -> Doc
ppBType Type l
a, String -> Doc
text String
"->", Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
b]
        prettyPrec Indent
_ (TyTuple l
_ Boxed
bxd [Type l]
l) =
                let ds :: [Doc]
ds = (Type l -> Doc) -> [Type l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Type l -> Doc
forall a. Pretty a => a -> Doc
pretty [Type l]
l
                 in case Boxed
bxd of
                        Boxed
Boxed   -> [Doc] -> Doc
parenList [Doc]
ds
                        Boxed
Unboxed -> [Doc] -> Doc
hashParenList [Doc]
ds
        prettyPrec Indent
_ (TyUnboxedSum l
_ [Type l]
es) = [Doc] -> Doc
unboxedSumType ((Type l -> Doc) -> [Type l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Type l -> Doc
forall a. Pretty a => a -> Doc
pretty [Type l]
es)

        prettyPrec Indent
_ (TyList l
_ Type l
t)  = Doc -> Doc
brackets (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
t
        prettyPrec Indent
_ (TyParArray l
_ Type l
t) = [Doc] -> Doc
bracketColonList [Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
t]
        prettyPrec Indent
p (TyApp l
_ Type l
a Type l
b) =
                {-
                | a == list_tycon = brackets $ pretty b         -- special case
                | otherwise = -} Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
prec_btype) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
                                    [Doc] -> Doc
myFsep [Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
a, Type l -> Doc
forall l. Type l -> Doc
ppAType Type l
b]
        prettyPrec Indent
_ (TyVar l
_ Name l
name) = Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
name
        prettyPrec Indent
_ (TyCon l
_ QName l
name) = QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
name
        prettyPrec Indent
_ (TyParen l
_ Type l
t) = Doc -> Doc
parens (Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
t)
        prettyPrec Indent
_ (TyInfix l
_ Type l
a MaybePromotedName l
op Type l
b) = [Doc] -> Doc
myFsep [Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
a, MaybePromotedName l -> Doc
forall a. Pretty a => a -> Doc
pretty MaybePromotedName l
op, Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
b]
        prettyPrec Indent
_ (TyKind l
_ Type l
t Type l
k) = Doc -> Doc
parens ([Doc] -> Doc
myFsep [Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
t, String -> Doc
text String
"::", Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
k])
        prettyPrec Indent
_ (TyPromoted l
_ Promoted l
p) = Promoted l -> Doc
forall a. Pretty a => a -> Doc
pretty Promoted l
p
        prettyPrec Indent
p (TyEquals l
_ Type l
a Type l
b) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
0) ([Doc] -> Doc
myFsep [Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
a, String -> Doc
text String
"~", Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
b])
        prettyPrec Indent
_ (TySplice l
_ Splice l
s) = Splice l -> Doc
forall a. Pretty a => a -> Doc
pretty Splice l
s
        prettyPrec Indent
_ (TyBang l
_ BangType l
b Unpackedness l
u Type l
t) = Unpackedness l -> Doc
forall a. Pretty a => a -> Doc
pretty Unpackedness l
u Doc -> Doc -> Doc
<> BangType l -> Doc
forall a. Pretty a => a -> Doc
pretty BangType l
b Doc -> Doc -> Doc
<> Indent -> Type l -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
prec_atype Type l
t
        prettyPrec Indent
_ (TyWildCard l
_ Maybe (Name l)
mn) = Char -> Doc
char Char
'_' Doc -> Doc -> Doc
<> (Name l -> Doc) -> Maybe (Name l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (Name l)
mn
        prettyPrec Indent
_ (TyQuasiQuote l
_ String
n String
qt) = String -> Doc
text (String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"|" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
qt String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"|]")

instance Pretty (MaybePromotedName l) where
  pretty :: MaybePromotedName l -> Doc
pretty (PromotedName l
_ QName l
q) = Char -> Doc
char Char
'\'' Doc -> Doc -> Doc
<> QName l -> Doc
forall l. QName l -> Doc
ppQNameInfix QName l
q
  pretty (UnpromotedName l
_ QName l
q) = QName l -> Doc
forall l. QName l -> Doc
ppQNameInfix QName l
q


instance  Pretty (Promoted l) where
  pretty :: Promoted l -> Doc
pretty Promoted l
p =
    case Promoted l
p of
      PromotedInteger l
_ Integer
n String
_ -> Integer -> Doc
integer Integer
n
      PromotedString l
_ String
s String
_ -> Doc -> Doc
doubleQuotes (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
s
      PromotedCon l
_ Bool
hasQuote QName l
qn ->
        Bool -> Doc -> Doc
addQuote Bool
hasQuote (QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
qn)
      PromotedList l
_ Bool
hasQuote [Type l]
list ->
        Bool -> Doc -> Doc
addQuote Bool
hasQuote (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
bracketList ([Doc] -> Doc) -> ([Type l] -> [Doc]) -> [Type l] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> ([Type l] -> [Doc]) -> [Type l] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Type l -> Doc) -> [Type l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Type l -> Doc
forall a. Pretty a => a -> Doc
pretty ([Type l] -> Doc) -> [Type l] -> Doc
forall a b. (a -> b) -> a -> b
$ [Type l]
list
      PromotedTuple l
_ [Type l]
list ->
        Bool -> Doc -> Doc
addQuote Bool
True (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
parenList ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Type l -> Doc) -> [Type l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Type l -> Doc
forall a. Pretty a => a -> Doc
pretty [Type l]
list
      PromotedUnit {} -> Bool -> Doc -> Doc
addQuote Bool
True (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"()"
    where
      addQuote :: Bool -> Doc -> Doc
addQuote Bool
True Doc
doc = Char -> Doc
char Char
'\'' Doc -> Doc -> Doc
<> Doc
doc
      addQuote Bool
False Doc
doc = Doc
doc

instance  Pretty (TyVarBind l) where
        pretty :: TyVarBind l -> Doc
pretty (KindedVar l
_ Name l
var Kind l
kind) = Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
myFsep [Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
var, String -> Doc
text String
"::", Kind l -> Doc
forall a. Pretty a => a -> Doc
pretty Kind l
kind]
        pretty (UnkindedVar l
_ Name l
var)    = Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
var

ppForall :: Maybe [TyVarBind l] -> Doc
ppForall :: Maybe [TyVarBind l] -> Doc
ppForall Maybe [TyVarBind l]
Nothing   = Doc
empty
ppForall (Just []) = Doc
empty
ppForall (Just [TyVarBind l]
vs) =    [Doc] -> Doc
myFsep (String -> Doc
text String
"forall" Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (TyVarBind l -> Doc) -> [TyVarBind l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map TyVarBind l -> Doc
forall a. Pretty a => a -> Doc
pretty [TyVarBind l]
vs [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Char -> Doc
char Char
'.'])

---------------------------- Kinds ----------------------------

ppOptKind :: Maybe (Kind l) -> [Doc]
ppOptKind :: Maybe (Kind l) -> [Doc]
ppOptKind Maybe (Kind l)
Nothing  = []
ppOptKind (Just Kind l
k) = [String -> Doc
text String
"::", Kind l -> Doc
forall a. Pretty a => a -> Doc
pretty Kind l
k]

------------------- Functional Dependencies -------------------
instance  Pretty (FunDep l) where
        pretty :: FunDep l -> Doc
pretty (FunDep l
_ [Name l]
from [Name l]
to) =
                [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Name l -> Doc) -> [Name l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Name l -> Doc
forall a. Pretty a => a -> Doc
pretty [Name l]
from [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"->"] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ (Name l -> Doc) -> [Name l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Name l -> Doc
forall a. Pretty a => a -> Doc
pretty [Name l]
to


ppFunDeps :: [FunDep l] -> Doc
ppFunDeps :: [FunDep l] -> Doc
ppFunDeps []  = Doc
empty
ppFunDeps [FunDep l]
fds = [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Char -> Doc
char Char
'|'Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:) ([Doc] -> [Doc]) -> ([FunDep l] -> [Doc]) -> [FunDep l] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> ([FunDep l] -> [Doc]) -> [FunDep l] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FunDep l -> Doc) -> [FunDep l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map FunDep l -> Doc
forall a. Pretty a => a -> Doc
pretty ([FunDep l] -> [Doc]) -> [FunDep l] -> [Doc]
forall a b. (a -> b) -> a -> b
$ [FunDep l]
fds

------------------------- Expressions -------------------------
instance  Pretty (Rhs l) where
        pretty :: Rhs l -> Doc
pretty (UnGuardedRhs l
_ Exp l
e) = Doc
equals Doc -> Doc -> Doc
<+> Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e
        pretty (GuardedRhss l
_ [GuardedRhs l]
guardList) = [Doc] -> Doc
myVcat ([Doc] -> Doc)
-> ([GuardedRhs l] -> [Doc]) -> [GuardedRhs l] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GuardedRhs l -> Doc) -> [GuardedRhs l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map GuardedRhs l -> Doc
forall a. Pretty a => a -> Doc
pretty ([GuardedRhs l] -> Doc) -> [GuardedRhs l] -> Doc
forall a b. (a -> b) -> a -> b
$ [GuardedRhs l]
guardList

instance  Pretty (GuardedRhs l) where
        pretty :: GuardedRhs l -> Doc
pretty (GuardedRhs l
_pos [Stmt l]
guards Exp l
ppBody') =
                [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [Char -> Doc
char Char
'|'] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> ([Stmt l] -> [Doc]) -> [Stmt l] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stmt l -> Doc) -> [Stmt l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Stmt l -> Doc
forall a. Pretty a => a -> Doc
pretty ([Stmt l] -> [Doc]) -> [Stmt l] -> [Doc]
forall a b. (a -> b) -> a -> b
$ [Stmt l]
guards) [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc
equals, Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
ppBody']

newtype GuardedAlts l = GuardedAlts (Rhs l)
newtype GuardedAlt l = GuardedAlt (GuardedRhs l)

instance  Pretty (GuardedAlts l) where
        pretty :: GuardedAlts l -> Doc
pretty (GuardedAlts (UnGuardedRhs l
_ Exp l
e)) = String -> Doc
text String
"->" Doc -> Doc -> Doc
<+> Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e
        pretty (GuardedAlts (GuardedRhss l
_ [GuardedRhs l]
guardList)) = [Doc] -> Doc
myVcat ([Doc] -> Doc)
-> ([GuardedRhs l] -> [Doc]) -> [GuardedRhs l] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GuardedRhs l -> Doc) -> [GuardedRhs l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (GuardedAlt l -> Doc
forall a. Pretty a => a -> Doc
pretty (GuardedAlt l -> Doc)
-> (GuardedRhs l -> GuardedAlt l) -> GuardedRhs l -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GuardedRhs l -> GuardedAlt l
forall l. GuardedRhs l -> GuardedAlt l
GuardedAlt) ([GuardedRhs l] -> Doc) -> [GuardedRhs l] -> Doc
forall a b. (a -> b) -> a -> b
$ [GuardedRhs l]
guardList

instance  Pretty (GuardedAlt l) where
        pretty :: GuardedAlt l -> Doc
pretty (GuardedAlt (GuardedRhs l
_pos [Stmt l]
guards Exp l
ppBody')) =
                [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [Char -> Doc
char Char
'|'] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> ([Stmt l] -> [Doc]) -> [Stmt l] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stmt l -> Doc) -> [Stmt l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Stmt l -> Doc
forall a. Pretty a => a -> Doc
pretty ([Stmt l] -> [Doc]) -> [Stmt l] -> [Doc]
forall a b. (a -> b) -> a -> b
$ [Stmt l]
guards) [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"->", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
ppBody']

instance  Pretty (Literal l) where
        pretty :: Literal l -> Doc
pretty (Int l
_ Integer
i String
_)        = Integer -> Doc
integer Integer
i
        pretty (Char l
_ Char
c String
_)       = String -> Doc
text (Char -> String
forall a. Show a => a -> String
show Char
c)
        pretty (String l
_ String
s String
_)     = String -> Doc
text (String -> String
forall a. Show a => a -> String
show String
s)
        pretty (Frac l
_ Rational
r String
_)       = Double -> Doc
double (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
r)
        -- GHC unboxed literals:
        pretty (PrimChar l
_ Char
c String
_)   = String -> Doc
text (Char -> String
forall a. Show a => a -> String
show Char
c)           Doc -> Doc -> Doc
<> Char -> Doc
char Char
'#'
        pretty (PrimString l
_ String
s String
_) = String -> Doc
text (String -> String
forall a. Show a => a -> String
show String
s)           Doc -> Doc -> Doc
<> Char -> Doc
char Char
'#'
        pretty (PrimInt l
_ Integer
i String
_)    = Integer -> Doc
integer Integer
i               Doc -> Doc -> Doc
<> Char -> Doc
char Char
'#'
        pretty (PrimWord l
_ Integer
w String
_)   = Integer -> Doc
integer Integer
w               Doc -> Doc -> Doc
<> String -> Doc
text String
"##"
        pretty (PrimFloat l
_ Rational
r String
_)  = Float -> Doc
float  (Rational -> Float
forall a. Fractional a => Rational -> a
fromRational Rational
r) Doc -> Doc -> Doc
<> Char -> Doc
char Char
'#'
        pretty (PrimDouble l
_ Rational
r String
_) = Double -> Doc
double (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
r) Doc -> Doc -> Doc
<> String -> Doc
text String
"##"

instance  Pretty (Exp l) where
        prettyPrec :: Indent -> Exp l -> Doc
prettyPrec Indent
_ (Lit l
_ Literal l
l) = Literal l -> Doc
forall a. Pretty a => a -> Doc
pretty Literal l
l
        -- lambda stuff
        -- WARNING: This stuff is fragile. See #152 for one example of how
        -- things can break.
        prettyPrec Indent
p (InfixApp l
_ Exp l
a QOp l
op Exp l
b) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
2) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
myFsep [Indent -> Exp l -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
1 Exp l
a, QOp l -> Doc
forall a. Pretty a => a -> Doc
pretty QOp l
op, Indent -> Exp l -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
1 Exp l
b]
        prettyPrec Indent
p (NegApp l
_ Exp l
e) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
0) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Char -> Doc
char Char
'-' Doc -> Doc -> Doc
<> Indent -> Exp l -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
2 Exp l
e
        prettyPrec Indent
p (App l
_ Exp l
a Exp l
b) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
3) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
myFsep [Indent -> Exp l -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
3 Exp l
a, Indent -> Exp l -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
4 Exp l
b]
        prettyPrec Indent
p (Lambda l
_loc [Pat l]
patList Exp l
ppBody') = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
1) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
                Char -> Doc
char Char
'\\' Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (Pat l -> Doc) -> [Pat l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Indent -> Pat l -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
3) [Pat l]
patList [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"->", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
ppBody']
        -- keywords
        -- two cases for lets
        prettyPrec Indent
p (Let l
_ (BDecls l
_ [Decl l]
declList) Exp l
letBody) =
                Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
1) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Decl l] -> Exp l -> Doc
forall a b. (PrettyDeclLike a, Pretty b) => [a] -> b -> Doc
ppLetExp [Decl l]
declList Exp l
letBody
        prettyPrec Indent
p (Let l
_ (IPBinds l
_ [IPBind l]
bindList) Exp l
letBody) =
                Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
1) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [IPBind l] -> Exp l -> Doc
forall a b. (PrettyDeclLike a, Pretty b) => [a] -> b -> Doc
ppLetExp [IPBind l]
bindList Exp l
letBody

        prettyPrec Indent
p (If l
_ Exp l
cond Exp l
thenexp Exp l
elsexp) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
1) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
                [Doc] -> Doc
myFsep [String -> Doc
text String
"if", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
cond,
                        String -> Doc
text String
"then", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
thenexp,
                        String -> Doc
text String
"else", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
elsexp]
        prettyPrec Indent
p (MultiIf l
_ [GuardedRhs l]
alts) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
1) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
                String -> Doc
text String
"if"
                Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
multiIfIndent ((GuardedRhs l -> Doc) -> [GuardedRhs l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (GuardedAlt l -> Doc
forall a. Pretty a => a -> Doc
pretty (GuardedAlt l -> Doc)
-> (GuardedRhs l -> GuardedAlt l) -> GuardedRhs l -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GuardedRhs l -> GuardedAlt l
forall l. GuardedRhs l -> GuardedAlt l
GuardedAlt) [GuardedRhs l]
alts)
        prettyPrec Indent
p (Case l
_ Exp l
cond [Alt l]
altList) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
1) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
                [Doc] -> Doc
myFsep ([String -> Doc
text String
"case", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
cond, String -> Doc
text String
"of"] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++
                       if [Alt l] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Alt l]
altList then [String -> Doc
text String
"{", String -> Doc
text String
"}"] else [])
                Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
caseIndent ((Alt l -> Doc) -> [Alt l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Alt l -> Doc
forall a. Pretty a => a -> Doc
pretty [Alt l]
altList)
        prettyPrec Indent
p (Do l
_ [Stmt l]
stmtList) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
1) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
                String -> Doc
text String
"do" Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
doIndent ((Stmt l -> Doc) -> [Stmt l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Stmt l -> Doc
forall a. Pretty a => a -> Doc
pretty [Stmt l]
stmtList)
        prettyPrec Indent
p (MDo l
_ [Stmt l]
stmtList) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
1) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
                String -> Doc
text String
"mdo" Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
doIndent ((Stmt l -> Doc) -> [Stmt l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Stmt l -> Doc
forall a. Pretty a => a -> Doc
pretty [Stmt l]
stmtList)
        -- Constructors & Vars
        prettyPrec Indent
_ (Var l
_ QName l
name) = QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
name
        prettyPrec Indent
_ (OverloadedLabel l
_ String
name) = String -> Doc
text (Char
'#'Char -> String -> String
forall a. a -> [a] -> [a]
:String
name)
        prettyPrec Indent
_ (IPVar l
_ IPName l
ipname) = IPName l -> Doc
forall a. Pretty a => a -> Doc
pretty IPName l
ipname
        prettyPrec Indent
_ (Con l
_ QName l
name) = QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
name
        prettyPrec Indent
_ (Tuple l
_ Boxed
bxd [Exp l]
expList) =
                let ds :: [Doc]
ds = (Exp l -> Doc) -> [Exp l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty [Exp l]
expList
                in case Boxed
bxd of
                       Boxed
Boxed   -> [Doc] -> Doc
parenList [Doc]
ds
                       Boxed
Unboxed -> [Doc] -> Doc
hashParenList [Doc]
ds
        prettyPrec Indent
_ (UnboxedSum l
_ Indent
before Indent
after Exp l
exp) =
          Indent -> Indent -> Exp l -> Doc
forall e. Pretty e => Indent -> Indent -> e -> Doc
printUnboxedSum Indent
before Indent
after Exp l
exp
        prettyPrec Indent
_ (TupleSection l
_ Boxed
bxd [Maybe (Exp l)]
mExpList) =
                let ds :: [Doc]
ds = (Maybe (Exp l) -> Doc) -> [Maybe (Exp l)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((Exp l -> Doc) -> Maybe (Exp l) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty) [Maybe (Exp l)]
mExpList
                in case Boxed
bxd of
                       Boxed
Boxed   -> [Doc] -> Doc
parenList [Doc]
ds
                       Boxed
Unboxed -> [Doc] -> Doc
hashParenList [Doc]
ds
        -- weird stuff
        prettyPrec Indent
_ (Paren l
_ Exp l
e) = Doc -> Doc
parens (Doc -> Doc) -> (Exp l -> Doc) -> Exp l -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty (Exp l -> Doc) -> Exp l -> Doc
forall a b. (a -> b) -> a -> b
$ Exp l
e
        prettyPrec Indent
_ (LeftSection l
_ Exp l
e QOp l
op) = Doc -> Doc
parens (Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e Doc -> Doc -> Doc
<+> QOp l -> Doc
forall a. Pretty a => a -> Doc
pretty QOp l
op)
        prettyPrec Indent
_ (RightSection l
_ QOp l
op Exp l
e) = Doc -> Doc
parens (QOp l -> Doc
forall a. Pretty a => a -> Doc
pretty QOp l
op Doc -> Doc -> Doc
<+> Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e)
        prettyPrec Indent
_ (RecConstr l
_ QName l
c [FieldUpdate l]
fieldList) =
                QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
c Doc -> Doc -> Doc
<> ([Doc] -> Doc
braceList ([Doc] -> Doc)
-> ([FieldUpdate l] -> [Doc]) -> [FieldUpdate l] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FieldUpdate l -> Doc) -> [FieldUpdate l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map FieldUpdate l -> Doc
forall a. Pretty a => a -> Doc
pretty ([FieldUpdate l] -> Doc) -> [FieldUpdate l] -> Doc
forall a b. (a -> b) -> a -> b
$ [FieldUpdate l]
fieldList)
        prettyPrec Indent
_ (RecUpdate l
_ Exp l
e [FieldUpdate l]
fieldList) =
                Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e Doc -> Doc -> Doc
<> ([Doc] -> Doc
braceList ([Doc] -> Doc)
-> ([FieldUpdate l] -> [Doc]) -> [FieldUpdate l] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FieldUpdate l -> Doc) -> [FieldUpdate l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map FieldUpdate l -> Doc
forall a. Pretty a => a -> Doc
pretty ([FieldUpdate l] -> Doc) -> [FieldUpdate l] -> Doc
forall a b. (a -> b) -> a -> b
$ [FieldUpdate l]
fieldList)
        -- Lists and parallel arrays
        prettyPrec Indent
_ (List l
_ [Exp l]
list) =
                [Doc] -> Doc
bracketList ([Doc] -> Doc) -> ([Exp l] -> [Doc]) -> [Exp l] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> ([Exp l] -> [Doc]) -> [Exp l] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Exp l -> Doc) -> [Exp l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty ([Exp l] -> Doc) -> [Exp l] -> Doc
forall a b. (a -> b) -> a -> b
$ [Exp l]
list
        prettyPrec Indent
_ (ParArray l
_ [Exp l]
arr) =
                [Doc] -> Doc
bracketColonList ([Doc] -> Doc) -> ([Exp l] -> [Doc]) -> [Exp l] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Exp l -> Doc) -> [Exp l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty ([Exp l] -> Doc) -> [Exp l] -> Doc
forall a b. (a -> b) -> a -> b
$ [Exp l]
arr
        prettyPrec Indent
_ (EnumFrom l
_ Exp l
e) =
                [Doc] -> Doc
bracketList [Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e, String -> Doc
text String
".."]
        prettyPrec Indent
_ (EnumFromTo l
_ Exp l
from Exp l
to) =
                [Doc] -> Doc
bracketList [Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
from, String -> Doc
text String
"..", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
to]
        prettyPrec Indent
_ (EnumFromThen l
_ Exp l
from Exp l
thenE) =
                [Doc] -> Doc
bracketList [Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
from Doc -> Doc -> Doc
<> Doc
comma, Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
thenE, String -> Doc
text String
".."]
        prettyPrec Indent
_ (EnumFromThenTo l
_ Exp l
from Exp l
thenE Exp l
to) =
                [Doc] -> Doc
bracketList [Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
from Doc -> Doc -> Doc
<> Doc
comma, Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
thenE,
                             String -> Doc
text String
"..", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
to]
        prettyPrec Indent
_ (ParArrayFromTo l
_ Exp l
from Exp l
to) =
                [Doc] -> Doc
bracketColonList [Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
from, String -> Doc
text String
"..", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
to]
        prettyPrec Indent
_ (ParArrayFromThenTo l
_ Exp l
from Exp l
thenE Exp l
to) =
                [Doc] -> Doc
bracketColonList [Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
from Doc -> Doc -> Doc
<> Doc
comma, Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
thenE,
                             String -> Doc
text String
"..", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
to]
        prettyPrec Indent
_ (ListComp l
_ Exp l
e [QualStmt l]
qualList) =
                [Doc] -> Doc
bracketList ([Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e, Char -> Doc
char Char
'|']
                             [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc])
-> ([QualStmt l] -> [Doc]) -> [QualStmt l] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QualStmt l -> Doc) -> [QualStmt l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map QualStmt l -> Doc
forall a. Pretty a => a -> Doc
pretty ([QualStmt l] -> [Doc]) -> [QualStmt l] -> [Doc]
forall a b. (a -> b) -> a -> b
$ [QualStmt l]
qualList))
        prettyPrec Indent
_ (ParComp l
_ Exp l
e [[QualStmt l]]
qualLists) =
                [Doc] -> Doc
bracketList (Doc -> [Doc] -> [Doc]
punctuate (Char -> Doc
char Char
'|') ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$
                                Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: ([QualStmt l] -> Doc) -> [[QualStmt l]] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ([Doc] -> Doc
hsep ([Doc] -> Doc) -> ([QualStmt l] -> [Doc]) -> [QualStmt l] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc])
-> ([QualStmt l] -> [Doc]) -> [QualStmt l] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QualStmt l -> Doc) -> [QualStmt l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map QualStmt l -> Doc
forall a. Pretty a => a -> Doc
pretty) [[QualStmt l]]
qualLists)
        prettyPrec Indent
_ (ParArrayComp l
_ Exp l
e [[QualStmt l]]
qualArrs) =
                [Doc] -> Doc
bracketColonList (Doc -> [Doc] -> [Doc]
punctuate (Char -> Doc
char Char
'|') ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$
                                Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: ([QualStmt l] -> Doc) -> [[QualStmt l]] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ([Doc] -> Doc
hsep ([Doc] -> Doc) -> ([QualStmt l] -> [Doc]) -> [QualStmt l] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc])
-> ([QualStmt l] -> [Doc]) -> [QualStmt l] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QualStmt l -> Doc) -> [QualStmt l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map QualStmt l -> Doc
forall a. Pretty a => a -> Doc
pretty) [[QualStmt l]]
qualArrs)
        prettyPrec Indent
p (ExpTypeSig l
_pos Exp l
e Type l
ty) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
0) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
                [Doc] -> Doc
myFsep [Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e, String -> Doc
text String
"::", Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
ty]
        -- Template Haskell
        prettyPrec Indent
_ (BracketExp l
_ Bracket l
b) = Bracket l -> Doc
forall a. Pretty a => a -> Doc
pretty Bracket l
b
        prettyPrec Indent
_ (SpliceExp l
_ Splice l
s) = Splice l -> Doc
forall a. Pretty a => a -> Doc
pretty Splice l
s
        prettyPrec Indent
_ (TypQuote l
_ QName l
t)  = String -> Doc
text String
"\'\'" Doc -> Doc -> Doc
<> QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
t
        prettyPrec Indent
_ (VarQuote l
_ QName l
x)  = String -> Doc
text String
"\'" Doc -> Doc -> Doc
<> QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
x
        prettyPrec Indent
_ (QuasiQuote l
_ String
n String
qt) = String -> Doc
text (String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"|" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
qt String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"|]")
        -- Hsx
        prettyPrec Indent
_ (XTag l
_ XName l
n [XAttr l]
attrs Maybe (Exp l)
mattr [Exp l]
cs) =
                let ax :: [Doc]
ax = [Doc] -> (Exp l -> [Doc]) -> Maybe (Exp l) -> [Doc]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Doc -> [Doc]
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> [Doc]) -> (Exp l -> Doc) -> Exp l -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty) Maybe (Exp l)
mattr
                 in [Doc] -> Doc
hcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
                     ([Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Char -> Doc
char Char
'<' Doc -> Doc -> Doc
<> XName l -> Doc
forall a. Pretty a => a -> Doc
pretty XName l
n)Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (XAttr l -> Doc) -> [XAttr l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map XAttr l -> Doc
forall a. Pretty a => a -> Doc
pretty [XAttr l]
attrs [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc]
ax [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Char -> Doc
char Char
'>'])Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:
                        (Exp l -> Doc) -> [Exp l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty [Exp l]
cs [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [[Doc] -> Doc
myFsep [String -> Doc
text String
"</" Doc -> Doc -> Doc
<> XName l -> Doc
forall a. Pretty a => a -> Doc
pretty XName l
n, Char -> Doc
char Char
'>']]
        prettyPrec Indent
_ (XETag l
_ XName l
n [XAttr l]
attrs Maybe (Exp l)
mattr) =
                let ax :: [Doc]
ax = [Doc] -> (Exp l -> [Doc]) -> Maybe (Exp l) -> [Doc]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Doc -> [Doc]
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> [Doc]) -> (Exp l -> Doc) -> Exp l -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty) Maybe (Exp l)
mattr
                 in [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Char -> Doc
char Char
'<' Doc -> Doc -> Doc
<> XName l -> Doc
forall a. Pretty a => a -> Doc
pretty XName l
n)Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (XAttr l -> Doc) -> [XAttr l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map XAttr l -> Doc
forall a. Pretty a => a -> Doc
pretty [XAttr l]
attrs [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc]
ax [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"/>"]
        prettyPrec Indent
_ (XPcdata l
_ String
s) = String -> Doc
text String
s
        prettyPrec Indent
_ (XExpTag l
_ Exp l
e) =
                [Doc] -> Doc
myFsep [String -> Doc
text String
"<%", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e, String -> Doc
text String
"%>"]
        prettyPrec Indent
_ (XChildTag l
_ [Exp l]
cs) =
                [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"<%>" Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (Exp l -> Doc) -> [Exp l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty [Exp l]
cs [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"</%>"]

        -- Pragmas
        prettyPrec Indent
_ (CorePragma l
_ String
s Exp l
e) = [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text [String
"{-# CORE", String -> String
forall a. Show a => a -> String
show String
s, String
"#-}"] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e]
        prettyPrec Indent
_ (SCCPragma  l
_ String
s Exp l
e) = [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text [String
"{-# SCC",  String -> String
forall a. Show a => a -> String
show String
s, String
"#-}"] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e]
        prettyPrec Indent
_ (GenPragma  l
_ String
s (Indent
a,Indent
b) (Indent
c,Indent
d) Exp l
e) =
                [Doc] -> Doc
myFsep [String -> Doc
text String
"{-# GENERATED", String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. Show a => a -> String
show String
s,
                            Indent -> Doc
int Indent
a, Char -> Doc
char Char
':', Indent -> Doc
int Indent
b, Char -> Doc
char Char
'-',
                            Indent -> Doc
int Indent
c, Char -> Doc
char Char
':', Indent -> Doc
int Indent
d, String -> Doc
text String
"#-}", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e]
        -- Arrows
        prettyPrec Indent
p (Proc l
_ Pat l
pat Exp l
e) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
1) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
myFsep [String -> Doc
text String
"proc", Pat l -> Doc
forall a. Pretty a => a -> Doc
pretty Pat l
pat, String -> Doc
text String
"->", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e]
        prettyPrec Indent
p (LeftArrApp l
_ Exp l
l Exp l
r)      = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
0) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
myFsep [Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
l, String -> Doc
text String
"-<",  Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
r]
        prettyPrec Indent
p (RightArrApp l
_ Exp l
l Exp l
r)     = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
0) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
myFsep [Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
l, String -> Doc
text String
">-",  Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
r]
        prettyPrec Indent
p (LeftArrHighApp l
_ Exp l
l Exp l
r)  = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
0) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
myFsep [Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
l, String -> Doc
text String
"-<<", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
r]
        prettyPrec Indent
p (RightArrHighApp l
_ Exp l
l Exp l
r) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
0) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
myFsep [Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
l, String -> Doc
text String
">>-", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
r]
        prettyPrec Indent
_ (ArrOp l
_ Exp l
e) = [Doc] -> Doc
myFsep [String -> Doc
text String
"(|", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e, String -> Doc
text String
"|)"]

        -- LamdaCase
        prettyPrec Indent
p (LCase l
_ [Alt l]
altList) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
1) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
                [Doc] -> Doc
myFsep (String -> Doc
text String
"\\case"Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:
                       if [Alt l] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Alt l]
altList then [String -> Doc
text String
"{", String -> Doc
text String
"}"] else [])
                Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
caseIndent ((Alt l -> Doc) -> [Alt l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Alt l -> Doc
forall a. Pretty a => a -> Doc
pretty [Alt l]
altList)
        prettyPrec Indent
_ (TypeApp l
_ Type l
ty)   = Char -> Doc
char Char
'@' Doc -> Doc -> Doc
<> Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
ty

printUnboxedSum :: Pretty e => Int -> Int -> e -> Doc
printUnboxedSum :: Indent -> Indent -> e -> Doc
printUnboxedSum Indent
before Indent
after e
exp =
          Doc -> Doc
hashParens (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Indent -> Doc -> [Doc]
forall a. Indent -> a -> [a]
replicate Indent
before (String -> Doc
text String
"|")
                                [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [e -> Doc
forall a. Pretty a => a -> Doc
pretty e
exp]
                                [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ (Indent -> Doc -> [Doc]
forall a. Indent -> a -> [a]
replicate Indent
after (String -> Doc
text String
"|")))


instance  Pretty (XAttr l) where
        pretty :: XAttr l -> Doc
pretty (XAttr l
_ XName l
n Exp l
v) =
                [Doc] -> Doc
myFsep [XName l -> Doc
forall a. Pretty a => a -> Doc
pretty XName l
n, Char -> Doc
char Char
'=', Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
v]

instance  Pretty (XName l) where
        pretty :: XName l -> Doc
pretty (XName l
_ String
n) = String -> Doc
text String
n
        pretty (XDomName l
_ String
d String
n) = String -> Doc
text String
d Doc -> Doc -> Doc
<> Char -> Doc
char Char
':' Doc -> Doc -> Doc
<> String -> Doc
text String
n

ppLetExp :: (PrettyDeclLike a, Pretty b) => [a] -> b -> Doc
ppLetExp :: [a] -> b -> Doc
ppLetExp [a]
l b
b = [Doc] -> Doc
myFsep [String -> Doc
text String
"let" Doc -> Doc -> Doc
<+> (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
letIndent (Bool -> [a] -> [Doc]
forall a. PrettyDeclLike a => Bool -> [a] -> [Doc]
ppDecls Bool
False [a]
l),
                        String -> Doc
text String
"in", b -> Doc
forall a. Pretty a => a -> Doc
pretty b
b]

--------------------- Template Haskell -------------------------

instance  Pretty (Bracket l) where
        pretty :: Bracket l -> Doc
pretty (ExpBracket l
_ Exp l
e) = String -> Exp l -> Doc
forall a. Pretty a => String -> a -> Doc
ppBracket String
"[|" Exp l
e
        pretty (TExpBracket l
_ Exp l
e) = [Doc] -> Doc
myFsep [String -> Doc
text String
"[||", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e, String -> Doc
text String
"||]"]
        pretty (PatBracket l
_ Pat l
p) = String -> Pat l -> Doc
forall a. Pretty a => String -> a -> Doc
ppBracket String
"[p|" Pat l
p
        pretty (TypeBracket l
_ Type l
t) = String -> Type l -> Doc
forall a. Pretty a => String -> a -> Doc
ppBracket String
"[t|" Type l
t
        pretty (DeclBracket l
_ [Decl l]
d) =
                [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"[d|" Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: Bool -> [Decl l] -> [Doc]
forall a. PrettyDeclLike a => Bool -> [a] -> [Doc]
ppDecls Bool
True [Decl l]
d [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"|]"]

ppBracket :: Pretty a => String -> a -> Doc
ppBracket :: String -> a -> Doc
ppBracket String
o a
x = [Doc] -> Doc
myFsep [String -> Doc
text String
o, a -> Doc
forall a. Pretty a => a -> Doc
pretty a
x, String -> Doc
text String
"|]"]

instance  Pretty (Splice l) where
        pretty :: Splice l -> Doc
pretty (IdSplice l
_ String
s) = Char -> Doc
char Char
'$' Doc -> Doc -> Doc
<> String -> Doc
text String
s
        pretty (TIdSplice l
_ String
s) = Char -> Doc
char Char
'$' Doc -> Doc -> Doc
<> Char -> Doc
char Char
'$' Doc -> Doc -> Doc
<> String -> Doc
text String
s
        pretty (TParenSplice l
_ Exp l
e) =
                [Doc] -> Doc
myFsep [String -> Doc
text String
"$$(", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e, Char -> Doc
char Char
')']
        pretty (ParenSplice l
_ Exp l
e) =
                [Doc] -> Doc
myFsep [String -> Doc
text String
"$(", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e, Char -> Doc
char Char
')']

------------------------- Patterns -----------------------------

instance  Pretty (Pat l) where
        prettyPrec :: Indent -> Pat l -> Doc
prettyPrec Indent
_ (PVar l
_ Name l
name) = Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
name
        prettyPrec Indent
_ (PLit l
_ (Signless {}) Literal l
lit) = Literal l -> Doc
forall a. Pretty a => a -> Doc
pretty Literal l
lit
        prettyPrec Indent
p (PLit l
_ (Negative{}) Literal l
lit) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
1) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Char -> Doc
char Char
'-' Doc -> Doc -> Doc
<> Literal l -> Doc
forall a. Pretty a => a -> Doc
pretty Literal l
lit
        prettyPrec Indent
p (PInfixApp l
l Pat l
a QName l
op Pat l
b) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
0) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
                [Doc] -> Doc
myFsep [Indent -> Pat l -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
1 Pat l
a, QOp l -> Doc
forall a. Pretty a => a -> Doc
pretty (l -> QName l -> QOp l
forall l. l -> QName l -> QOp l
QConOp l
l QName l
op), Indent -> Pat l -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
1 Pat l
b]
        prettyPrec Indent
p (PApp l
_ QName l
n [Pat l]
ps) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
2 Bool -> Bool -> Bool
&& Bool -> Bool
not ([Pat l] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Pat l]
ps)) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
                [Doc] -> Doc
myFsep (QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
n Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (Pat l -> Doc) -> [Pat l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Indent -> Pat l -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
3) [Pat l]
ps)
        prettyPrec Indent
_ (PTuple l
_ Boxed
bxd [Pat l]
ps) =
                let ds :: [Doc]
ds = (Pat l -> Doc) -> [Pat l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Pat l -> Doc
forall a. Pretty a => a -> Doc
pretty [Pat l]
ps
                in case Boxed
bxd of
                       Boxed
Boxed   -> [Doc] -> Doc
parenList [Doc]
ds
                       Boxed
Unboxed -> [Doc] -> Doc
hashParenList [Doc]
ds
        prettyPrec Indent
_ (PUnboxedSum l
_ Indent
before Indent
after Pat l
exp) =
          Indent -> Indent -> Pat l -> Doc
forall e. Pretty e => Indent -> Indent -> e -> Doc
printUnboxedSum Indent
before Indent
after Pat l
exp
        prettyPrec Indent
_ (PList l
_ [Pat l]
ps) =
                [Doc] -> Doc
bracketList ([Doc] -> Doc) -> ([Pat l] -> [Doc]) -> [Pat l] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> ([Pat l] -> [Doc]) -> [Pat l] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pat l -> Doc) -> [Pat l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Pat l -> Doc
forall a. Pretty a => a -> Doc
pretty ([Pat l] -> Doc) -> [Pat l] -> Doc
forall a b. (a -> b) -> a -> b
$ [Pat l]
ps
        prettyPrec Indent
_ (PParen l
_ Pat l
pat) = Doc -> Doc
parens (Doc -> Doc) -> (Pat l -> Doc) -> Pat l -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pat l -> Doc
forall a. Pretty a => a -> Doc
pretty (Pat l -> Doc) -> Pat l -> Doc
forall a b. (a -> b) -> a -> b
$ Pat l
pat
        prettyPrec Indent
_ (PRec l
_ QName l
c [PatField l]
fields) =
                QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
c Doc -> Doc -> Doc
<> ([Doc] -> Doc
braceList ([Doc] -> Doc) -> ([PatField l] -> [Doc]) -> [PatField l] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PatField l -> Doc) -> [PatField l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map PatField l -> Doc
forall a. Pretty a => a -> Doc
pretty ([PatField l] -> Doc) -> [PatField l] -> Doc
forall a b. (a -> b) -> a -> b
$ [PatField l]
fields)
        -- special case that would otherwise be buggy
        prettyPrec Indent
_ (PAsPat l
_ Name l
name (PIrrPat l
_ Pat l
pat)) =
                [Doc] -> Doc
myFsep [Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
name Doc -> Doc -> Doc
<> Char -> Doc
char Char
'@', Char -> Doc
char Char
'~' Doc -> Doc -> Doc
<> Indent -> Pat l -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
3 Pat l
pat]
        prettyPrec Indent
_ (PAsPat l
_ Name l
name Pat l
pat) =
                [Doc] -> Doc
hcat [Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
name, Char -> Doc
char Char
'@', Indent -> Pat l -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
3 Pat l
pat]
        prettyPrec Indent
_ PWildCard {} = Char -> Doc
char Char
'_'
        prettyPrec Indent
_ (PIrrPat l
_ Pat l
pat) = Char -> Doc
char Char
'~' Doc -> Doc -> Doc
<> Indent -> Pat l -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
3 Pat l
pat
        prettyPrec Indent
p (PatTypeSig l
_pos Pat l
pat Type l
ty) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
0) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
                [Doc] -> Doc
myFsep [Pat l -> Doc
forall a. Pretty a => a -> Doc
pretty Pat l
pat, String -> Doc
text String
"::", Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
ty]
        prettyPrec Indent
p (PViewPat l
_ Exp l
e Pat l
pat) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
0) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
                [Doc] -> Doc
myFsep [Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e, String -> Doc
text String
"->", Pat l -> Doc
forall a. Pretty a => a -> Doc
pretty Pat l
pat]
        prettyPrec Indent
p (PNPlusK l
_ Name l
n Integer
k) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
0) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
                [Doc] -> Doc
myFsep [Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
n, String -> Doc
text String
"+", String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
k]
        -- HaRP
        prettyPrec Indent
_ (PRPat l
_ [RPat l]
rs) =
                [Doc] -> Doc
bracketList ([Doc] -> Doc) -> ([RPat l] -> [Doc]) -> [RPat l] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> ([RPat l] -> [Doc]) -> [RPat l] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RPat l -> Doc) -> [RPat l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map RPat l -> Doc
forall a. Pretty a => a -> Doc
pretty ([RPat l] -> Doc) -> [RPat l] -> Doc
forall a b. (a -> b) -> a -> b
$ [RPat l]
rs
        -- Hsx
        prettyPrec Indent
_ (PXTag l
_ XName l
n [PXAttr l]
attrs Maybe (Pat l)
mattr [Pat l]
cp) =
            let ap :: [Doc]
ap = [Doc] -> (Pat l -> [Doc]) -> Maybe (Pat l) -> [Doc]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Doc -> [Doc]
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> [Doc]) -> (Pat l -> Doc) -> Pat l -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pat l -> Doc
forall a. Pretty a => a -> Doc
pretty) Maybe (Pat l)
mattr
             in [Doc] -> Doc
hcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ -- TODO: should not introduce blanks
                  ([Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Char -> Doc
char Char
'<' Doc -> Doc -> Doc
<> XName l -> Doc
forall a. Pretty a => a -> Doc
pretty XName l
n)Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (PXAttr l -> Doc) -> [PXAttr l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map PXAttr l -> Doc
forall a. Pretty a => a -> Doc
pretty [PXAttr l]
attrs [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc]
ap [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Char -> Doc
char Char
'>'])Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:
                    (Pat l -> Doc) -> [Pat l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Pat l -> Doc
forall a. Pretty a => a -> Doc
pretty [Pat l]
cp [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [[Doc] -> Doc
myFsep [String -> Doc
text String
"</" Doc -> Doc -> Doc
<> XName l -> Doc
forall a. Pretty a => a -> Doc
pretty XName l
n, Char -> Doc
char Char
'>']]
        prettyPrec Indent
_ (PXETag l
_ XName l
n [PXAttr l]
attrs Maybe (Pat l)
mattr) =
                let ap :: [Doc]
ap = [Doc] -> (Pat l -> [Doc]) -> Maybe (Pat l) -> [Doc]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Doc -> [Doc]
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> [Doc]) -> (Pat l -> Doc) -> Pat l -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pat l -> Doc
forall a. Pretty a => a -> Doc
pretty) Maybe (Pat l)
mattr
                 in [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Char -> Doc
char Char
'<' Doc -> Doc -> Doc
<> XName l -> Doc
forall a. Pretty a => a -> Doc
pretty XName l
n)Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (PXAttr l -> Doc) -> [PXAttr l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map PXAttr l -> Doc
forall a. Pretty a => a -> Doc
pretty [PXAttr l]
attrs [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc]
ap [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"/>"]
        prettyPrec Indent
_ (PXPcdata l
_ String
s) = String -> Doc
text String
s
        prettyPrec Indent
_ (PXPatTag l
_ Pat l
p) =
                [Doc] -> Doc
myFsep [String -> Doc
text String
"<%", Pat l -> Doc
forall a. Pretty a => a -> Doc
pretty Pat l
p, String -> Doc
text String
"%>"]
        prettyPrec Indent
_ (PXRPats l
_ [RPat l]
ps) =
                [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"<[" Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (RPat l -> Doc) -> [RPat l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map RPat l -> Doc
forall a. Pretty a => a -> Doc
pretty [RPat l]
ps [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"%>"]
        -- BangPatterns
        prettyPrec Indent
_ (PBangPat l
_ Pat l
pat) = String -> Doc
text String
"!" Doc -> Doc -> Doc
<> Indent -> Pat l -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
3 Pat l
pat
        prettyPrec Indent
_ (PSplice l
_ Splice l
s) = Splice l -> Doc
forall a. Pretty a => a -> Doc
pretty Splice l
s
        prettyPrec Indent
_ (PQuasiQuote l
_ String
n String
qt) = String -> Doc
text (String
"[$" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"|" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
qt String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"|]")

instance  Pretty (PXAttr l) where
        pretty :: PXAttr l -> Doc
pretty (PXAttr l
_ XName l
n Pat l
p) =
                [Doc] -> Doc
myFsep [XName l -> Doc
forall a. Pretty a => a -> Doc
pretty XName l
n, Char -> Doc
char Char
'=', Pat l -> Doc
forall a. Pretty a => a -> Doc
pretty Pat l
p]

instance  Pretty (PatField l) where
        pretty :: PatField l -> Doc
pretty (PFieldPat l
_ QName l
name Pat l
pat) =
                [Doc] -> Doc
myFsep [QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
name, Doc
equals, Pat l -> Doc
forall a. Pretty a => a -> Doc
pretty Pat l
pat]
        pretty (PFieldPun l
_ QName l
name) = QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
name
        pretty (PFieldWildcard{}) = String -> Doc
text String
".."

--------------------- Regular Patterns -------------------------

instance  Pretty (RPat l) where
        pretty :: RPat l -> Doc
pretty (RPOp l
_ RPat l
r RPatOp l
op) = RPat l -> Doc
forall a. Pretty a => a -> Doc
pretty RPat l
r Doc -> Doc -> Doc
<> RPatOp l -> Doc
forall a. Pretty a => a -> Doc
pretty RPatOp l
op
        pretty (RPEither l
_ RPat l
r1 RPat l
r2) = Doc -> Doc
parens (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
                [RPat l -> Doc
forall a. Pretty a => a -> Doc
pretty RPat l
r1, Char -> Doc
char Char
'|', RPat l -> Doc
forall a. Pretty a => a -> Doc
pretty RPat l
r2]
        pretty (RPSeq l
_ [RPat l]
rs) =
                [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"(|" Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> ([RPat l] -> [Doc]) -> [RPat l] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RPat l -> Doc) -> [RPat l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map RPat l -> Doc
forall a. Pretty a => a -> Doc
pretty ([RPat l] -> [Doc]) -> [RPat l] -> [Doc]
forall a b. (a -> b) -> a -> b
$ [RPat l]
rs)
                           [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"|)"]
        pretty (RPGuard l
_ Pat l
r [Stmt l]
gs) =
                [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"(|" Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: Pat l -> Doc
forall a. Pretty a => a -> Doc
pretty Pat l
r Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: Char -> Doc
char Char
'|' Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:
                           (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> ([Stmt l] -> [Doc]) -> [Stmt l] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stmt l -> Doc) -> [Stmt l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Stmt l -> Doc
forall a. Pretty a => a -> Doc
pretty ([Stmt l] -> [Doc]) -> [Stmt l] -> [Doc]
forall a b. (a -> b) -> a -> b
$ [Stmt l]
gs) [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"|)"]
        -- special case that would otherwise be buggy
        pretty (RPCAs l
_ Name l
n (RPPat l
_ (PIrrPat l
_ Pat l
p))) =
                [Doc] -> Doc
myFsep [Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
n Doc -> Doc -> Doc
<> String -> Doc
text String
"@:", Char -> Doc
char Char
'~' Doc -> Doc -> Doc
<> Pat l -> Doc
forall a. Pretty a => a -> Doc
pretty Pat l
p]
        pretty (RPCAs l
_ Name l
n RPat l
r) = [Doc] -> Doc
hcat [Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
n, String -> Doc
text String
"@:", RPat l -> Doc
forall a. Pretty a => a -> Doc
pretty RPat l
r]
        -- special case that would otherwise be buggy
        pretty (RPAs l
_ Name l
n (RPPat l
_ (PIrrPat l
_ Pat l
p))) =
                [Doc] -> Doc
myFsep [Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
n Doc -> Doc -> Doc
<> String -> Doc
text String
"@:", Char -> Doc
char Char
'~' Doc -> Doc -> Doc
<> Pat l -> Doc
forall a. Pretty a => a -> Doc
pretty Pat l
p]
        pretty (RPAs l
_ Name l
n RPat l
r) = [Doc] -> Doc
hcat [Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
n, Char -> Doc
char Char
'@', RPat l -> Doc
forall a. Pretty a => a -> Doc
pretty RPat l
r]
        pretty (RPPat l
_ Pat l
p) = Pat l -> Doc
forall a. Pretty a => a -> Doc
pretty Pat l
p
        pretty (RPParen l
_ RPat l
rp) = Doc -> Doc
parens (Doc -> Doc) -> (RPat l -> Doc) -> RPat l -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RPat l -> Doc
forall a. Pretty a => a -> Doc
pretty (RPat l -> Doc) -> RPat l -> Doc
forall a b. (a -> b) -> a -> b
$ RPat l
rp

instance  Pretty (RPatOp l) where
        pretty :: RPatOp l -> Doc
pretty RPStar{}  = Char -> Doc
char Char
'*'
        pretty RPStarG{} = String -> Doc
text String
"*!"
        pretty RPPlus{}  = Char -> Doc
char Char
'+'
        pretty RPPlusG{} = String -> Doc
text String
"+!"
        pretty RPOpt{}   = Char -> Doc
char Char
'?'
        pretty RPOptG{}  = String -> Doc
text String
"?!"

------------------------- Case bodies  -------------------------
instance  Pretty (Alt l) where
        pretty :: Alt l -> Doc
pretty (Alt l
_pos Pat l
e Rhs l
gAlts Maybe (Binds l)
binds) =
                Pat l -> Doc
forall a. Pretty a => a -> Doc
pretty Pat l
e Doc -> Doc -> Doc
<+> GuardedAlts l -> Doc
forall a. Pretty a => a -> Doc
pretty (Rhs l -> GuardedAlts l
forall l. Rhs l -> GuardedAlts l
GuardedAlts Rhs l
gAlts) Doc -> Doc -> Doc
$$$ Maybe (Binds l) -> Doc
forall l. Maybe (Binds l) -> Doc
ppWhere Maybe (Binds l)
binds

------------------------- Statements in monads, guards & list comprehensions -----
instance  Pretty (Stmt l) where
        pretty :: Stmt l -> Doc
pretty (Generator l
_loc Pat l
e Exp l
from) =
                Pat l -> Doc
forall a. Pretty a => a -> Doc
pretty Pat l
e Doc -> Doc -> Doc
<+> String -> Doc
text String
"<-" Doc -> Doc -> Doc
<+> Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
from
        pretty (Qualifier l
_ Exp l
e) = Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e
        -- two cases for lets
        pretty (LetStmt l
_ (BDecls l
_ [Decl l]
declList)) =
                [Decl l] -> Doc
forall a. Pretty a => [a] -> Doc
ppLetStmt [Decl l]
declList
        pretty (LetStmt l
_ (IPBinds l
_ [IPBind l]
bindList)) =
                [IPBind l] -> Doc
forall a. Pretty a => [a] -> Doc
ppLetStmt [IPBind l]
bindList
        pretty (RecStmt l
_ [Stmt l]
stmtList) =
                String -> Doc
text String
"rec" Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
letIndent ((Stmt l -> Doc) -> [Stmt l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Stmt l -> Doc
forall a. Pretty a => a -> Doc
pretty [Stmt l]
stmtList)

ppLetStmt :: Pretty a => [a] -> Doc
ppLetStmt :: [a] -> Doc
ppLetStmt [a]
l = String -> Doc
text String
"let" Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
letIndent ((a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
forall a. Pretty a => a -> Doc
pretty [a]
l)

instance  Pretty (QualStmt l) where
        pretty :: QualStmt l -> Doc
pretty (QualStmt l
_ Stmt l
s) = Stmt l -> Doc
forall a. Pretty a => a -> Doc
pretty Stmt l
s
        pretty (ThenTrans l
_ Exp l
f)    = [Doc] -> Doc
myFsep [String -> Doc
text String
"then", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
f]
        pretty (ThenBy l
_ Exp l
f Exp l
e)  = [Doc] -> Doc
myFsep [String -> Doc
text String
"then", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
f, String -> Doc
text String
"by", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e]
        pretty (GroupBy l
_ Exp l
e)    = [Doc] -> Doc
myFsep [String -> Doc
text String
"then", String -> Doc
text String
"group", String -> Doc
text String
"by", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e]
        pretty (GroupUsing l
_ Exp l
f)    = [Doc] -> Doc
myFsep [String -> Doc
text String
"then", String -> Doc
text String
"group", String -> Doc
text String
"using", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
f]
        pretty (GroupByUsing l
_ Exp l
e Exp l
f)  = [Doc] -> Doc
myFsep [String -> Doc
text String
"then", String -> Doc
text String
"group", String -> Doc
text String
"by",
                                                Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e, String -> Doc
text String
"using", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
f]



------------------------- Record updates
instance  Pretty (FieldUpdate l) where
        pretty :: FieldUpdate l -> Doc
pretty (FieldUpdate l
_ QName l
name Exp l
e) =
                [Doc] -> Doc
myFsep [QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
name, Doc
equals, Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e]
        pretty (FieldPun l
_ QName l
name) = QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
name
        pretty (FieldWildcard {}) = String -> Doc
text String
".."

------------------------- Names -------------------------
instance  Pretty (QOp l) where
        pretty :: QOp l -> Doc
pretty (QVarOp l
_ QName l
n) = QName l -> Doc
forall l. QName l -> Doc
ppQNameInfix QName l
n
        pretty (QConOp l
_ QName l
n) = QName l -> Doc
forall l. QName l -> Doc
ppQNameInfix QName l
n

ppQNameInfix :: QName l -> Doc
ppQNameInfix :: QName l -> Doc
ppQNameInfix QName l
name
        | QName l -> Bool
forall l. QName l -> Bool
isSymbolQName QName l
name = QName l -> Doc
forall l. QName l -> Doc
ppQName QName l
name
        | Bool
otherwise = Char -> Doc
char Char
'`' Doc -> Doc -> Doc
<> QName l -> Doc
forall l. QName l -> Doc
ppQName QName l
name Doc -> Doc -> Doc
<> Char -> Doc
char Char
'`'

instance  Pretty (QName l) where
        pretty :: QName l -> Doc
pretty QName l
name = case QName l
name of
                UnQual l
_ (Symbol l
_ (Char
'#':String
_)) -> Char -> Doc
char Char
'(' Doc -> Doc -> Doc
<+> QName l -> Doc
forall l. QName l -> Doc
ppQName QName l
name Doc -> Doc -> Doc
<+> Char -> Doc
char Char
')'
                QName l
_ -> Bool -> Doc -> Doc
parensIf (QName l -> Bool
forall l. QName l -> Bool
isSymbolQName QName l
name) (QName l -> Doc
forall l. QName l -> Doc
ppQName QName l
name)

ppQName :: QName l -> Doc
ppQName :: QName l -> Doc
ppQName (UnQual l
_ Name l
name) = Name l -> Doc
forall l. Name l -> Doc
ppName Name l
name
ppQName (Qual l
_ ModuleName l
m Name l
name) = ModuleName l -> Doc
forall a. Pretty a => a -> Doc
pretty ModuleName l
m Doc -> Doc -> Doc
<> Char -> Doc
char Char
'.' Doc -> Doc -> Doc
<> Name l -> Doc
forall l. Name l -> Doc
ppName Name l
name
ppQName (Special l
_ SpecialCon l
sym) = SpecialCon l -> Doc
forall a. Pretty a => a -> Doc
pretty SpecialCon l
sym

instance  Pretty (Op l) where
        pretty :: Op l -> Doc
pretty (VarOp l
_ Name l
n) = Name l -> Doc
forall l. Name l -> Doc
ppNameInfix Name l
n
        pretty (ConOp l
_ Name l
n) = Name l -> Doc
forall l. Name l -> Doc
ppNameInfix Name l
n

ppNameInfix :: Name l -> Doc
ppNameInfix :: Name l -> Doc
ppNameInfix Name l
name
        | Name l -> Bool
forall l. Name l -> Bool
isSymbolName Name l
name = Name l -> Doc
forall l. Name l -> Doc
ppName Name l
name
        | Bool
otherwise = Char -> Doc
char Char
'`' Doc -> Doc -> Doc
<> Name l -> Doc
forall l. Name l -> Doc
ppName Name l
name Doc -> Doc -> Doc
<> Char -> Doc
char Char
'`'

instance  Pretty (Name l) where
        pretty :: Name l -> Doc
pretty Name l
name = case Name l
name of
                Symbol l
_ (Char
'#':String
_) -> Char -> Doc
char Char
'(' Doc -> Doc -> Doc
<+> Name l -> Doc
forall l. Name l -> Doc
ppName Name l
name Doc -> Doc -> Doc
<+> Char -> Doc
char Char
')'
                Name l
_ -> Bool -> Doc -> Doc
parensIf (Name l -> Bool
forall l. Name l -> Bool
isSymbolName Name l
name) (Name l -> Doc
forall l. Name l -> Doc
ppName Name l
name)

ppName :: Name l -> Doc
ppName :: Name l -> Doc
ppName (Ident l
_ String
s) = String -> Doc
text String
s
ppName (Symbol l
_ String
s) = String -> Doc
text String
s

instance  Pretty (IPName l) where
        pretty :: IPName l -> Doc
pretty (IPDup l
_ String
s) = Char -> Doc
char Char
'?' Doc -> Doc -> Doc
<> String -> Doc
text String
s
        pretty (IPLin l
_ String
s) = Char -> Doc
char Char
'%' Doc -> Doc -> Doc
<> String -> Doc
text String
s

instance  PrettyDeclLike (IPBind l) where
  wantsBlankline :: IPBind l -> Bool
wantsBlankline IPBind l
_ = Bool
False

instance  Pretty (IPBind l) where
        pretty :: IPBind l -> Doc
pretty (IPBind l
_loc IPName l
ipname Exp l
exp) =
                [Doc] -> Doc
myFsep [IPName l -> Doc
forall a. Pretty a => a -> Doc
pretty IPName l
ipname, Doc
equals, Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
exp]

instance  Pretty (CName l) where
        pretty :: CName l -> Doc
pretty (VarName l
_ Name l
n) = Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
n
        pretty (ConName l
_ Name l
n) = Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
n

instance Pretty (SpecialCon l) where
        pretty :: SpecialCon l -> Doc
pretty (UnitCon {})         = String -> Doc
text String
"()"
        pretty (ListCon {})         = String -> Doc
text String
"[]"
        pretty (FunCon  {})         = String -> Doc
text String
"->"
        pretty (TupleCon l
_ Boxed
b Indent
n)   = Doc -> Doc
listFun (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ (Doc -> Doc -> Doc) -> Doc -> [Doc] -> Doc
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Doc -> Doc -> Doc
(<>) Doc
empty (Indent -> Doc -> [Doc]
forall a. Indent -> a -> [a]
replicate (Indent
nIndent -> Indent -> Indent
forall a. Num a => a -> a -> a
-Indent
1) Doc
comma)
          where listFun :: Doc -> Doc
listFun = if Boxed
b Boxed -> Boxed -> Bool
forall a. Eq a => a -> a -> Bool
== Boxed
Unboxed then Doc -> Doc
hashParens else Doc -> Doc
parens
        pretty (Cons {})             = String -> Doc
text String
":"
        pretty (UnboxedSingleCon {}) = String -> Doc
text String
"(# #)"
        pretty (ExprHole {}) = String -> Doc
text String
"_"

isSymbolName :: Name l -> Bool
isSymbolName :: Name l -> Bool
isSymbolName (Symbol {}) = Bool
True
isSymbolName Name l
_ = Bool
False

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

--getSpecialName :: QName l -> Maybe (SpecialCon l)
--getSpecialName (Special _ n) = Just n
--getSpecialName _           = Nothing

-- Contexts are "sets" of assertions. Several members really means it's a
-- CxTuple, but we can't represent that in our list of assertions.
-- Therefore: print single member contexts without parenthesis, and treat
--            larger contexts as tuples.
instance (Pretty (Context l)) where
  pretty :: Context l -> Doc
pretty (CxEmpty l
_)      = String -> Doc
text String
"()" Doc -> Doc -> Doc
<+> String -> Doc
text String
"=>"
  pretty (CxSingle l
_ Asst l
ctxt)  = Asst l -> Doc
forall a. Pretty a => a -> Doc
pretty Asst l
ctxt Doc -> Doc -> Doc
<+> String -> Doc
text String
"=>"
  pretty (CxTuple l
_ [Asst l]
context) = [Doc] -> Doc
mySep [[Doc] -> Doc
parenList ((Asst l -> Doc) -> [Asst l] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Asst l -> Doc
forall a. Pretty a => a -> Doc
pretty [Asst l]
context), String -> Doc
text String
"=>"]

instance  Pretty (Asst l) where
        pretty :: Asst l -> Doc
pretty (TypeA l
_ Type l
t)       = Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
t
        pretty (IParam l
_ IPName l
i Type l
t)    = [Doc] -> Doc
myFsep [IPName l -> Doc
forall a. Pretty a => a -> Doc
pretty IPName l
i, String -> Doc
text String
"::", Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
t]
        pretty (ParenA l
_ Asst l
a)      = Doc -> Doc
parens (Asst l -> Doc
forall a. Pretty a => a -> Doc
pretty Asst l
a)

-- Pretty print a source location, useful for printing out error messages
instance Pretty SrcLoc where
  pretty :: SrcLoc -> Doc
pretty SrcLoc
srcLoc =
    Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
P.hcat [ Doc -> Doc
colonFollow (String -> Doc
P.text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ SrcLoc -> String
srcFilename SrcLoc
srcLoc)
                    , Doc -> Doc
colonFollow (Indent -> Doc
P.int  (Indent -> Doc) -> Indent -> Doc
forall a b. (a -> b) -> a -> b
$ SrcLoc -> Indent
srcLine     SrcLoc
srcLoc)
                    , Indent -> Doc
P.int (Indent -> Doc) -> Indent -> Doc
forall a b. (a -> b) -> a -> b
$ SrcLoc -> Indent
srcColumn SrcLoc
srcLoc
                    ]

colonFollow :: P.Doc -> P.Doc
colonFollow :: Doc -> Doc
colonFollow Doc
p = [Doc] -> Doc
P.hcat [ Doc
p, Doc
P.colon ]


instance Pretty SrcSpan where
    pretty :: SrcSpan -> Doc
pretty SrcSpan
srcSpan =
        Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
P.hsep [ Doc -> Doc
colonFollow (String -> Doc
P.text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ SrcSpan -> String
srcSpanFilename SrcSpan
srcSpan)
                        , [Doc] -> Doc
P.hcat [ String -> Doc
P.text String
"("
                                 , Indent -> Doc
P.int (Indent -> Doc) -> Indent -> Doc
forall a b. (a -> b) -> a -> b
$ SrcSpan -> Indent
srcSpanStartLine SrcSpan
srcSpan
                                 , Doc
P.colon
                                 , Indent -> Doc
P.int (Indent -> Doc) -> Indent -> Doc
forall a b. (a -> b) -> a -> b
$ SrcSpan -> Indent
srcSpanStartColumn SrcSpan
srcSpan
                                 , String -> Doc
P.text String
")"
                                 ]
                        , String -> Doc
P.text String
"-"
                        , [Doc] -> Doc
P.hcat [ String -> Doc
P.text String
"("
                                 , Indent -> Doc
P.int (Indent -> Doc) -> Indent -> Doc
forall a b. (a -> b) -> a -> b
$ SrcSpan -> Indent
srcSpanEndLine SrcSpan
srcSpan
                                 , Doc
P.colon
                                 , Indent -> Doc
P.int (Indent -> Doc) -> Indent -> Doc
forall a b. (a -> b) -> a -> b
$ SrcSpan -> Indent
srcSpanEndColumn SrcSpan
srcSpan
                                 , String -> Doc
P.text String
")"
                                 ]
                        ]

---------------------------------------------------------------------
-- Annotated version


-------------------------  Pretty-Print a Module --------------------
instance Pretty (Module pos) where
        pretty :: Module pos -> Doc
pretty (Module pos
_ Maybe (ModuleHead pos)
mbHead [ModulePragma pos]
os [ImportDecl pos]
imp [Decl pos]
decls) =
                [Doc] -> Doc
myVcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (ModulePragma pos -> Doc) -> [ModulePragma pos] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ModulePragma pos -> Doc
forall a. Pretty a => a -> Doc
pretty [ModulePragma pos]
os [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++
                    (case Maybe (ModuleHead pos)
mbHead of
                        Maybe (ModuleHead pos)
Nothing -> [Doc] -> [Doc]
forall a. a -> a
id
                        Just ModuleHead pos
h  -> \[Doc]
x -> [Doc -> [Doc] -> Doc
topLevel (ModuleHead pos -> Doc
forall a. Pretty a => a -> Doc
pretty ModuleHead pos
h) [Doc]
x])
                    ((ImportDecl pos -> Doc) -> [ImportDecl pos] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ImportDecl pos -> Doc
forall a. Pretty a => a -> Doc
pretty [ImportDecl pos]
imp [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++
                         Bool -> [Decl pos] -> [Doc]
forall a. PrettyDeclLike a => Bool -> [a] -> [Doc]
ppDecls (Maybe (ModuleHead pos) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (ModuleHead pos)
mbHead Bool -> Bool -> Bool
||
                                  Bool -> Bool
not ([ImportDecl pos] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ImportDecl pos]
imp) Bool -> Bool -> Bool
||
                                  Bool -> Bool
not ([ModulePragma pos] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ModulePragma pos]
os))
                           [Decl pos]
decls)
        pretty (XmlPage pos
_ ModuleName pos
_mn [ModulePragma pos]
os XName pos
n [XAttr pos]
attrs Maybe (Exp pos)
mattr [Exp pos]
cs) =
                [Doc] -> Doc
myVcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (ModulePragma pos -> Doc) -> [ModulePragma pos] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ModulePragma pos -> Doc
forall a. Pretty a => a -> Doc
pretty [ModulePragma pos]
os [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++
                    [let ax :: [Doc]
ax = [Doc] -> (Exp pos -> [Doc]) -> Maybe (Exp pos) -> [Doc]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Doc -> [Doc]
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> [Doc]) -> (Exp pos -> Doc) -> Exp pos -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp pos -> Doc
forall a. Pretty a => a -> Doc
pretty) Maybe (Exp pos)
mattr
                      in [Doc] -> Doc
hcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
                         ([Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Char -> Doc
char Char
'<' Doc -> Doc -> Doc
<> XName pos -> Doc
forall a. Pretty a => a -> Doc
pretty XName pos
n)Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (XAttr pos -> Doc) -> [XAttr pos] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map XAttr pos -> Doc
forall a. Pretty a => a -> Doc
pretty [XAttr pos]
attrs [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc]
ax [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Char -> Doc
char Char
'>'])Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:
                            (Exp pos -> Doc) -> [Exp pos] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Exp pos -> Doc
forall a. Pretty a => a -> Doc
pretty [Exp pos]
cs [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [[Doc] -> Doc
myFsep [String -> Doc
text String
"</" Doc -> Doc -> Doc
<> XName pos -> Doc
forall a. Pretty a => a -> Doc
pretty XName pos
n, Char -> Doc
char Char
'>']]]
        pretty (XmlHybrid pos
_ Maybe (ModuleHead pos)
mbHead [ModulePragma pos]
os [ImportDecl pos]
imp [Decl pos]
decls XName pos
n [XAttr pos]
attrs Maybe (Exp pos)
mattr [Exp pos]
cs) =
                [Doc] -> Doc
myVcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (ModulePragma pos -> Doc) -> [ModulePragma pos] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ModulePragma pos -> Doc
forall a. Pretty a => a -> Doc
pretty [ModulePragma pos]
os [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"<%"] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++
                    (case Maybe (ModuleHead pos)
mbHead of
                        Maybe (ModuleHead pos)
Nothing -> [Doc] -> [Doc]
forall a. a -> a
id
                        Just ModuleHead pos
h  -> \[Doc]
x -> [Doc -> [Doc] -> Doc
topLevel (ModuleHead pos -> Doc
forall a. Pretty a => a -> Doc
pretty ModuleHead pos
h) [Doc]
x])
                    ((ImportDecl pos -> Doc) -> [ImportDecl pos] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ImportDecl pos -> Doc
forall a. Pretty a => a -> Doc
pretty [ImportDecl pos]
imp [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++
                      Bool -> [Decl pos] -> [Doc]
forall a. PrettyDeclLike a => Bool -> [a] -> [Doc]
ppDecls (Maybe (ModuleHead pos) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (ModuleHead pos)
mbHead Bool -> Bool -> Bool
|| Bool -> Bool
not ([ImportDecl pos] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ImportDecl pos]
imp) Bool -> Bool -> Bool
|| Bool -> Bool
not ([ModulePragma pos] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ModulePragma pos]
os)) [Decl pos]
decls [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++
                        [let ax :: [Doc]
ax = [Doc] -> (Exp pos -> [Doc]) -> Maybe (Exp pos) -> [Doc]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Doc -> [Doc]
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> [Doc]) -> (Exp pos -> Doc) -> Exp pos -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp pos -> Doc
forall a. Pretty a => a -> Doc
pretty) Maybe (Exp pos)
mattr
                          in [Doc] -> Doc
hcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
                             ([Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Char -> Doc
char Char
'<' Doc -> Doc -> Doc
<> XName pos -> Doc
forall a. Pretty a => a -> Doc
pretty XName pos
n)Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (XAttr pos -> Doc) -> [XAttr pos] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map XAttr pos -> Doc
forall a. Pretty a => a -> Doc
pretty [XAttr pos]
attrs [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc]
ax [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Char -> Doc
char Char
'>'])Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:
                                (Exp pos -> Doc) -> [Exp pos] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Exp pos -> Doc
forall a. Pretty a => a -> Doc
pretty [Exp pos]
cs [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [[Doc] -> Doc
myFsep [String -> Doc
text String
"</" Doc -> Doc -> Doc
<> XName pos -> Doc
forall a. Pretty a => a -> Doc
pretty XName pos
n, Char -> Doc
char Char
'>']]])



------------------------- pp utils -------------------------
maybePP :: (a -> Doc) -> Maybe a -> Doc
maybePP :: (a -> Doc) -> Maybe a -> Doc
maybePP a -> Doc
_  Maybe a
Nothing = Doc
empty
maybePP a -> Doc
pp (Just a
a) = a -> Doc
pp a
a

parenList :: [Doc] -> Doc
parenList :: [Doc] -> Doc
parenList = Doc -> Doc
parens (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
myFsepSimple ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma

hashParenList :: [Doc] -> Doc
hashParenList :: [Doc] -> Doc
hashParenList = Doc -> Doc
hashParens (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
myFsepSimple ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma

unboxedSumType :: [Doc] -> Doc
unboxedSumType :: [Doc] -> Doc
unboxedSumType = Doc -> Doc
hashParens (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
myFsepSimple ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate (String -> Doc
text String
" |")

hashParens :: Doc -> Doc
hashParens :: Doc -> Doc
hashParens = Doc -> Doc
parens (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
hashes
  where
    hashes :: Doc -> Doc
hashes Doc
doc = Char -> Doc
char Char
'#' Doc -> Doc -> Doc
<+> Doc
doc Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'#'

braceList :: [Doc] -> Doc
braceList :: [Doc] -> Doc
braceList = Doc -> Doc
braces (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
myFsepSimple ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma

bracketList :: [Doc] -> Doc
bracketList :: [Doc] -> Doc
bracketList = Doc -> Doc
brackets (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
myFsepSimple

bracketColonList :: [Doc] -> Doc
bracketColonList :: [Doc] -> Doc
bracketColonList = Doc -> Doc
bracketColons (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
myFsepSimple
    where bracketColons :: Doc -> Doc
bracketColons = Doc -> Doc
brackets (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
colons
          colons :: Doc -> Doc
colons Doc
doc = Char -> Doc
char Char
':' Doc -> Doc -> Doc
<> Doc
doc Doc -> Doc -> Doc
<> Char -> Doc
char Char
':'

-- Wrap in braces and semicolons, with an extra space at the start in
-- case the first doc begins with "-", which would be scanned as {-
flatBlock :: [Doc] -> Doc
flatBlock :: [Doc] -> Doc
flatBlock = Doc -> Doc
braces (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc
space Doc -> Doc -> Doc
<>) (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
hsep ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
semi

-- Same, but put each thing on a separate line
prettyBlock :: [Doc] -> Doc
prettyBlock :: [Doc] -> Doc
prettyBlock = Doc -> Doc
braces (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc
space Doc -> Doc -> Doc
<>) (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
vcat ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
semi

-- Monadic PP Combinators -- these examine the env

blankline :: Doc -> Doc
blankline :: Doc -> Doc
blankline Doc
dl = do{PPHsMode
e<-DocM PPHsMode PPHsMode
forall s. DocM s s
getPPEnv;if PPHsMode -> Bool
spacing PPHsMode
e Bool -> Bool -> Bool
&& PPHsMode -> PPLayout
layout PPHsMode
e PPLayout -> PPLayout -> Bool
forall a. Eq a => a -> a -> Bool
/= PPLayout
PPNoLayout
                              then String -> Doc
text String
"" Doc -> Doc -> Doc
$+$ Doc
dl else Doc
dl}
topLevel :: Doc -> [Doc] -> Doc
topLevel :: Doc -> [Doc] -> Doc
topLevel Doc
header [Doc]
dl = do
         PPLayout
e <- (PPHsMode -> PPLayout)
-> DocM PPHsMode PPHsMode -> DocM PPHsMode PPLayout
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PPHsMode -> PPLayout
layout DocM PPHsMode PPHsMode
forall s. DocM s s
getPPEnv
         case PPLayout
e of
             PPLayout
PPOffsideRule -> Doc
header Doc -> Doc -> Doc
$$ [Doc] -> Doc
vcat [Doc]
dl
             PPLayout
PPSemiColon -> Doc
header Doc -> Doc -> Doc
$$ [Doc] -> Doc
prettyBlock [Doc]
dl
             PPLayout
PPInLine -> Doc
header Doc -> Doc -> Doc
$$ [Doc] -> Doc
prettyBlock [Doc]
dl
             PPLayout
PPNoLayout -> Doc
header Doc -> Doc -> Doc
<+> [Doc] -> Doc
flatBlock [Doc]
dl

ppBody :: (PPHsMode -> Int) -> [Doc] -> Doc
ppBody :: (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
f [Doc]
dl = do
         PPLayout
e <- (PPHsMode -> PPLayout)
-> DocM PPHsMode PPHsMode -> DocM PPHsMode PPLayout
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PPHsMode -> PPLayout
layout DocM PPHsMode PPHsMode
forall s. DocM s s
getPPEnv
         case PPLayout
e of PPLayout
PPOffsideRule -> Doc
indent
                   PPLayout
PPSemiColon   -> Doc
indentExplicit
                   PPLayout
_ -> [Doc] -> Doc
flatBlock [Doc]
dl
                   where
                   indent :: Doc
indent  = do{Indent
i <-(PPHsMode -> Indent)
-> DocM PPHsMode PPHsMode -> DocM PPHsMode Indent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PPHsMode -> Indent
f DocM PPHsMode PPHsMode
forall s. DocM s s
getPPEnv;Indent -> Doc -> Doc
nest Indent
i (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc]
dl}
                   indentExplicit :: Doc
indentExplicit = do {Indent
i <- (PPHsMode -> Indent)
-> DocM PPHsMode PPHsMode -> DocM PPHsMode Indent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PPHsMode -> Indent
f DocM PPHsMode PPHsMode
forall s. DocM s s
getPPEnv;
                           Indent -> Doc -> Doc
nest Indent
i (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
prettyBlock ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc]
dl}

-- | Indent without braces. Useful for deriving clauses etc.
ppIndent :: (PPHsMode -> Int) -> [Doc] -> Doc
ppIndent :: (PPHsMode -> Indent) -> [Doc] -> Doc
ppIndent PPHsMode -> Indent
f [Doc]
dl = do
            Indent
i <- (PPHsMode -> Indent)
-> DocM PPHsMode PPHsMode -> DocM PPHsMode Indent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PPHsMode -> Indent
f DocM PPHsMode PPHsMode
forall s. DocM s s
getPPEnv
            Indent -> Doc -> Doc
nest Indent
i (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc]
dl

($$$) :: Doc -> Doc -> Doc
Doc
a $$$ :: Doc -> Doc -> Doc
$$$ Doc
b = (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
forall a. (a -> Doc) -> (a -> Doc) -> a -> Doc
layoutChoice (Doc
a Doc -> Doc -> Doc
$$) (Doc
a Doc -> Doc -> Doc
<+>) Doc
b

mySep :: [Doc] -> Doc
mySep :: [Doc] -> Doc
mySep = ([Doc] -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall a. (a -> Doc) -> (a -> Doc) -> a -> Doc
layoutChoice [Doc] -> Doc
mySep' [Doc] -> Doc
hsep
        where
        -- ensure paragraph fills with indentation.
        mySep' :: [Doc] -> Doc
mySep' [Doc
x]    = Doc
x
        mySep' (Doc
x:[Doc]
xs) = Doc
x Doc -> Doc -> Doc
<+> [Doc] -> Doc
fsep [Doc]
xs
        mySep' []     = String -> Doc
forall a. HasCallStack => String -> a
error String
"Internal error: mySep"

myVcat :: [Doc] -> Doc
myVcat :: [Doc] -> Doc
myVcat = ([Doc] -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall a. (a -> Doc) -> (a -> Doc) -> a -> Doc
layoutChoice [Doc] -> Doc
vcat [Doc] -> Doc
hsep

myFsepSimple :: [Doc] -> Doc
myFsepSimple :: [Doc] -> Doc
myFsepSimple = ([Doc] -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall a. (a -> Doc) -> (a -> Doc) -> a -> Doc
layoutChoice [Doc] -> Doc
fsep [Doc] -> Doc
hsep

-- same, except that continuation lines are indented,
-- which is necessary to avoid triggering the offside rule.
myFsep :: [Doc] -> Doc
myFsep :: [Doc] -> Doc
myFsep = ([Doc] -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall a. (a -> Doc) -> (a -> Doc) -> a -> Doc
layoutChoice [Doc] -> Doc
fsep' [Doc] -> Doc
hsep
        where   fsep' :: [Doc] -> Doc
fsep' [] = Doc
empty
                fsep' (Doc
d:[Doc]
ds) = do
                        PPHsMode
e <- DocM PPHsMode PPHsMode
forall s. DocM s s
getPPEnv
                        let n :: Indent
n = PPHsMode -> Indent
onsideIndent PPHsMode
e
                        Indent -> Doc -> Doc
nest Indent
n ([Doc] -> Doc
fsep (Indent -> Doc -> Doc
nest (-Indent
n) Doc
dDoc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:[Doc]
ds))

layoutChoice :: (a -> Doc) -> (a -> Doc) -> a -> Doc
layoutChoice :: (a -> Doc) -> (a -> Doc) -> a -> Doc
layoutChoice a -> Doc
a a -> Doc
b a
dl = do PPHsMode
e <- DocM PPHsMode PPHsMode
forall s. DocM s s
getPPEnv
                         if PPHsMode -> PPLayout
layout PPHsMode
e PPLayout -> PPLayout -> Bool
forall a. Eq a => a -> a -> Bool
== PPLayout
PPOffsideRule Bool -> Bool -> Bool
||
                            PPHsMode -> PPLayout
layout PPHsMode
e PPLayout -> PPLayout -> Bool
forall a. Eq a => a -> a -> Bool
== PPLayout
PPSemiColon
                          then a -> Doc
a a
dl else a -> Doc
b a
dl

--------------------------------------------------------------------------------
-- Pretty-printing of internal constructs, for error messages while parsing

instance SrcInfo loc => Pretty (P.PExp loc) where
        pretty :: PExp loc -> Doc
pretty (P.Lit loc
_ Literal loc
l) = Literal loc -> Doc
forall a. Pretty a => a -> Doc
pretty Literal loc
l
        pretty (P.InfixApp loc
_ PExp loc
a QOp loc
op PExp loc
b) = [Doc] -> Doc
myFsep [PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
a, QOp loc -> Doc
forall a. Pretty a => a -> Doc
pretty QOp loc
op, PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
b]
        pretty (P.NegApp loc
_ PExp loc
e) = [Doc] -> Doc
myFsep [Char -> Doc
char Char
'-', PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
e]
        pretty (P.App loc
_ PExp loc
a PExp loc
b) = [Doc] -> Doc
myFsep [PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
a, PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
b]
        pretty (P.Lambda loc
_loc [Pat loc]
expList PExp loc
ppBody') = [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
                Char -> Doc
char Char
'\\' Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (Pat loc -> Doc) -> [Pat loc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Pat loc -> Doc
forall a. Pretty a => a -> Doc
pretty [Pat loc]
expList [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"->", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
ppBody']
        pretty (P.Let loc
_ (BDecls loc
_ [Decl loc]
declList) PExp loc
letBody) =
                [Decl loc] -> PExp loc -> Doc
forall a b. (PrettyDeclLike a, Pretty b) => [a] -> b -> Doc
ppLetExp [Decl loc]
declList PExp loc
letBody
        pretty (P.Let loc
_ (IPBinds loc
_ [IPBind loc]
bindList) PExp loc
letBody) =
                [IPBind loc] -> PExp loc -> Doc
forall a b. (PrettyDeclLike a, Pretty b) => [a] -> b -> Doc
ppLetExp [IPBind loc]
bindList PExp loc
letBody
        pretty (P.If loc
_ PExp loc
cond PExp loc
thenexp PExp loc
elsexp) =
                [Doc] -> Doc
myFsep [String -> Doc
text String
"if", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
cond,
                        String -> Doc
text String
"then", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
thenexp,
                        String -> Doc
text String
"else", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
elsexp]
        pretty (P.MultiIf loc
_ [GuardedRhs loc]
alts) =
                String -> Doc
text String
"if"
                Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
caseIndent ((GuardedRhs loc -> Doc) -> [GuardedRhs loc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map GuardedRhs loc -> Doc
forall a. Pretty a => a -> Doc
pretty [GuardedRhs loc]
alts)
        pretty (P.Case loc
_ PExp loc
cond [Alt loc]
altList) =
                [Doc] -> Doc
myFsep [String -> Doc
text String
"case", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
cond, String -> Doc
text String
"of"]
                Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
caseIndent ((Alt loc -> Doc) -> [Alt loc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Alt loc -> Doc
forall a. Pretty a => a -> Doc
pretty [Alt loc]
altList)
        pretty (P.Do loc
_ [Stmt loc]
stmtList) =
                String -> Doc
text String
"do" Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
doIndent ((Stmt loc -> Doc) -> [Stmt loc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Stmt loc -> Doc
forall a. Pretty a => a -> Doc
pretty [Stmt loc]
stmtList)
        pretty (P.MDo loc
_ [Stmt loc]
stmtList) =
                String -> Doc
text String
"mdo" Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
doIndent ((Stmt loc -> Doc) -> [Stmt loc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Stmt loc -> Doc
forall a. Pretty a => a -> Doc
pretty [Stmt loc]
stmtList)
        pretty (P.Var loc
_ QName loc
name) = QName loc -> Doc
forall a. Pretty a => a -> Doc
pretty QName loc
name
        pretty (P.OverloadedLabel loc
_ String
name) = String -> Doc
text String
name
        pretty (P.IPVar loc
_ IPName loc
ipname) = IPName loc -> Doc
forall a. Pretty a => a -> Doc
pretty IPName loc
ipname
        pretty (P.Con loc
_ QName loc
name) = QName loc -> Doc
forall a. Pretty a => a -> Doc
pretty QName loc
name
        pretty (P.TupleSection loc
_ Boxed
bxd [Maybe (PExp loc)]
mExpList) =
                let ds :: [Doc]
ds = (Maybe (PExp loc) -> Doc) -> [Maybe (PExp loc)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((PExp loc -> Doc) -> Maybe (PExp loc) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty) [Maybe (PExp loc)]
mExpList
                in case Boxed
bxd of
                       Boxed
Boxed   -> [Doc] -> Doc
parenList [Doc]
ds
                       Boxed
Unboxed -> [Doc] -> Doc
hashParenList [Doc]
ds
        pretty (P.UnboxedSum loc
_ Indent
before Indent
after PExp loc
exp) =
          Indent -> Indent -> PExp loc -> Doc
forall e. Pretty e => Indent -> Indent -> e -> Doc
printUnboxedSum Indent
before Indent
after PExp loc
exp
        pretty (P.Paren loc
_ PExp loc
e) = Doc -> Doc
parens (Doc -> Doc) -> (PExp loc -> Doc) -> PExp loc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty (PExp loc -> Doc) -> PExp loc -> Doc
forall a b. (a -> b) -> a -> b
$ PExp loc
e
        pretty (P.RecConstr loc
_ QName loc
c [PFieldUpdate loc]
fieldList) =
                QName loc -> Doc
forall a. Pretty a => a -> Doc
pretty QName loc
c Doc -> Doc -> Doc
<> ([Doc] -> Doc
braceList ([Doc] -> Doc)
-> ([PFieldUpdate loc] -> [Doc]) -> [PFieldUpdate loc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PFieldUpdate loc -> Doc) -> [PFieldUpdate loc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map PFieldUpdate loc -> Doc
forall a. Pretty a => a -> Doc
pretty ([PFieldUpdate loc] -> Doc) -> [PFieldUpdate loc] -> Doc
forall a b. (a -> b) -> a -> b
$ [PFieldUpdate loc]
fieldList)
        pretty (P.RecUpdate loc
_ PExp loc
e [PFieldUpdate loc]
fieldList) =
                PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
e Doc -> Doc -> Doc
<> ([Doc] -> Doc
braceList ([Doc] -> Doc)
-> ([PFieldUpdate loc] -> [Doc]) -> [PFieldUpdate loc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PFieldUpdate loc -> Doc) -> [PFieldUpdate loc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map PFieldUpdate loc -> Doc
forall a. Pretty a => a -> Doc
pretty ([PFieldUpdate loc] -> Doc) -> [PFieldUpdate loc] -> Doc
forall a b. (a -> b) -> a -> b
$ [PFieldUpdate loc]
fieldList)
        pretty (P.List loc
_ [PExp loc]
list) =
                [Doc] -> Doc
bracketList ([Doc] -> Doc) -> ([PExp loc] -> [Doc]) -> [PExp loc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> ([PExp loc] -> [Doc]) -> [PExp loc] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PExp loc -> Doc) -> [PExp loc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty ([PExp loc] -> Doc) -> [PExp loc] -> Doc
forall a b. (a -> b) -> a -> b
$ [PExp loc]
list
        pretty (P.ParArray loc
_ [PExp loc]
arr) =
                [Doc] -> Doc
bracketColonList ([Doc] -> Doc) -> ([PExp loc] -> [Doc]) -> [PExp loc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> ([PExp loc] -> [Doc]) -> [PExp loc] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PExp loc -> Doc) -> [PExp loc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty ([PExp loc] -> Doc) -> [PExp loc] -> Doc
forall a b. (a -> b) -> a -> b
$ [PExp loc]
arr
        pretty (P.EnumFrom loc
_ PExp loc
e) =
                [Doc] -> Doc
bracketList [PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
e, String -> Doc
text String
".."]
        pretty (P.EnumFromTo loc
_ PExp loc
from PExp loc
to) =
                [Doc] -> Doc
bracketList [PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
from, String -> Doc
text String
"..", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
to]
        pretty (P.EnumFromThen loc
_ PExp loc
from PExp loc
thenE) =
                [Doc] -> Doc
bracketList [PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
from Doc -> Doc -> Doc
<> Doc
comma, PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
thenE, String -> Doc
text String
".."]
        pretty (P.EnumFromThenTo loc
_ PExp loc
from PExp loc
thenE PExp loc
to) =
                [Doc] -> Doc
bracketList [PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
from Doc -> Doc -> Doc
<> Doc
comma, PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
thenE,
                             String -> Doc
text String
"..", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
to]
        pretty (P.ParArrayFromTo loc
_ PExp loc
from PExp loc
to) =
                [Doc] -> Doc
bracketColonList [PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
from, String -> Doc
text String
"..", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
to]
        pretty (P.ParArrayFromThenTo loc
_ PExp loc
from PExp loc
thenE PExp loc
to) =
                [Doc] -> Doc
bracketColonList [PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
from Doc -> Doc -> Doc
<> Doc
comma, PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
thenE,
                             String -> Doc
text String
"..", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
to]
        pretty (P.ParComp loc
_ PExp loc
e [[QualStmt loc]]
qualLists) =
                [Doc] -> Doc
bracketList (Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
intersperse (Char -> Doc
char Char
'|') ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$
                                PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
e Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc])
-> ([[QualStmt loc]] -> [Doc]) -> [[QualStmt loc]] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([QualStmt loc] -> [Doc]) -> [[QualStmt loc]] -> [Doc]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((QualStmt loc -> Doc) -> [QualStmt loc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map QualStmt loc -> Doc
forall a. Pretty a => a -> Doc
pretty) ([[QualStmt loc]] -> [Doc]) -> [[QualStmt loc]] -> [Doc]
forall a b. (a -> b) -> a -> b
$ [[QualStmt loc]]
qualLists))
        pretty (P.ParArrayComp loc
_ PExp loc
e [[QualStmt loc]]
qualArrs) =
                [Doc] -> Doc
bracketColonList (Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
intersperse (Char -> Doc
char Char
'|') ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$
                                PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
e Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc])
-> ([[QualStmt loc]] -> [Doc]) -> [[QualStmt loc]] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([QualStmt loc] -> [Doc]) -> [[QualStmt loc]] -> [Doc]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((QualStmt loc -> Doc) -> [QualStmt loc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map QualStmt loc -> Doc
forall a. Pretty a => a -> Doc
pretty) ([[QualStmt loc]] -> [Doc]) -> [[QualStmt loc]] -> [Doc]
forall a b. (a -> b) -> a -> b
$ [[QualStmt loc]]
qualArrs))
        pretty (P.ExpTypeSig loc
_pos PExp loc
e Type loc
ty) =
                [Doc] -> Doc
myFsep [PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
e, String -> Doc
text String
"::", Type loc -> Doc
forall a. Pretty a => a -> Doc
pretty Type loc
ty]
        pretty (P.BracketExp loc
_ Bracket loc
b) = Bracket loc -> Doc
forall a. Pretty a => a -> Doc
pretty Bracket loc
b
        pretty (P.SpliceExp loc
_ Splice loc
s) = Splice loc -> Doc
forall a. Pretty a => a -> Doc
pretty Splice loc
s
        pretty (P.TypQuote loc
_ QName loc
t)  = String -> Doc
text String
"\'\'" Doc -> Doc -> Doc
<> QName loc -> Doc
forall a. Pretty a => a -> Doc
pretty QName loc
t
        pretty (P.VarQuote loc
_ QName loc
x)  = String -> Doc
text String
"\'" Doc -> Doc -> Doc
<> QName loc -> Doc
forall a. Pretty a => a -> Doc
pretty QName loc
x
        pretty (P.QuasiQuote loc
_ String
n String
qt) = String -> Doc
text (String
"[$" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"|" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
qt String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"|]")
        pretty (P.XTag loc
_ XName loc
n [ParseXAttr loc]
attrs Maybe (PExp loc)
mattr [PExp loc]
cs) =
                let ax :: [Doc]
ax = [Doc] -> (PExp loc -> [Doc]) -> Maybe (PExp loc) -> [Doc]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Doc -> [Doc]
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> [Doc]) -> (PExp loc -> Doc) -> PExp loc -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty) Maybe (PExp loc)
mattr
                 in [Doc] -> Doc
hcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
                     ([Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Char -> Doc
char Char
'<' Doc -> Doc -> Doc
<> XName loc -> Doc
forall a. Pretty a => a -> Doc
pretty XName loc
n)Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (ParseXAttr loc -> Doc) -> [ParseXAttr loc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ParseXAttr loc -> Doc
forall a. Pretty a => a -> Doc
pretty [ParseXAttr loc]
attrs [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc]
ax [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Char -> Doc
char Char
'>'])Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:
                        (PExp loc -> Doc) -> [PExp loc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty [PExp loc]
cs [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [[Doc] -> Doc
myFsep [String -> Doc
text String
"</" Doc -> Doc -> Doc
<> XName loc -> Doc
forall a. Pretty a => a -> Doc
pretty XName loc
n, Char -> Doc
char Char
'>']]
        pretty (P.XETag loc
_ XName loc
n [ParseXAttr loc]
attrs Maybe (PExp loc)
mattr) =
                let ax :: [Doc]
ax = [Doc] -> (PExp loc -> [Doc]) -> Maybe (PExp loc) -> [Doc]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Doc -> [Doc]
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> [Doc]) -> (PExp loc -> Doc) -> PExp loc -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty) Maybe (PExp loc)
mattr
                 in [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Char -> Doc
char Char
'<' Doc -> Doc -> Doc
<> XName loc -> Doc
forall a. Pretty a => a -> Doc
pretty XName loc
n)Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (ParseXAttr loc -> Doc) -> [ParseXAttr loc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ParseXAttr loc -> Doc
forall a. Pretty a => a -> Doc
pretty [ParseXAttr loc]
attrs [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc]
ax [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"/>"]
        pretty (P.XPcdata loc
_ String
s) = String -> Doc
text String
s
        pretty (P.XExpTag loc
_ PExp loc
e) =
                [Doc] -> Doc
myFsep [String -> Doc
text String
"<%", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
e, String -> Doc
text String
"%>"]
        pretty (P.XChildTag loc
_ [PExp loc]
es) =
                [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"<%>" Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (PExp loc -> Doc) -> [PExp loc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty [PExp loc]
es [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"</%>"]
        pretty (P.CorePragma loc
_ String
s PExp loc
e) = [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text [String
"{-# CORE", String -> String
forall a. Show a => a -> String
show String
s, String
"#-}"] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
e]
        pretty (P.SCCPragma  loc
_ String
s PExp loc
e) = [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text [String
"{-# SCC",  String -> String
forall a. Show a => a -> String
show String
s, String
"#-}"] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
e]
        pretty (P.GenPragma  loc
_ String
s (Indent
a,Indent
b) (Indent
c,Indent
d) PExp loc
e) =
                [Doc] -> Doc
myFsep [String -> Doc
text String
"{-# GENERATED", String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. Show a => a -> String
show String
s,
                            Indent -> Doc
int Indent
a, Char -> Doc
char Char
':', Indent -> Doc
int Indent
b, Char -> Doc
char Char
'-',
                            Indent -> Doc
int Indent
c, Char -> Doc
char Char
':', Indent -> Doc
int Indent
d, String -> Doc
text String
"#-}", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
e]
        pretty (P.Proc loc
_ Pat loc
p PExp loc
e) = [Doc] -> Doc
myFsep [String -> Doc
text String
"proc", Pat loc -> Doc
forall a. Pretty a => a -> Doc
pretty Pat loc
p, String -> Doc
text String
"->", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
e]
        pretty (P.LeftArrApp loc
_ PExp loc
l PExp loc
r)      = [Doc] -> Doc
myFsep [PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
l, String -> Doc
text String
"-<",  PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
r]
        pretty (P.RightArrApp loc
_ PExp loc
l PExp loc
r)     = [Doc] -> Doc
myFsep [PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
l, String -> Doc
text String
">-",  PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
r]
        pretty (P.LeftArrHighApp loc
_ PExp loc
l PExp loc
r)  = [Doc] -> Doc
myFsep [PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
l, String -> Doc
text String
"-<<", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
r]
        pretty (P.RightArrHighApp loc
_ PExp loc
l PExp loc
r) = [Doc] -> Doc
myFsep [PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
l, String -> Doc
text String
">>-", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
r]
        pretty (P.ArrOp loc
_ PExp loc
e) = [Doc] -> Doc
myFsep [String -> Doc
text String
"(|", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
e, String -> Doc
text String
"|)"]
        pretty (P.AsPat loc
_ Name loc
name (P.IrrPat loc
_ PExp loc
pat)) =
                [Doc] -> Doc
myFsep [Name loc -> Doc
forall a. Pretty a => a -> Doc
pretty Name loc
name Doc -> Doc -> Doc
<> Char -> Doc
char Char
'@', Char -> Doc
char Char
'~' Doc -> Doc -> Doc
<> PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
pat]
        pretty (P.AsPat loc
_ Name loc
name PExp loc
pat) =
                [Doc] -> Doc
hcat [Name loc -> Doc
forall a. Pretty a => a -> Doc
pretty Name loc
name, Char -> Doc
char Char
'@', PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
pat]
        pretty (P.WildCard loc
_) = Char -> Doc
char Char
'_'
        pretty (P.IrrPat loc
_ PExp loc
pat) = Char -> Doc
char Char
'~' Doc -> Doc -> Doc
<> PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
pat
        pretty (P.PostOp loc
_ PExp loc
e QOp loc
op) = PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
e Doc -> Doc -> Doc
<+> QOp loc -> Doc
forall a. Pretty a => a -> Doc
pretty QOp loc
op
        pretty (P.PreOp loc
_ QOp loc
op PExp loc
e)  = QOp loc -> Doc
forall a. Pretty a => a -> Doc
pretty QOp loc
op Doc -> Doc -> Doc
<+> PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
e
        pretty (P.ViewPat loc
_ PExp loc
e Pat loc
p) =
                [Doc] -> Doc
myFsep [PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
e, String -> Doc
text String
"->", Pat loc -> Doc
forall a. Pretty a => a -> Doc
pretty Pat loc
p]
        pretty (P.SeqRP loc
_ [PExp loc]
rs) =
            [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"(|" Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> ([PExp loc] -> [Doc]) -> [PExp loc] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PExp loc -> Doc) -> [PExp loc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty ([PExp loc] -> [Doc]) -> [PExp loc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ [PExp loc]
rs) [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"|)"]
        pretty (P.GuardRP loc
_ PExp loc
r [Stmt loc]
gs) =
                [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"(|" Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
r Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: Char -> Doc
char Char
'|' Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:
                           (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> ([Stmt loc] -> [Doc]) -> [Stmt loc] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stmt loc -> Doc) -> [Stmt loc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Stmt loc -> Doc
forall a. Pretty a => a -> Doc
pretty ([Stmt loc] -> [Doc]) -> [Stmt loc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ [Stmt loc]
gs) [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"|)"]
        pretty (P.EitherRP loc
_ PExp loc
r1 PExp loc
r2) = Doc -> Doc
parens (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
r1, Char -> Doc
char Char
'|', PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
r2]
        pretty (P.CAsRP loc
_ Name loc
n (P.IrrPat loc
_ PExp loc
e)) =
                [Doc] -> Doc
myFsep [Name loc -> Doc
forall a. Pretty a => a -> Doc
pretty Name loc
n Doc -> Doc -> Doc
<> String -> Doc
text String
"@:", Char -> Doc
char Char
'~' Doc -> Doc -> Doc
<> PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
e]
        pretty (P.CAsRP loc
_ Name loc
n PExp loc
r) = [Doc] -> Doc
hcat [Name loc -> Doc
forall a. Pretty a => a -> Doc
pretty Name loc
n, String -> Doc
text String
"@:", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
r]
        pretty (P.XRPats loc
_ [PExp loc]
ps) =
                [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"<[" Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (PExp loc -> Doc) -> [PExp loc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty [PExp loc]
ps [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text String
"%>"]
        pretty (P.BangPat loc
_ PExp loc
e) = String -> Doc
text String
"!" Doc -> Doc -> Doc
<> PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
e
        pretty (P.LCase loc
_ [Alt loc]
altList) = String -> Doc
text String
"\\case" Doc -> Doc -> Doc
$$$ (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody PPHsMode -> Indent
caseIndent ((Alt loc -> Doc) -> [Alt loc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Alt loc -> Doc
forall a. Pretty a => a -> Doc
pretty [Alt loc]
altList)
        pretty (P.TypeApp loc
_ Type loc
ty) = Char -> Doc
char Char
'@' Doc -> Doc -> Doc
<> Type loc -> Doc
forall a. Pretty a => a -> Doc
pretty Type loc
ty

instance SrcInfo loc => Pretty (P.PFieldUpdate loc) where
        pretty :: PFieldUpdate loc -> Doc
pretty (P.FieldUpdate loc
_ QName loc
name PExp loc
e) =
                [Doc] -> Doc
myFsep [QName loc -> Doc
forall a. Pretty a => a -> Doc
pretty QName loc
name, Doc
equals, PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
e]
        pretty (P.FieldPun loc
_ QName loc
name) = QName loc -> Doc
forall a. Pretty a => a -> Doc
pretty QName loc
name
        pretty (P.FieldWildcard loc
_) = String -> Doc
text String
".."

instance SrcInfo loc => Pretty (P.ParseXAttr loc) where
        pretty :: ParseXAttr loc -> Doc
pretty (P.XAttr loc
_ XName loc
n PExp loc
v) =
                [Doc] -> Doc
myFsep [XName loc -> Doc
forall a. Pretty a => a -> Doc
pretty XName loc
n, Char -> Doc
char Char
'=', PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
v]

instance SrcInfo loc => Pretty (P.PContext loc) where
        pretty :: PContext loc -> Doc
pretty (P.CxEmpty loc
_) = [Doc] -> Doc
mySep [String -> Doc
text String
"()", String -> Doc
text String
"=>"]
        pretty (P.CxSingle loc
_ PAsst loc
asst) = [Doc] -> Doc
mySep [PAsst loc -> Doc
forall a. Pretty a => a -> Doc
pretty PAsst loc
asst, String -> Doc
text String
"=>"]
        pretty (P.CxTuple loc
_ [PAsst loc]
assts) = [Doc] -> Doc
myFsep [[Doc] -> Doc
parenList ((PAsst loc -> Doc) -> [PAsst loc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map PAsst loc -> Doc
forall a. Pretty a => a -> Doc
pretty [PAsst loc]
assts), String -> Doc
text String
"=>"]

instance SrcInfo loc => Pretty (P.PAsst loc) where
        pretty :: PAsst loc -> Doc
pretty (P.TypeA loc
_ PType loc
t)       = PType loc -> Doc
forall a. Pretty a => a -> Doc
pretty PType loc
t
        pretty (P.IParam loc
_ IPName loc
i PType loc
t)    = [Doc] -> Doc
myFsep [IPName loc -> Doc
forall a. Pretty a => a -> Doc
pretty IPName loc
i, String -> Doc
text String
"::", PType loc -> Doc
forall a. Pretty a => a -> Doc
pretty PType loc
t]
        pretty (P.ParenA loc
_ PAsst loc
a)      = Doc -> Doc
parens (PAsst loc -> Doc
forall a. Pretty a => a -> Doc
pretty PAsst loc
a)

instance SrcInfo loc => Pretty (P.PType loc) where
        prettyPrec :: Indent -> PType loc -> Doc
prettyPrec Indent
p (P.TyForall loc
_ Maybe [TyVarBind loc]
mtvs Maybe (PContext loc)
ctxt PType loc
htype) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
0) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
                [Doc] -> Doc
myFsep [Maybe [TyVarBind loc] -> Doc
forall l. Maybe [TyVarBind l] -> Doc
ppForall Maybe [TyVarBind loc]
mtvs, (PContext loc -> Doc) -> Maybe (PContext loc) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP PContext loc -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (PContext loc)
ctxt, PType loc -> Doc
forall a. Pretty a => a -> Doc
pretty PType loc
htype]
        prettyPrec Indent
_ (P.TyStar loc
_) = String -> Doc
text String
"*"
        prettyPrec Indent
p (P.TyFun loc
_ PType loc
a PType loc
b) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
0) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
                [Doc] -> Doc
myFsep [Indent -> PType loc -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
prec_btype PType loc
a, String -> Doc
text String
"->", PType loc -> Doc
forall a. Pretty a => a -> Doc
pretty PType loc
b]
        prettyPrec Indent
_ (P.TyTuple loc
_ Boxed
bxd [PType loc]
l) =
                let ds :: [Doc]
ds = (PType loc -> Doc) -> [PType loc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map PType loc -> Doc
forall a. Pretty a => a -> Doc
pretty [PType loc]
l
                 in case Boxed
bxd of
                        Boxed
Boxed   -> [Doc] -> Doc
parenList [Doc]
ds
                        Boxed
Unboxed -> [Doc] -> Doc
hashParenList [Doc]
ds
        prettyPrec Indent
_ (P.TyUnboxedSum loc
_ [PType loc]
es) =
          [Doc] -> Doc
unboxedSumType ((PType loc -> Doc) -> [PType loc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map PType loc -> Doc
forall a. Pretty a => a -> Doc
pretty [PType loc]
es)
        prettyPrec Indent
_ (P.TyList loc
_ PType loc
t)  = Doc -> Doc
brackets (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ PType loc -> Doc
forall a. Pretty a => a -> Doc
pretty PType loc
t
        prettyPrec Indent
_ (P.TyParArray loc
_ PType loc
t) = [Doc] -> Doc
bracketColonList [PType loc -> Doc
forall a. Pretty a => a -> Doc
pretty PType loc
t]
        prettyPrec Indent
p (P.TyApp loc
_ PType loc
a PType loc
b) =
                {-
                | a == list_tycon = brackets $ pretty b         -- special case
                | otherwise = -} Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> Indent
prec_btype) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
                                    [Doc] -> Doc
myFsep [PType loc -> Doc
forall a. Pretty a => a -> Doc
pretty PType loc
a, Indent -> PType loc -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
prec_atype PType loc
b]
        prettyPrec Indent
_ (P.TyVar loc
_ Name loc
name) = Name loc -> Doc
forall a. Pretty a => a -> Doc
pretty Name loc
name
        prettyPrec Indent
_ (P.TyCon loc
_ QName loc
name) = QName loc -> Doc
forall a. Pretty a => a -> Doc
pretty QName loc
name
        prettyPrec Indent
_ (P.TyParen loc
_ PType loc
t) = Doc -> Doc
parens (PType loc -> Doc
forall a. Pretty a => a -> Doc
pretty PType loc
t)
        prettyPrec Indent
_ (P.TyPred loc
_ PAsst loc
asst) = PAsst loc -> Doc
forall a. Pretty a => a -> Doc
pretty PAsst loc
asst
        prettyPrec Indent
_ (P.TyInfix loc
_ PType loc
a MaybePromotedName loc
op PType loc
b) = [Doc] -> Doc
myFsep [PType loc -> Doc
forall a. Pretty a => a -> Doc
pretty PType loc
a, MaybePromotedName loc -> Doc
forall a. Pretty a => a -> Doc
pretty MaybePromotedName loc
op, PType loc -> Doc
forall a. Pretty a => a -> Doc
pretty PType loc
b]
        prettyPrec Indent
_ (P.TyKind loc
_ PType loc
t Kind loc
k) = Doc -> Doc
parens ([Doc] -> Doc
myFsep [PType loc -> Doc
forall a. Pretty a => a -> Doc
pretty PType loc
t, String -> Doc
text String
"::", Kind loc -> Doc
forall a. Pretty a => a -> Doc
pretty Kind loc
k])
        prettyPrec Indent
_ (P.TyPromoted loc
_ Promoted loc
p) = Promoted loc -> Doc
forall a. Pretty a => a -> Doc
pretty Promoted loc
p
        prettyPrec Indent
_ (P.TyEquals loc
_ PType loc
a PType loc
b) = [Doc] -> Doc
myFsep [PType loc -> Doc
forall a. Pretty a => a -> Doc
pretty PType loc
a, String -> Doc
text String
"~", PType loc -> Doc
forall a. Pretty a => a -> Doc
pretty PType loc
b]
        prettyPrec Indent
_ (P.TySplice loc
_ Splice loc
s) = Splice loc -> Doc
forall a. Pretty a => a -> Doc
pretty Splice loc
s
        prettyPrec Indent
_ (P.TyBang loc
_ BangType loc
b Unpackedness loc
u PType loc
t) = Unpackedness loc -> Doc
forall a. Pretty a => a -> Doc
pretty Unpackedness loc
u Doc -> Doc -> Doc
<+> BangType loc -> Doc
forall a. Pretty a => a -> Doc
pretty BangType loc
b Doc -> Doc -> Doc
<> Indent -> PType loc -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec Indent
prec_atype PType loc
t
        prettyPrec Indent
_ (P.TyWildCard loc
_ Maybe (Name loc)
mn) = Char -> Doc
char Char
'_' Doc -> Doc -> Doc
<> (Name loc -> Doc) -> Maybe (Name loc) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP Name loc -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (Name loc)
mn
        prettyPrec Indent
_ (P.TyQuasiQuote loc
_ String
n String
qt) = String -> Doc
text (String
"[$" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"|" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
qt String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"|]")