{-# 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 = 8,
                      doIndent :: Indent
doIndent = 3,
                      multiIfIndent :: Indent
multiIfIndent = 3,
                      caseIndent :: Indent
caseIndent = 4,
                      letIndent :: Indent
letIndent = 4,
                      whereIndent :: Indent
whereIndent = 6,
                      onsideIndent :: Indent
onsideIndent = 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 f :: a -> b
f xs :: 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 m :: DocM s a
m k :: 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
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
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 m :: DocM s a
m k :: 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
s -> case DocM s a -> s -> a
forall s a. DocM s a -> s -> a
unDocM DocM s a
m s
s of _ -> 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
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 f :: 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 0
        prettyPrec _ = 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 i :: Indent
i m :: 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 d :: 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 d :: 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 d :: 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 d :: 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 True = Doc -> Doc
parens
parensIf 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
aM :: Doc
aM <> :: Doc -> Doc -> Doc
<> bM :: 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)}
aM :: Doc
aM <+> :: Doc -> Doc -> Doc
<+> bM :: 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)}
aM :: Doc
aM $$ :: Doc -> Doc -> Doc
$$ bM :: 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
aM :: Doc
aM $+$ :: Doc -> Doc -> Doc
$+$ bM :: 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 dl :: [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 dl :: [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 dl :: [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 dl :: [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 _ []     = []
punctuate p :: Doc
p (d1 :: Doc
d1:ds :: [Doc]
ds) = Doc -> [Doc] -> [Doc]
go Doc
d1 [Doc]
ds
                   where
                     go :: Doc -> [Doc] -> [Doc]
go d :: Doc
d [] = [Doc
d]
                     go d :: Doc
d (e :: Doc
e:es :: [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 ppStyle :: Style
ppStyle ppMode :: PPHsMode
ppMode d :: 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 ppStyle :: Style
ppStyle ppMode :: 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 pphs :: PPHsMode
pphs doc :: 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 _ m :: ModuleName l
m mbWarn :: Maybe (WarningText l)
mbWarn mbExportList :: Maybe (ExportSpecList l)
mbExportList) =
    [Doc] -> Doc
mySep [
        String -> Doc
text "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 "where"]

instance Pretty (ExportSpecList l) where
        pretty :: ExportSpecList l -> Doc
pretty (ExportSpecList _ especs :: [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 _ s :: String
s) = [Doc] -> Doc
mySep [String -> Doc
text "{-# DEPRECATED", String -> Doc
text (String -> String
forall a. Show a => a -> String
show String
s), String -> Doc
text "#-}"]
ppWarnTxt (WarnText _ s :: String
s) = [Doc] -> Doc
mySep [String -> Doc
text "{-# WARNING",    String -> Doc
text (String -> String
forall a. Show a => a -> String
show String
s), String -> Doc
text "#-}"]

instance  Pretty (ModuleName l) where
        pretty :: ModuleName l -> Doc
pretty (ModuleName _ modName :: 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 "type"
        pretty PatternNamespace {} = String -> Doc
text "pattern"

instance  Pretty (ExportSpec l) where
        pretty :: ExportSpec l -> Doc
pretty (EVar _ name :: QName l
name)                = QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
name
        pretty (EAbs _ ns :: Namespace l
ns name :: 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 _ wc :: EWildcard l
wc name :: QName l
name nameList :: [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 _ n :: Indent
n  ->
                          let (before :: [Doc]
before,after :: [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 ".."] [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 _ m :: ModuleName l
m)        = String -> Doc
text "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 _ m :: ModuleName l
m qual :: Bool
qual src :: Bool
src safe :: Bool
safe mbPkg :: Maybe String
mbPkg mbName :: Maybe (ModuleName l)
mbName mbSpecs :: Maybe (ImportSpecList l)
mbSpecs) =
                [Doc] -> Doc
mySep [String -> Doc
text "import",
                       if Bool
src  then String -> Doc
text "{-# SOURCE #-}" else Doc
empty,
                       if Bool
safe then String -> Doc
text "safe" else Doc
empty,
                       if Bool
qual then String -> Doc
text "qualified" else Doc
empty,
                       (String -> Doc) -> Maybe String -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
maybePP (\s :: 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 (\m' :: ModuleName l
m' -> String -> Doc
text "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 _ b :: Bool
b ispecs :: [ImportSpec l]
ispecs)  =
            (if Bool
b then String -> Doc
text "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 _ name :: Name l
name  )              = Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
name
        pretty (IAbs _ ns :: Namespace l
ns name :: 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 _ name :: Name l
name)           = Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
name Doc -> Doc -> Doc
<> String -> Doc
text "(..)"
        pretty (IThingWith _ name :: Name l
name nameList :: [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 _ pat :: Type l
pat eqn :: 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 _ = Bool
True

condBlankline :: PrettyDeclLike a => a -> Doc
condBlankline :: a -> Doc
condBlankline d :: 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 True  ds :: [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 False (d :: a
d:ds :: [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 _ _ = []
--ppDecls = map condBlankline

instance Pretty (InjectivityInfo l) where
  pretty :: InjectivityInfo l -> Doc
pretty (InjectivityInfo _ from :: Name l
from to :: [Name l]
to) =
    Char -> Doc
char '|' Doc -> Doc -> Doc
<+> Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
from Doc -> Doc -> Doc
<+> String -> Doc
text "->" 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 _ kind :: Kind l
kind) = String -> Doc
text "::" Doc -> Doc -> Doc
<+> Kind l -> Doc
forall a. Pretty a => a -> Doc
pretty Kind l
kind
  pretty (TyVarSig _ tv :: TyVarBind l
tv)  = Char -> Doc
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 _ dHead :: DeclHead l
dHead htype :: Type l
htype) =
                [Doc] -> Doc
mySep ( [String -> Doc
text "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 _ don :: DataOrNew l
don context :: Maybe (Context l)
context dHead :: DeclHead l
dHead constrList :: [QualConDecl l]
constrList derives :: [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 '|'))
                                             ((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 _ don :: DataOrNew l
don context :: Maybe (Context l)
context dHead :: DeclHead l
dHead optkind :: Maybe (Type l)
optkind gadtList :: [GadtDecl l]
gadtList derives :: [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 "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 _ dHead :: DeclHead l
dHead optkind :: Maybe (ResultSig l)
optkind optinj :: Maybe (InjectivityInfo l)
optinj) =
                [Doc] -> Doc
mySep ([String -> Doc
text "type", String -> Doc
text "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 _ dHead :: DeclHead l
dHead optkind :: Maybe (ResultSig l)
optkind optinj :: Maybe (InjectivityInfo l)
optinj eqns :: [TypeEqn l]
eqns) =
                [Doc] -> Doc
mySep ([String -> Doc
text "type", String -> Doc
text "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 "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 _ context :: Maybe (Context l)
context dHead :: DeclHead l
dHead optkind :: Maybe (ResultSig l)
optkind) =
                [Doc] -> Doc
mySep ( [String -> Doc
text "data", String -> Doc
text "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 _ ntype :: Type l
ntype htype :: Type l
htype) =
                [Doc] -> Doc
mySep [String -> Doc
text "type", String -> Doc
text "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 _ don :: DataOrNew l
don ntype :: Type l
ntype constrList :: [QualConDecl l]
constrList derives :: [Deriving l]
derives) =
                [Doc] -> Doc
mySep [DataOrNew l -> Doc
forall a. Pretty a => a -> Doc
pretty DataOrNew l
don, String -> Doc
text "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 '|'))
                                                   ((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 _ don :: DataOrNew l
don ntype :: Type l
ntype optkind :: Maybe (Type l)
optkind gadtList :: [GadtDecl l]
gadtList derives :: [Deriving l]
derives) =
                [Doc] -> Doc
mySep ( [DataOrNew l -> Doc
forall a. Pretty a => a -> Doc
pretty DataOrNew l
don, String -> Doc
text "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 "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 _ context :: Maybe (Context l)
context dHead :: DeclHead l
dHead fundeps :: [FunDep l]
fundeps Nothing) =
                [Doc] -> Doc
mySep ( [String -> Doc
text "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 _ context :: Maybe (Context l)
context dHead :: DeclHead l
dHead fundeps :: [FunDep l]
fundeps declList :: Maybe [ClassDecl l]
declList) =
                [Doc] -> Doc
mySep ( [String -> Doc
text "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 "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 _ moverlap :: Maybe (Overlap l)
moverlap iHead :: InstRule l
iHead Nothing) =
                  [Doc] -> Doc
mySep ( [String -> Doc
text "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 _ overlap :: Maybe (Overlap l)
overlap iHead :: InstRule l
iHead declList :: Maybe [InstDecl l]
declList) =
                [Doc] -> Doc
mySep ( [ String -> Doc
text "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 "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 _ mds :: Maybe (DerivStrategy l)
mds overlap :: Maybe (Overlap l)
overlap irule :: InstRule l
irule) =
                  [Doc] -> Doc
mySep ( [ String -> Doc
text "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 "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 _ htypes :: [Type l]
htypes) =
                String -> Doc
text "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 _ splice :: Exp l
splice) =
                Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
splice

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

        pretty (TypeSig _ nameList :: [Name l]
nameList qualType :: 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 "::", 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 _ ns :: [Name l]
ns mtvs :: Maybe [TyVarBind l]
mtvs prov :: Maybe (Context l)
prov mtvs2 :: Maybe [TyVarBind l]
mtvs2 req :: Maybe (Context l)
req t :: 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 "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 "::", 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 _ matches :: [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 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)
                          _ -> [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 _ pat :: Pat l
pat rhs :: Rhs l
rhs whereBinds :: 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 _ assoc :: Assoc l
assoc prec :: Maybe Indent
prec opList :: [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 _ pat :: Pat l
pat rhs :: Pat l
rhs dir :: PatternSynDirection l
dir) =
                let sep :: String
sep = case PatternSynDirection l
dir of
                            ImplicitBidirectional {}   -> "="
                            ExplicitBidirectional {}   -> "<-"
                            Unidirectional {}          -> "<-"
                in
                 ([Doc] -> Doc
mySep ([String -> Doc
text "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 _ ds :: [Decl l]
ds ->
                        Indent -> Doc -> Doc
nest 2 (String -> Doc
text "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))
                      _ -> Doc
empty)

        pretty (ForImp _ cconv :: CallConv l
cconv saf :: Maybe (Safety l)
saf str :: Maybe String
str name :: Name l
name typ :: Type l
typ) =
                [Doc] -> Doc
mySep [String -> Doc
text "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 "::", Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
typ]

        pretty (ForExp _ cconv :: CallConv l
cconv str :: Maybe String
str name :: Name l
name typ :: Type l
typ) =
                [Doc] -> Doc
mySep [String -> Doc
text "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 "::", Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
typ]

        pretty (RulePragmaDecl _ rules :: [Rule l]
rules) =
                [Doc] -> Doc
myVcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "{-# 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 " #-}"]

        pretty (DeprPragmaDecl _ deprs :: [([Name l], String)]
deprs) =
                [Doc] -> Doc
myVcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "{-# 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 " #-}"]

        pretty (WarnPragmaDecl _ deprs :: [([Name l], String)]
deprs) =
                [Doc] -> Doc
myVcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "{-# 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 " #-}"]

        pretty (InlineSig _ inl :: Bool
inl activ :: Maybe (Activation l)
activ name :: QName l
name) =
                [Doc] -> Doc
mySep [String -> Doc
text (if Bool
inl then "{-# INLINE" else "{-# 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 "#-}"]

        pretty (InlineConlikeSig _ activ :: Maybe (Activation l)
activ name :: QName l
name) =
                [Doc] -> Doc
mySep [ String -> Doc
text "{-# 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 "#-}"]

        pretty (SpecSig _ activ :: Maybe (Activation l)
activ name :: QName l
name types :: [Type l]
types) =
                [Doc] -> Doc
mySep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [String -> Doc
text "{-# 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 "::"]
                         [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 "#-}"]

        pretty (SpecInlineSig _ inl :: Bool
inl activ :: Maybe (Activation l)
activ name :: QName l
name types :: [Type l]
types) =
                [Doc] -> Doc
mySep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [String -> Doc
text "{-# SPECIALISE", String -> Doc
text (if Bool
inl then "INLINE" else "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 "::"]
                        [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 "#-}"]

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

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

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

        pretty (RoleAnnotDecl _ qn :: QName l
qn rs :: [Role l]
rs) =
                [Doc] -> Doc
mySep ( [String -> Doc
text "type", String -> Doc
text "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 _ cls :: [Name l]
cls opt_ts :: 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 (\tc :: QName l
tc -> String -> Doc
text "::" 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 "{-# 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 "#-}"]

instance Pretty (InstRule l) where
    pretty :: InstRule l -> Doc
pretty (IRule _ tvs :: Maybe [TyVarBind l]
tvs mctxt :: Maybe (Context l)
mctxt qn :: 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 _ ih :: 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 _ qn :: QName l
qn)          = QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
qn
    pretty (IHInfix _ ta :: Type l
ta qn :: 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 _ ih :: InstHead l
ih)        = Doc -> Doc
parens (InstHead l -> Doc
forall a. Pretty a => a -> Doc
pretty InstHead l
ih)
    pretty (IHApp _ ih :: InstHead l
ih t :: 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 _ n :: Name l
n e :: 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 _ n :: Name l
n e :: Exp l
e) = [Doc] -> Doc
myFsep [String -> Doc
text "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 _ e :: Exp l
e) = [Doc] -> Doc
myFsep [String -> Doc
text "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 _ n :: Name l
n)   = Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
n
        pretty (AndFormula _ bs :: [BooleanFormula l]
bs)  = [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate (String -> Doc
text " ,") ([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 _ bs :: [BooleanFormula l]
bs)   = [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate (String -> Doc
text " |") ([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 _ b :: 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 '_'
        pretty Nominal{}          = String -> Doc
text "nominal"
        pretty Representational{} = String -> Doc
text "representational"
        pretty Phantom{}          = String -> Doc
text "phantom"

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

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

instance  Pretty (Match l) where
        pretty :: Match l -> Doc
pretty (InfixMatch _ l :: Pat l
l op :: Name l
op rs :: [Pat l]
rs rhs :: Rhs l
rhs wbinds :: Maybe (Binds l)
wbinds) =
          let
              lhs :: [Doc]
lhs = case [Pat l]
rs of
                      []  -> [] -- Should never reach
                      (r :: Pat l
r:rs' :: [Pat l]
rs') ->
                        let hd :: [Doc]
hd = [Indent -> Pat l -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec 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 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 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 _ f :: Name l
f ps :: [Pat l]
ps rhs :: Rhs l
rhs whereBinds :: 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 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 Nothing            = Doc
empty
ppWhere (Just (BDecls _ l :: [Decl l]
l))  = Indent -> Doc -> Doc
nest 2 (String -> Doc
text "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 _ b :: [IPBind l]
b)) = Indent -> Doc -> Doc
nest 2 (String -> Doc
text "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 _ d :: Decl l
d) = Decl l -> Bool
forall a. PrettyDeclLike a => a -> Bool
wantsBlankline Decl l
d
    wantsBlankline (ClsDefSig {}) = Bool
True
    wantsBlankline _ = Bool
False

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

    pretty (ClsDataFam _ context :: Maybe (Context l)
context declHead :: DeclHead l
declHead optkind :: Maybe (ResultSig l)
optkind) =
                [Doc] -> Doc
mySep ( [String -> Doc
text "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 _ declHead :: DeclHead l
declHead optkind :: Maybe (ResultSig l)
optkind optinj :: Maybe (InjectivityInfo l)
optinj) =
                [Doc] -> Doc
mySep ( [String -> Doc
text "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 _ ntype :: TypeEqn l
ntype) =
                [Doc] -> Doc
mySep [String -> Doc
text "type", TypeEqn l -> Doc
forall a. Pretty a => a -> Doc
pretty TypeEqn l
ntype]

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

instance Pretty (DeclHead l) where
  pretty :: DeclHead l -> Doc
pretty (DHead _ n :: Name l
n) = Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
n
  pretty (DHInfix _ tv :: TyVarBind l
tv n :: 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 _ d :: DeclHead l
d) = Doc -> Doc
parens (DeclHead l -> Doc
forall a. Pretty a => a -> Doc
pretty DeclHead l
d)
  pretty (DHApp _ dh :: DeclHead l
dh tv :: 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 _ d :: Decl l
d) = Decl l -> Bool
forall a. PrettyDeclLike a => a -> Bool
wantsBlankline Decl l
d
    wantsBlankline _ = Bool
False

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

        pretty (InsType _ ntype :: Type l
ntype htype :: Type l
htype) =
                [Doc] -> Doc
mySep [String -> Doc
text "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 _ don :: DataOrNew l
don ntype :: Type l
ntype constrList :: [QualConDecl l]
constrList derives :: [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 '|'))
                                                   ((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 _ don :: DataOrNew l
don ntype :: Type l
ntype optkind :: Maybe (Type l)
optkind gadtList :: [GadtDecl l]
gadtList derives :: [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 "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 "unsafe"
        pretty (PlaySafe _ b :: Bool
b)      = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ if Bool
b then "threadsafe" else "safe"
        pretty PlayInterruptible {} = String -> Doc
text "interruptible"

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

------------------------- Pragmas ---------------------------------------
ppWarnDepr :: ([Name l], String) -> Doc
ppWarnDepr :: ([Name l], String) -> Doc
ppWarnDepr (names :: [Name l]
names, txt :: 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 _ tag :: String
tag activ :: Maybe (Activation l)
activ rvs :: Maybe [RuleVar l]
rvs rhs :: Exp l
rhs lhs :: 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 '=', 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 rvs :: [RuleVar l]
rvs = [Doc] -> Doc
mySep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "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 '.']

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

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

instance  Pretty (RuleVar l) where
    pretty :: RuleVar l -> Doc
pretty (RuleVar _ n :: Name l
n) = Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
n
    pretty (TypedRuleVar _ n :: Name l
n t :: 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 "::", 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 opt :: Doc
opt s :: String
s =
  case String
s of
    ('\n':_) -> Doc
opt Doc -> Doc -> Doc
<> String -> Doc
text String
s Doc -> Doc -> Doc
<> String -> Doc
text "#-}"
    _ ->  [Doc] -> Doc
myFsep [Doc
opt, String -> Doc
text String
s Doc -> Doc -> Doc
<> String -> Doc
text "#-}"]

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


instance Pretty Tool where
    pretty :: Tool -> Doc
pretty (UnknownTool s :: String
s) = String -> Doc
text String
s
    pretty t :: 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 _pos :: l
_pos tvs :: Maybe [TyVarBind l]
tvs ctxt :: Maybe (Context l)
ctxt con :: 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 _pos :: l
_pos name :: Name l
name tvs :: Maybe [TyVarBind l]
tvs ctxt :: Maybe (Context l)
ctxt names :: Maybe [FieldDecl l]
names ty :: Type l
ty) =
            case Maybe [FieldDecl l]
names of
                Nothing ->
                    [Doc] -> Doc
myFsep [Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
name, String -> Doc
text "::", Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
ty]
                Just ts' :: [FieldDecl l]
ts' ->
                    [Doc] -> Doc
myFsep [Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
name, String -> Doc
text "::" , 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 "->", Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
ty]

instance  Pretty (ConDecl l) where
        pretty :: ConDecl l -> Doc
pretty (RecDecl _ name :: Name l
name fieldList :: [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 _ name :: Name l
name typeList :: [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 :: Name l
name r :: 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 _ names :: [Name l]
names ty :: 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 "::", 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 '!'
        pretty LazyTy {}    = Char -> Doc
char '~'
        pretty NoStrictAnnot {} = Doc
empty

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

instance Pretty (Deriving l) where
  pretty :: Deriving l -> Doc
pretty (Deriving _ mds :: Maybe (DerivStrategy l)
mds d :: [InstRule l]
d) =
    [Doc] -> Doc
hsep [ String -> Doc
text "deriving"
         , Doc
pp_strat_before
         , Doc
pp_dct
         , Doc
pp_strat_after ]
    where
      pp_dct :: Doc
pp_dct =
        case [InstRule l]
d of
          [d' :: InstRule l
d'] -> InstRule l -> Doc
forall a. Pretty a => a -> Doc
pretty InstRule l
d'
          _    -> [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.
      (pp_strat_before :: Doc
pp_strat_before, pp_strat_after :: 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)
          _                     -> ((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 ds :: DerivStrategy l
ds =
    case DerivStrategy l
ds of
      DerivStock _    -> String -> Doc
text "stock"
      DerivAnyclass _ -> String -> Doc
text "anyclass"
      DerivNewtype _  -> String -> Doc
text "newtype"
      DerivVia _ ty :: Type l
ty   -> String -> Doc
text "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 = 1  -- left argument of ->,
                -- or either argument of an infix data constructor
prec_atype :: Indent
prec_atype = 2  -- argument of type or data constructor, or of a class

instance  Pretty (Type l) where
        prettyPrec :: Indent -> Type l -> Doc
prettyPrec p :: Indent
p (TyForall _ mtvs :: Maybe [TyVarBind l]
mtvs ctxt :: Maybe (Context l)
ctxt htype :: Type l
htype) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> 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 _ (TyStar _) = String -> Doc
text "*"
        prettyPrec p :: Indent
p (TyFun _ a :: Type l
a b :: Type l
b) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> 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 "->", Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
b]
        prettyPrec _ (TyTuple _ bxd :: Boxed
bxd l :: [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   -> [Doc] -> Doc
parenList [Doc]
ds
                        Unboxed -> [Doc] -> Doc
hashParenList [Doc]
ds
        prettyPrec _ (TyUnboxedSum _ es :: [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 _ (TyList _ t :: 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 _ (TyParArray _ t :: Type l
t) = [Doc] -> Doc
bracketColonList [Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
t]
        prettyPrec p :: Indent
p (TyApp _ a :: Type l
a b :: 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 _ (TyVar _ name :: Name l
name) = Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
name
        prettyPrec _ (TyCon _ name :: QName l
name) = QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
name
        prettyPrec _ (TyParen _ t :: Type l
t) = Doc -> Doc
parens (Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
t)
        prettyPrec _ (TyInfix _ a :: Type l
a op :: MaybePromotedName l
op b :: 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 _ (TyKind _ t :: Type l
t k :: 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 "::", Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
k])
        prettyPrec _ (TyPromoted _ p :: Promoted l
p) = Promoted l -> Doc
forall a. Pretty a => a -> Doc
pretty Promoted l
p
        prettyPrec p :: Indent
p (TyEquals _ a :: Type l
a b :: Type l
b) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> 0) ([Doc] -> Doc
myFsep [Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
a, String -> Doc
text "~", Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
b])
        prettyPrec _ (TySplice _ s :: Splice l
s) = Splice l -> Doc
forall a. Pretty a => a -> Doc
pretty Splice l
s
        prettyPrec _ (TyBang _ b :: BangType l
b u :: Unpackedness l
u t :: 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 _ (TyWildCard _ mn :: Maybe (Name l)
mn) = Char -> Doc
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 _ (TyQuasiQuote _ n :: String
n qt :: String
qt) = String -> Doc
text ("[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ "|" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
qt String -> String -> String
forall a. [a] -> [a] -> [a]
++ "|]")

instance Pretty (MaybePromotedName l) where
  pretty :: MaybePromotedName l -> Doc
pretty (PromotedName _ q :: QName l
q) = Char -> Doc
char '\'' Doc -> Doc -> Doc
<> QName l -> Doc
forall l. QName l -> Doc
ppQNameInfix QName l
q
  pretty (UnpromotedName _ q :: 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 p :: Promoted l
p =
    case Promoted l
p of
      PromotedInteger _ n :: Integer
n _ -> Integer -> Doc
integer Integer
n
      PromotedString _ s :: String
s _ -> Doc -> Doc
doubleQuotes (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
s
      PromotedCon _ hasQuote :: Bool
hasQuote qn :: QName l
qn ->
        Bool -> Doc -> Doc
addQuote Bool
hasQuote (QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
qn)
      PromotedList _ hasQuote :: Bool
hasQuote list :: [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 _ list :: [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 "()"
    where
      addQuote :: Bool -> Doc -> Doc
addQuote True doc :: Doc
doc = Char -> Doc
char '\'' Doc -> Doc -> Doc
<> Doc
doc
      addQuote False doc :: Doc
doc = Doc
doc

instance  Pretty (TyVarBind l) where
        pretty :: TyVarBind l -> Doc
pretty (KindedVar _ var :: Name l
var kind :: 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 "::", Kind l -> Doc
forall a. Pretty a => a -> Doc
pretty Kind l
kind]
        pretty (UnkindedVar _ var :: 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 Nothing   = Doc
empty
ppForall (Just []) = Doc
empty
ppForall (Just vs :: [TyVarBind l]
vs) =    [Doc] -> Doc
myFsep (String -> Doc
text "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 '.'])

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

ppOptKind :: Maybe (Kind l) -> [Doc]
ppOptKind :: Maybe (Kind l) -> [Doc]
ppOptKind Nothing  = []
ppOptKind (Just k :: Kind l
k) = [String -> Doc
text "::", 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 _ from :: [Name l]
from to :: [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 "->"] [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 fds :: [FunDep l]
fds = [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Char -> Doc
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 _ e :: Exp l
e) = Doc
equals Doc -> Doc -> Doc
<+> Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e
        pretty (GuardedRhss _ guardList :: [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 _pos :: l
_pos guards :: [Stmt l]
guards ppBody' :: Exp l
ppBody') =
                [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [Char -> Doc
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 _ e :: Exp l
e)) = String -> Doc
text "->" Doc -> Doc -> Doc
<+> Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e
        pretty (GuardedAlts (GuardedRhss _ guardList :: [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 _pos :: l
_pos guards :: [Stmt l]
guards ppBody' :: Exp l
ppBody')) =
                [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [Char -> Doc
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 "->", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
ppBody']

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

instance  Pretty (Exp l) where
        prettyPrec :: Indent -> Exp l -> Doc
prettyPrec _ (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 p :: Indent
p (InfixApp _ a :: Exp l
a op :: QOp l
op b :: Exp l
b) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> 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 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 1 Exp l
b]
        prettyPrec p :: Indent
p (NegApp _ e :: Exp l
e) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> 0) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Char -> Doc
char '-' Doc -> Doc -> Doc
<> Indent -> Exp l -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec 2 Exp l
e
        prettyPrec p :: Indent
p (App _ a :: Exp l
a b :: Exp l
b) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> 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 3 Exp l
a, Indent -> Exp l -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec 4 Exp l
b]
        prettyPrec p :: Indent
p (Lambda _loc :: l
_loc patList :: [Pat l]
patList ppBody' :: Exp l
ppBody') = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> 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 '\\' 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 3) [Pat l]
patList [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text "->", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
ppBody']
        -- keywords
        -- two cases for lets
        prettyPrec p :: Indent
p (Let _ (BDecls _ declList :: [Decl l]
declList) letBody :: Exp l
letBody) =
                Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> 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 p :: Indent
p (Let _ (IPBinds _ bindList :: [IPBind l]
bindList) letBody :: Exp l
letBody) =
                Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> 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 p :: Indent
p (If _ cond :: Exp l
cond thenexp :: Exp l
thenexp elsexp :: Exp l
elsexp) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> 1) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
                [Doc] -> Doc
myFsep [String -> Doc
text "if", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
cond,
                        String -> Doc
text "then", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
thenexp,
                        String -> Doc
text "else", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
elsexp]
        prettyPrec p :: Indent
p (MultiIf _ alts :: [GuardedRhs l]
alts) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> 1) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
                String -> Doc
text "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 p :: Indent
p (Case _ cond :: Exp l
cond altList :: [Alt l]
altList) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> 1) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
                [Doc] -> Doc
myFsep ([String -> Doc
text "case", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
cond, String -> Doc
text "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 -> Doc
text "}"] 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 p :: Indent
p (Do _ stmtList :: [Stmt l]
stmtList) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> 1) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
                String -> Doc
text "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 p :: Indent
p (MDo _ stmtList :: [Stmt l]
stmtList) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> 1) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
                String -> Doc
text "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 _ (Var _ name :: QName l
name) = QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
name
        prettyPrec _ (OverloadedLabel _ name :: String
name) = String -> Doc
text ('#'Char -> String -> String
forall a. a -> [a] -> [a]
:String
name)
        prettyPrec _ (IPVar _ ipname :: IPName l
ipname) = IPName l -> Doc
forall a. Pretty a => a -> Doc
pretty IPName l
ipname
        prettyPrec _ (Con _ name :: QName l
name) = QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
name
        prettyPrec _ (Tuple _ bxd :: Boxed
bxd expList :: [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   -> [Doc] -> Doc
parenList [Doc]
ds
                       Unboxed -> [Doc] -> Doc
hashParenList [Doc]
ds
        prettyPrec _ (UnboxedSum _ before :: Indent
before after :: Indent
after exp :: 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 _ (TupleSection _ bxd :: Boxed
bxd mExpList :: [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   -> [Doc] -> Doc
parenList [Doc]
ds
                       Unboxed -> [Doc] -> Doc
hashParenList [Doc]
ds
        -- weird stuff
        prettyPrec _ (Paren _ e :: 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 _ (LeftSection _ e :: Exp l
e op :: 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 _ (RightSection _ op :: QOp l
op e :: 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 _ (RecConstr _ c :: QName l
c fieldList :: [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 _ (RecUpdate _ e :: Exp l
e fieldList :: [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 _ (List _ list :: [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 _ (ParArray _ arr :: [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 _ (EnumFrom _ e :: Exp l
e) =
                [Doc] -> Doc
bracketList [Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e, String -> Doc
text ".."]
        prettyPrec _ (EnumFromTo _ from :: Exp l
from to :: Exp l
to) =
                [Doc] -> Doc
bracketList [Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
from, String -> Doc
text "..", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
to]
        prettyPrec _ (EnumFromThen _ from :: Exp l
from thenE :: 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 ".."]
        prettyPrec _ (EnumFromThenTo _ from :: Exp l
from thenE :: Exp l
thenE to :: 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 "..", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
to]
        prettyPrec _ (ParArrayFromTo _ from :: Exp l
from to :: Exp l
to) =
                [Doc] -> Doc
bracketColonList [Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
from, String -> Doc
text "..", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
to]
        prettyPrec _ (ParArrayFromThenTo _ from :: Exp l
from thenE :: Exp l
thenE to :: 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 "..", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
to]
        prettyPrec _ (ListComp _ e :: Exp l
e qualList :: [QualStmt l]
qualList) =
                [Doc] -> Doc
bracketList ([Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e, Char -> Doc
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 _ (ParComp _ e :: Exp l
e qualLists :: [[QualStmt l]]
qualLists) =
                [Doc] -> Doc
bracketList (Doc -> [Doc] -> [Doc]
punctuate (Char -> Doc
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 _ (ParArrayComp _ e :: Exp l
e qualArrs :: [[QualStmt l]]
qualArrs) =
                [Doc] -> Doc
bracketColonList (Doc -> [Doc] -> [Doc]
punctuate (Char -> Doc
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 p :: Indent
p (ExpTypeSig _pos :: l
_pos e :: Exp l
e ty :: Type l
ty) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> 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 "::", Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
ty]
        -- Template Haskell
        prettyPrec _ (BracketExp _ b :: Bracket l
b) = Bracket l -> Doc
forall a. Pretty a => a -> Doc
pretty Bracket l
b
        prettyPrec _ (SpliceExp _ s :: Splice l
s) = Splice l -> Doc
forall a. Pretty a => a -> Doc
pretty Splice l
s
        prettyPrec _ (TypQuote _ t :: QName l
t)  = String -> Doc
text "\'\'" Doc -> Doc -> Doc
<> QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
t
        prettyPrec _ (VarQuote _ x :: QName l
x)  = String -> Doc
text "\'" Doc -> Doc -> Doc
<> QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
x
        prettyPrec _ (QuasiQuote _ n :: String
n qt :: String
qt) = String -> Doc
text ("[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ "|" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
qt String -> String -> String
forall a. [a] -> [a] -> [a]
++ "|]")
        -- Hsx
        prettyPrec _ (XTag _ n :: XName l
n attrs :: [XAttr l]
attrs mattr :: Maybe (Exp l)
mattr cs :: [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 '<' 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 '>'])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 "</" Doc -> Doc -> Doc
<> XName l -> Doc
forall a. Pretty a => a -> Doc
pretty XName l
n, Char -> Doc
char '>']]
        prettyPrec _ (XETag _ n :: XName l
n attrs :: [XAttr l]
attrs mattr :: 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 '<' 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 "/>"]
        prettyPrec _ (XPcdata _ s :: String
s) = String -> Doc
text String
s
        prettyPrec _ (XExpTag _ e :: Exp l
e) =
                [Doc] -> Doc
myFsep [String -> Doc
text "<%", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e, String -> Doc
text "%>"]
        prettyPrec _ (XChildTag _ cs :: [Exp l]
cs) =
                [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "<%>" 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 "</%>"]

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

        -- LamdaCase
        prettyPrec p :: Indent
p (LCase _ altList :: [Alt l]
altList) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> 1) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
                [Doc] -> Doc
myFsep (String -> Doc
text "\\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 -> Doc
text "}"] 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 _ (TypeApp _ ty :: Type l
ty)   = Char -> Doc
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 before :: Indent
before after :: Indent
after exp :: 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 "|")
                                [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 "|")))


instance  Pretty (XAttr l) where
        pretty :: XAttr l -> Doc
pretty (XAttr _ n :: XName l
n v :: Exp l
v) =
                [Doc] -> Doc
myFsep [XName l -> Doc
forall a. Pretty a => a -> Doc
pretty XName l
n, Char -> Doc
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 _ n :: String
n) = String -> Doc
text String
n
        pretty (XDomName _ d :: String
d n :: String
n) = String -> Doc
text String
d Doc -> Doc -> Doc
<> Char -> Doc
char ':' Doc -> Doc -> Doc
<> String -> Doc
text String
n

ppLetExp :: (PrettyDeclLike a, Pretty b) => [a] -> b -> Doc
ppLetExp :: [a] -> b -> Doc
ppLetExp l :: [a]
l b :: b
b = [Doc] -> Doc
myFsep [String -> Doc
text "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 "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 _ e :: Exp l
e) = String -> Exp l -> Doc
forall a. Pretty a => String -> a -> Doc
ppBracket "[|" Exp l
e
        pretty (TExpBracket _ e :: Exp l
e) = [Doc] -> Doc
myFsep [String -> Doc
text "[||", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e, String -> Doc
text "||]"]
        pretty (PatBracket _ p :: Pat l
p) = String -> Pat l -> Doc
forall a. Pretty a => String -> a -> Doc
ppBracket "[p|" Pat l
p
        pretty (TypeBracket _ t :: Type l
t) = String -> Type l -> Doc
forall a. Pretty a => String -> a -> Doc
ppBracket "[t|" Type l
t
        pretty (DeclBracket _ d :: [Decl l]
d) =
                [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "[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 "|]"]

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

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

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

instance  Pretty (Pat l) where
        prettyPrec :: Indent -> Pat l -> Doc
prettyPrec _ (PVar _ name :: Name l
name) = Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
name
        prettyPrec _ (PLit _ (Signless {}) lit :: Literal l
lit) = Literal l -> Doc
forall a. Pretty a => a -> Doc
pretty Literal l
lit
        prettyPrec p :: Indent
p (PLit _ (Negative{}) lit :: Literal l
lit) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> 1) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Char -> Doc
char '-' Doc -> Doc -> Doc
<> Literal l -> Doc
forall a. Pretty a => a -> Doc
pretty Literal l
lit
        prettyPrec p :: Indent
p (PInfixApp l :: l
l a :: Pat l
a op :: QName l
op b :: Pat l
b) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> 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 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 1 Pat l
b]
        prettyPrec p :: Indent
p (PApp _ n :: QName l
n ps :: [Pat l]
ps) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> 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 3) [Pat l]
ps)
        prettyPrec _ (PTuple _ bxd :: Boxed
bxd ps :: [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   -> [Doc] -> Doc
parenList [Doc]
ds
                       Unboxed -> [Doc] -> Doc
hashParenList [Doc]
ds
        prettyPrec _ (PUnboxedSum _ before :: Indent
before after :: Indent
after exp :: 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 _ (PList _ ps :: [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 _ (PParen _ pat :: 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 _ (PRec _ c :: QName l
c fields :: [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 _ (PAsPat _ name :: Name l
name (PIrrPat _ pat :: 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 -> Doc
char '~' Doc -> Doc -> Doc
<> Indent -> Pat l -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec 3 Pat l
pat]
        prettyPrec _ (PAsPat _ name :: Name l
name pat :: Pat l
pat) =
                [Doc] -> Doc
hcat [Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
name, Char -> Doc
char '@', Indent -> Pat l -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec 3 Pat l
pat]
        prettyPrec _ PWildCard {} = Char -> Doc
char '_'
        prettyPrec _ (PIrrPat _ pat :: Pat l
pat) = Char -> Doc
char '~' Doc -> Doc -> Doc
<> Indent -> Pat l -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec 3 Pat l
pat
        prettyPrec p :: Indent
p (PatTypeSig _pos :: l
_pos pat :: Pat l
pat ty :: Type l
ty) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> 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 "::", Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
ty]
        prettyPrec p :: Indent
p (PViewPat _ e :: Exp l
e pat :: Pat l
pat) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> 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 "->", Pat l -> Doc
forall a. Pretty a => a -> Doc
pretty Pat l
pat]
        prettyPrec p :: Indent
p (PNPlusK _ n :: Name l
n k :: Integer
k) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> 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 -> 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 _ (PRPat _ rs :: [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 _ (PXTag _ n :: XName l
n attrs :: [PXAttr l]
attrs mattr :: Maybe (Pat l)
mattr cp :: [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 '<' 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 '>'])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 "</" Doc -> Doc -> Doc
<> XName l -> Doc
forall a. Pretty a => a -> Doc
pretty XName l
n, Char -> Doc
char '>']]
        prettyPrec _ (PXETag _ n :: XName l
n attrs :: [PXAttr l]
attrs mattr :: 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 '<' 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 "/>"]
        prettyPrec _ (PXPcdata _ s :: String
s) = String -> Doc
text String
s
        prettyPrec _ (PXPatTag _ p :: Pat l
p) =
                [Doc] -> Doc
myFsep [String -> Doc
text "<%", Pat l -> Doc
forall a. Pretty a => a -> Doc
pretty Pat l
p, String -> Doc
text "%>"]
        prettyPrec _ (PXRPats _ ps :: [RPat l]
ps) =
                [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "<[" 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 "%>"]
        -- BangPatterns
        prettyPrec _ (PBangPat _ pat :: Pat l
pat) = String -> Doc
text "!" Doc -> Doc -> Doc
<> Indent -> Pat l -> Doc
forall a. Pretty a => Indent -> a -> Doc
prettyPrec 3 Pat l
pat
        prettyPrec _ (PSplice _ s :: Splice l
s) = Splice l -> Doc
forall a. Pretty a => a -> Doc
pretty Splice l
s
        prettyPrec _ (PQuasiQuote _ n :: String
n qt :: String
qt) = String -> Doc
text ("[$" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ "|" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
qt String -> String -> String
forall a. [a] -> [a] -> [a]
++ "|]")

instance  Pretty (PXAttr l) where
        pretty :: PXAttr l -> Doc
pretty (PXAttr _ n :: XName l
n p :: Pat l
p) =
                [Doc] -> Doc
myFsep [XName l -> Doc
forall a. Pretty a => a -> Doc
pretty XName l
n, Char -> Doc
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 _ name :: QName l
name pat :: 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 _ name :: QName l
name) = QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
name
        pretty (PFieldWildcard{}) = String -> Doc
text ".."

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

instance  Pretty (RPat l) where
        pretty :: RPat l -> Doc
pretty (RPOp _ r :: RPat l
r op :: 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 _ r1 :: RPat l
r1 r2 :: 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 '|', RPat l -> Doc
forall a. Pretty a => a -> Doc
pretty RPat l
r2]
        pretty (RPSeq _ rs :: [RPat l]
rs) =
                [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "(|" 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 "|)"]
        pretty (RPGuard _ r :: Pat l
r gs :: [Stmt l]
gs) =
                [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "(|" 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 '|' 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 "|)"]
        -- special case that would otherwise be buggy
        pretty (RPCAs _ n :: Name l
n (RPPat _ (PIrrPat _ p :: 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 "@:", Char -> Doc
char '~' Doc -> Doc -> Doc
<> Pat l -> Doc
forall a. Pretty a => a -> Doc
pretty Pat l
p]
        pretty (RPCAs _ n :: Name l
n r :: RPat l
r) = [Doc] -> Doc
hcat [Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
n, String -> Doc
text "@:", RPat l -> Doc
forall a. Pretty a => a -> Doc
pretty RPat l
r]
        -- special case that would otherwise be buggy
        pretty (RPAs _ n :: Name l
n (RPPat _ (PIrrPat _ p :: 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 "@:", Char -> Doc
char '~' Doc -> Doc -> Doc
<> Pat l -> Doc
forall a. Pretty a => a -> Doc
pretty Pat l
p]
        pretty (RPAs _ n :: Name l
n r :: RPat l
r) = [Doc] -> Doc
hcat [Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
n, Char -> Doc
char '@', RPat l -> Doc
forall a. Pretty a => a -> Doc
pretty RPat l
r]
        pretty (RPPat _ p :: Pat l
p) = Pat l -> Doc
forall a. Pretty a => a -> Doc
pretty Pat l
p
        pretty (RPParen _ rp :: 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 '*'
        pretty RPStarG{} = String -> Doc
text "*!"
        pretty RPPlus{}  = Char -> Doc
char '+'
        pretty RPPlusG{} = String -> Doc
text "+!"
        pretty RPOpt{}   = Char -> Doc
char '?'
        pretty RPOptG{}  = String -> Doc
text "?!"

------------------------- Case bodies  -------------------------
instance  Pretty (Alt l) where
        pretty :: Alt l -> Doc
pretty (Alt _pos :: l
_pos e :: Pat l
e gAlts :: Rhs l
gAlts binds :: 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 _loc :: l
_loc e :: Pat l
e from :: Exp l
from) =
                Pat l -> Doc
forall a. Pretty a => a -> Doc
pretty Pat l
e Doc -> Doc -> Doc
<+> String -> Doc
text "<-" Doc -> Doc -> Doc
<+> Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
from
        pretty (Qualifier _ e :: Exp l
e) = Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e
        -- two cases for lets
        pretty (LetStmt _ (BDecls _ declList :: [Decl l]
declList)) =
                [Decl l] -> Doc
forall a. Pretty a => [a] -> Doc
ppLetStmt [Decl l]
declList
        pretty (LetStmt _ (IPBinds _ bindList :: [IPBind l]
bindList)) =
                [IPBind l] -> Doc
forall a. Pretty a => [a] -> Doc
ppLetStmt [IPBind l]
bindList
        pretty (RecStmt _ stmtList :: [Stmt l]
stmtList) =
                String -> Doc
text "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 l :: [a]
l = String -> Doc
text "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 _ s :: Stmt l
s) = Stmt l -> Doc
forall a. Pretty a => a -> Doc
pretty Stmt l
s
        pretty (ThenTrans _ f :: Exp l
f)    = [Doc] -> Doc
myFsep [String -> Doc
text "then", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
f]
        pretty (ThenBy _ f :: Exp l
f e :: Exp l
e)  = [Doc] -> Doc
myFsep [String -> Doc
text "then", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
f, String -> Doc
text "by", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e]
        pretty (GroupBy _ e :: Exp l
e)    = [Doc] -> Doc
myFsep [String -> Doc
text "then", String -> Doc
text "group", String -> Doc
text "by", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e]
        pretty (GroupUsing _ f :: Exp l
f)    = [Doc] -> Doc
myFsep [String -> Doc
text "then", String -> Doc
text "group", String -> Doc
text "using", Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
f]
        pretty (GroupByUsing _ e :: Exp l
e f :: Exp l
f)  = [Doc] -> Doc
myFsep [String -> Doc
text "then", String -> Doc
text "group", String -> Doc
text "by",
                                                Exp l -> Doc
forall a. Pretty a => a -> Doc
pretty Exp l
e, String -> Doc
text "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 _ name :: QName l
name e :: 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 _ name :: QName l
name) = QName l -> Doc
forall a. Pretty a => a -> Doc
pretty QName l
name
        pretty (FieldWildcard {}) = String -> Doc
text ".."

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

ppQNameInfix :: QName l -> Doc
ppQNameInfix :: QName l -> Doc
ppQNameInfix name :: 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 '`' Doc -> Doc -> Doc
<> QName l -> Doc
forall l. QName l -> Doc
ppQName QName l
name Doc -> Doc -> Doc
<> Char -> Doc
char '`'

instance  Pretty (QName l) where
        pretty :: QName l -> Doc
pretty name :: QName l
name = case QName l
name of
                UnQual _ (Symbol _ ('#':_)) -> Char -> Doc
char '(' Doc -> Doc -> Doc
<+> QName l -> Doc
forall l. QName l -> Doc
ppQName QName l
name Doc -> Doc -> Doc
<+> Char -> Doc
char ')'
                _ -> 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 _ name :: Name l
name) = Name l -> Doc
forall l. Name l -> Doc
ppName Name l
name
ppQName (Qual _ m :: ModuleName l
m name :: Name l
name) = ModuleName l -> Doc
forall a. Pretty a => a -> Doc
pretty ModuleName l
m Doc -> Doc -> Doc
<> Char -> Doc
char '.' Doc -> Doc -> Doc
<> Name l -> Doc
forall l. Name l -> Doc
ppName Name l
name
ppQName (Special _ sym :: 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 _ n :: Name l
n) = Name l -> Doc
forall l. Name l -> Doc
ppNameInfix Name l
n
        pretty (ConOp _ n :: 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 :: 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 '`' Doc -> Doc -> Doc
<> Name l -> Doc
forall l. Name l -> Doc
ppName Name l
name Doc -> Doc -> Doc
<> Char -> Doc
char '`'

instance  Pretty (Name l) where
        pretty :: Name l -> Doc
pretty name :: Name l
name = case Name l
name of
                Symbol _ ('#':_) -> Char -> Doc
char '(' Doc -> Doc -> Doc
<+> Name l -> Doc
forall l. Name l -> Doc
ppName Name l
name Doc -> Doc -> Doc
<+> Char -> Doc
char ')'
                _ -> 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 _ s :: String
s) = String -> Doc
text String
s
ppName (Symbol _ s :: String
s) = String -> Doc
text String
s

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

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

instance  Pretty (IPBind l) where
        pretty :: IPBind l -> Doc
pretty (IPBind _loc :: l
_loc ipname :: IPName l
ipname exp :: 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 _ n :: Name l
n) = Name l -> Doc
forall a. Pretty a => a -> Doc
pretty Name l
n
        pretty (ConName _ n :: 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 "()"
        pretty (ListCon {})         = String -> Doc
text "[]"
        pretty (FunCon  {})         = String -> Doc
text "->"
        pretty (TupleCon _ b :: Boxed
b n :: 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
-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 ":"
        pretty (UnboxedSingleCon {}) = String -> Doc
text "(# #)"
        pretty (ExprHole {}) = String -> Doc
text "_"

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

isSymbolQName :: QName l -> Bool
isSymbolQName :: QName l -> Bool
isSymbolQName (UnQual _ n :: Name l
n)       = Name l -> Bool
forall l. Name l -> Bool
isSymbolName Name l
n
isSymbolQName (Qual _ _ n :: Name l
n)       = Name l -> Bool
forall l. Name l -> Bool
isSymbolName Name l
n
isSymbolQName (Special _ (Cons {}))   = Bool
True
isSymbolQName (Special _ (FunCon {})) = Bool
True
isSymbolQName _                  = 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 _)      = String -> Doc
text "()" Doc -> Doc -> Doc
<+> String -> Doc
text "=>"
  pretty (CxSingle _ ctxt :: Asst l
ctxt)  = Asst l -> Doc
forall a. Pretty a => a -> Doc
pretty Asst l
ctxt Doc -> Doc -> Doc
<+> String -> Doc
text "=>"
  pretty (CxTuple _ context :: [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 "=>"]

instance  Pretty (Asst l) where
        pretty :: Asst l -> Doc
pretty (TypeA _ t :: Type l
t)       = Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
t
        pretty (IParam _ i :: IPName l
i t :: Type l
t)    = [Doc] -> Doc
myFsep [IPName l -> Doc
forall a. Pretty a => a -> Doc
pretty IPName l
i, String -> Doc
text "::", Type l -> Doc
forall a. Pretty a => a -> Doc
pretty Type l
t]
        pretty (ParenA _ a :: 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
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 p :: Doc
p = [Doc] -> Doc
P.hcat [ Doc
p, Doc
P.colon ]


instance Pretty SrcSpan where
    pretty :: SrcSpan -> Doc
pretty srcSpan :: 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 "("
                                 , 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 -> Doc
P.text "-"
                        , [Doc] -> Doc
P.hcat [ String -> Doc
P.text "("
                                 , 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 ")"
                                 ]
                        ]

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


-------------------------  Pretty-Print a Module --------------------
instance Pretty (Module pos) where
        pretty :: Module pos -> Doc
pretty (Module _ mbHead :: Maybe (ModuleHead pos)
mbHead os :: [ModulePragma pos]
os imp :: [ImportDecl pos]
imp decls :: [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
                        Nothing -> [Doc] -> [Doc]
forall a. a -> a
id
                        Just h :: ModuleHead pos
h  -> \x :: [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 _ _mn :: ModuleName pos
_mn os :: [ModulePragma pos]
os n :: XName pos
n attrs :: [XAttr pos]
attrs mattr :: Maybe (Exp pos)
mattr cs :: [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 '<' 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 '>'])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 "</" Doc -> Doc -> Doc
<> XName pos -> Doc
forall a. Pretty a => a -> Doc
pretty XName pos
n, Char -> Doc
char '>']]]
        pretty (XmlHybrid _ mbHead :: Maybe (ModuleHead pos)
mbHead os :: [ModulePragma pos]
os imp :: [ImportDecl pos]
imp decls :: [Decl pos]
decls n :: XName pos
n attrs :: [XAttr pos]
attrs mattr :: Maybe (Exp pos)
mattr cs :: [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 "<%"] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++
                    (case Maybe (ModuleHead pos)
mbHead of
                        Nothing -> [Doc] -> [Doc]
forall a. a -> a
id
                        Just h :: ModuleHead pos
h  -> \x :: [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 '<' 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 '>'])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 "</" Doc -> Doc -> Doc
<> XName pos -> Doc
forall a. Pretty a => a -> Doc
pretty XName pos
n, Char -> Doc
char '>']]])



------------------------- pp utils -------------------------
maybePP :: (a -> Doc) -> Maybe a -> Doc
maybePP :: (a -> Doc) -> Maybe a -> Doc
maybePP _  Nothing = Doc
empty
maybePP pp :: a -> Doc
pp (Just a :: 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 " |")

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
doc = Char -> Doc
char '#' Doc -> Doc -> Doc
<+> Doc
doc Doc -> Doc -> Doc
<+> Char -> Doc
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
doc = Char -> Doc
char ':' Doc -> Doc -> Doc
<> Doc
doc Doc -> Doc -> Doc
<> Char -> Doc
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 dl :: 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 "" Doc -> Doc -> Doc
$+$ Doc
dl else Doc
dl}
topLevel :: Doc -> [Doc] -> Doc
topLevel :: Doc -> [Doc] -> Doc
topLevel header :: Doc
header dl :: [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
             PPOffsideRule -> Doc
header Doc -> Doc -> Doc
$$ [Doc] -> Doc
vcat [Doc]
dl
             PPSemiColon -> Doc
header Doc -> Doc -> Doc
$$ [Doc] -> Doc
prettyBlock [Doc]
dl
             PPInLine -> Doc
header Doc -> Doc -> Doc
$$ [Doc] -> Doc
prettyBlock [Doc]
dl
             PPNoLayout -> Doc
header Doc -> Doc -> Doc
<+> [Doc] -> Doc
flatBlock [Doc]
dl

ppBody :: (PPHsMode -> Int) -> [Doc] -> Doc
ppBody :: (PPHsMode -> Indent) -> [Doc] -> Doc
ppBody f :: PPHsMode -> Indent
f dl :: [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 PPOffsideRule -> Doc
indent
                   PPSemiColon   -> Doc
indentExplicit
                   _ -> [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 f :: PPHsMode -> Indent
f dl :: [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
a :: Doc
a $$$ :: Doc -> Doc -> Doc
$$$ b :: 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' [x :: Doc
x]    = Doc
x
        mySep' (x :: Doc
x:xs :: [Doc]
xs) = Doc
x Doc -> Doc -> Doc
<+> [Doc] -> Doc
fsep [Doc]
xs
        mySep' []     = String -> Doc
forall a. HasCallStack => String -> a
error "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' (d :: Doc
d:ds :: [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 :: a -> Doc
a b :: a -> Doc
b dl :: 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 _ l :: Literal loc
l) = Literal loc -> Doc
forall a. Pretty a => a -> Doc
pretty Literal loc
l
        pretty (P.InfixApp _ a :: PExp loc
a op :: QOp loc
op b :: 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 _ e :: PExp loc
e) = [Doc] -> Doc
myFsep [Char -> Doc
char '-', PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
e]
        pretty (P.App _ a :: PExp loc
a b :: 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
_loc expList :: [Pat loc]
expList ppBody' :: PExp loc
ppBody') = [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
                Char -> Doc
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 "->", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
ppBody']
        pretty (P.Let _ (BDecls _ declList :: [Decl loc]
declList) letBody :: 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 _ (IPBinds _ bindList :: [IPBind loc]
bindList) letBody :: 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 _ cond :: PExp loc
cond thenexp :: PExp loc
thenexp elsexp :: PExp loc
elsexp) =
                [Doc] -> Doc
myFsep [String -> Doc
text "if", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
cond,
                        String -> Doc
text "then", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
thenexp,
                        String -> Doc
text "else", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
elsexp]
        pretty (P.MultiIf _ alts :: [GuardedRhs loc]
alts) =
                String -> Doc
text "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 _ cond :: PExp loc
cond altList :: [Alt loc]
altList) =
                [Doc] -> Doc
myFsep [String -> Doc
text "case", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
cond, String -> Doc
text "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 _ stmtList :: [Stmt loc]
stmtList) =
                String -> Doc
text "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 _ stmtList :: [Stmt loc]
stmtList) =
                String -> Doc
text "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 _ name :: QName loc
name) = QName loc -> Doc
forall a. Pretty a => a -> Doc
pretty QName loc
name
        pretty (P.OverloadedLabel _ name :: String
name) = String -> Doc
text String
name
        pretty (P.IPVar _ ipname :: IPName loc
ipname) = IPName loc -> Doc
forall a. Pretty a => a -> Doc
pretty IPName loc
ipname
        pretty (P.Con _ name :: QName loc
name) = QName loc -> Doc
forall a. Pretty a => a -> Doc
pretty QName loc
name
        pretty (P.TupleSection _ bxd :: Boxed
bxd mExpList :: [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   -> [Doc] -> Doc
parenList [Doc]
ds
                       Unboxed -> [Doc] -> Doc
hashParenList [Doc]
ds
        pretty (P.UnboxedSum _ before :: Indent
before after :: Indent
after exp :: 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 _ e :: 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 _ c :: QName loc
c fieldList :: [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 _ e :: PExp loc
e fieldList :: [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 _ list :: [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 _ arr :: [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 _ e :: PExp loc
e) =
                [Doc] -> Doc
bracketList [PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
e, String -> Doc
text ".."]
        pretty (P.EnumFromTo _ from :: PExp loc
from to :: PExp loc
to) =
                [Doc] -> Doc
bracketList [PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
from, String -> Doc
text "..", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
to]
        pretty (P.EnumFromThen _ from :: PExp loc
from thenE :: 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 ".."]
        pretty (P.EnumFromThenTo _ from :: PExp loc
from thenE :: PExp loc
thenE to :: 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 "..", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
to]
        pretty (P.ParArrayFromTo _ from :: PExp loc
from to :: PExp loc
to) =
                [Doc] -> Doc
bracketColonList [PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
from, String -> Doc
text "..", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
to]
        pretty (P.ParArrayFromThenTo _ from :: PExp loc
from thenE :: PExp loc
thenE to :: 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 "..", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
to]
        pretty (P.ParComp _ e :: PExp loc
e qualLists :: [[QualStmt loc]]
qualLists) =
                [Doc] -> Doc
bracketList (Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
intersperse (Char -> Doc
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 _ e :: PExp loc
e qualArrs :: [[QualStmt loc]]
qualArrs) =
                [Doc] -> Doc
bracketColonList (Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
intersperse (Char -> Doc
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 _pos :: loc
_pos e :: PExp loc
e ty :: Type loc
ty) =
                [Doc] -> Doc
myFsep [PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
e, String -> Doc
text "::", Type loc -> Doc
forall a. Pretty a => a -> Doc
pretty Type loc
ty]
        pretty (P.BracketExp _ b :: Bracket loc
b) = Bracket loc -> Doc
forall a. Pretty a => a -> Doc
pretty Bracket loc
b
        pretty (P.SpliceExp _ s :: Splice loc
s) = Splice loc -> Doc
forall a. Pretty a => a -> Doc
pretty Splice loc
s
        pretty (P.TypQuote _ t :: QName loc
t)  = String -> Doc
text "\'\'" Doc -> Doc -> Doc
<> QName loc -> Doc
forall a. Pretty a => a -> Doc
pretty QName loc
t
        pretty (P.VarQuote _ x :: QName loc
x)  = String -> Doc
text "\'" Doc -> Doc -> Doc
<> QName loc -> Doc
forall a. Pretty a => a -> Doc
pretty QName loc
x
        pretty (P.QuasiQuote _ n :: String
n qt :: String
qt) = String -> Doc
text ("[$" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ "|" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
qt String -> String -> String
forall a. [a] -> [a] -> [a]
++ "|]")
        pretty (P.XTag _ n :: XName loc
n attrs :: [ParseXAttr loc]
attrs mattr :: Maybe (PExp loc)
mattr cs :: [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 '<' 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 '>'])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 "</" Doc -> Doc -> Doc
<> XName loc -> Doc
forall a. Pretty a => a -> Doc
pretty XName loc
n, Char -> Doc
char '>']]
        pretty (P.XETag _ n :: XName loc
n attrs :: [ParseXAttr loc]
attrs mattr :: 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 '<' 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 "/>"]
        pretty (P.XPcdata _ s :: String
s) = String -> Doc
text String
s
        pretty (P.XExpTag _ e :: PExp loc
e) =
                [Doc] -> Doc
myFsep [String -> Doc
text "<%", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
e, String -> Doc
text "%>"]
        pretty (P.XChildTag _ es :: [PExp loc]
es) =
                [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "<%>" 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 "</%>"]
        pretty (P.CorePragma _ s :: String
s e :: 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 ["{-# CORE", String -> String
forall a. Show a => a -> String
show String
s, "#-}"] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
e]
        pretty (P.SCCPragma  _ s :: String
s e :: 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 ["{-# SCC",  String -> String
forall a. Show a => a -> String
show String
s, "#-}"] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
e]
        pretty (P.GenPragma  _ s :: String
s (a :: Indent
a,b :: Indent
b) (c :: Indent
c,d :: Indent
d) e :: PExp loc
e) =
                [Doc] -> Doc
myFsep [String -> Doc
text "{-# 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 ':', Indent -> Doc
int Indent
b, Char -> Doc
char '-',
                            Indent -> Doc
int Indent
c, Char -> Doc
char ':', Indent -> Doc
int Indent
d, String -> Doc
text "#-}", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
e]
        pretty (P.Proc _ p :: Pat loc
p e :: PExp loc
e) = [Doc] -> Doc
myFsep [String -> Doc
text "proc", Pat loc -> Doc
forall a. Pretty a => a -> Doc
pretty Pat loc
p, String -> Doc
text "->", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
e]
        pretty (P.LeftArrApp _ l :: PExp loc
l r :: PExp loc
r)      = [Doc] -> Doc
myFsep [PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
l, String -> Doc
text "-<",  PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
r]
        pretty (P.RightArrApp _ l :: PExp loc
l r :: PExp loc
r)     = [Doc] -> Doc
myFsep [PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
l, String -> Doc
text ">-",  PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
r]
        pretty (P.LeftArrHighApp _ l :: PExp loc
l r :: PExp loc
r)  = [Doc] -> Doc
myFsep [PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
l, String -> Doc
text "-<<", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
r]
        pretty (P.RightArrHighApp _ l :: PExp loc
l r :: PExp loc
r) = [Doc] -> Doc
myFsep [PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
l, String -> Doc
text ">>-", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
r]
        pretty (P.ArrOp _ e :: PExp loc
e) = [Doc] -> Doc
myFsep [String -> Doc
text "(|", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
e, String -> Doc
text "|)"]
        pretty (P.AsPat _ name :: Name loc
name (P.IrrPat _ pat :: 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 -> Doc
char '~' Doc -> Doc -> Doc
<> PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
pat]
        pretty (P.AsPat _ name :: Name loc
name pat :: PExp loc
pat) =
                [Doc] -> Doc
hcat [Name loc -> Doc
forall a. Pretty a => a -> Doc
pretty Name loc
name, Char -> Doc
char '@', PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
pat]
        pretty (P.WildCard _) = Char -> Doc
char '_'
        pretty (P.IrrPat _ pat :: PExp loc
pat) = Char -> Doc
char '~' Doc -> Doc -> Doc
<> PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
pat
        pretty (P.PostOp _ e :: PExp loc
e op :: 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 _ op :: QOp loc
op e :: 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 _ e :: PExp loc
e p :: Pat loc
p) =
                [Doc] -> Doc
myFsep [PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
e, String -> Doc
text "->", Pat loc -> Doc
forall a. Pretty a => a -> Doc
pretty Pat loc
p]
        pretty (P.SeqRP _ rs :: [PExp loc]
rs) =
            [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "(|" 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 "|)"]
        pretty (P.GuardRP _ r :: PExp loc
r gs :: [Stmt loc]
gs) =
                [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "(|" 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 '|' 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 "|)"]
        pretty (P.EitherRP _ r1 :: PExp loc
r1 r2 :: 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 '|', PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
r2]
        pretty (P.CAsRP _ n :: Name loc
n (P.IrrPat _ e :: 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 "@:", Char -> Doc
char '~' Doc -> Doc -> Doc
<> PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
e]
        pretty (P.CAsRP _ n :: Name loc
n r :: PExp loc
r) = [Doc] -> Doc
hcat [Name loc -> Doc
forall a. Pretty a => a -> Doc
pretty Name loc
n, String -> Doc
text "@:", PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
r]
        pretty (P.XRPats _ ps :: [PExp loc]
ps) =
                [Doc] -> Doc
myFsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "<[" 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 "%>"]
        pretty (P.BangPat _ e :: PExp loc
e) = String -> Doc
text "!" Doc -> Doc -> Doc
<> PExp loc -> Doc
forall a. Pretty a => a -> Doc
pretty PExp loc
e
        pretty (P.LCase _ altList :: [Alt loc]
altList) = String -> Doc
text "\\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 _ ty :: Type loc
ty) = Char -> Doc
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 _ name :: QName loc
name e :: 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 _ name :: QName loc
name) = QName loc -> Doc
forall a. Pretty a => a -> Doc
pretty QName loc
name
        pretty (P.FieldWildcard _) = String -> Doc
text ".."

instance SrcInfo loc => Pretty (P.ParseXAttr loc) where
        pretty :: ParseXAttr loc -> Doc
pretty (P.XAttr _ n :: XName loc
n v :: PExp loc
v) =
                [Doc] -> Doc
myFsep [XName loc -> Doc
forall a. Pretty a => a -> Doc
pretty XName loc
n, Char -> Doc
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 _) = [Doc] -> Doc
mySep [String -> Doc
text "()", String -> Doc
text "=>"]
        pretty (P.CxSingle _ asst :: PAsst loc
asst) = [Doc] -> Doc
mySep [PAsst loc -> Doc
forall a. Pretty a => a -> Doc
pretty PAsst loc
asst, String -> Doc
text "=>"]
        pretty (P.CxTuple _ assts :: [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 "=>"]

instance SrcInfo loc => Pretty (P.PAsst loc) where
        pretty :: PAsst loc -> Doc
pretty (P.TypeA _ t :: PType loc
t)       = PType loc -> Doc
forall a. Pretty a => a -> Doc
pretty PType loc
t
        pretty (P.IParam _ i :: IPName loc
i t :: PType loc
t)    = [Doc] -> Doc
myFsep [IPName loc -> Doc
forall a. Pretty a => a -> Doc
pretty IPName loc
i, String -> Doc
text "::", PType loc -> Doc
forall a. Pretty a => a -> Doc
pretty PType loc
t]
        pretty (P.ParenA _ a :: 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 p :: Indent
p (P.TyForall _ mtvs :: Maybe [TyVarBind loc]
mtvs ctxt :: Maybe (PContext loc)
ctxt htype :: PType loc
htype) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> 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 _ (P.TyStar _) = String -> Doc
text "*"
        prettyPrec p :: Indent
p (P.TyFun _ a :: PType loc
a b :: PType loc
b) = Bool -> Doc -> Doc
parensIf (Indent
p Indent -> Indent -> Bool
forall a. Ord a => a -> a -> Bool
> 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 "->", PType loc -> Doc
forall a. Pretty a => a -> Doc
pretty PType loc
b]
        prettyPrec _ (P.TyTuple _ bxd :: Boxed
bxd l :: [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   -> [Doc] -> Doc
parenList [Doc]
ds
                        Unboxed -> [Doc] -> Doc
hashParenList [Doc]
ds
        prettyPrec _ (P.TyUnboxedSum _ es :: [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 _ (P.TyList _ t :: 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 _ (P.TyParArray _ t :: PType loc
t) = [Doc] -> Doc
bracketColonList [PType loc -> Doc
forall a. Pretty a => a -> Doc
pretty PType loc
t]
        prettyPrec p :: Indent
p (P.TyApp _ a :: PType loc
a b :: 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 _ (P.TyVar _ name :: Name loc
name) = Name loc -> Doc
forall a. Pretty a => a -> Doc
pretty Name loc
name
        prettyPrec _ (P.TyCon _ name :: QName loc
name) = QName loc -> Doc
forall a. Pretty a => a -> Doc
pretty QName loc
name
        prettyPrec _ (P.TyParen _ t :: PType loc
t) = Doc -> Doc
parens (PType loc -> Doc
forall a. Pretty a => a -> Doc
pretty PType loc
t)
        prettyPrec _ (P.TyPred _ asst :: PAsst loc
asst) = PAsst loc -> Doc
forall a. Pretty a => a -> Doc
pretty PAsst loc
asst
        prettyPrec _ (P.TyInfix _ a :: PType loc
a op :: MaybePromotedName loc
op b :: 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 _ (P.TyKind _ t :: PType loc
t k :: 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 "::", Kind loc -> Doc
forall a. Pretty a => a -> Doc
pretty Kind loc
k])
        prettyPrec _ (P.TyPromoted _ p :: Promoted loc
p) = Promoted loc -> Doc
forall a. Pretty a => a -> Doc
pretty Promoted loc
p
        prettyPrec _ (P.TyEquals _ a :: PType loc
a b :: PType loc
b) = [Doc] -> Doc
myFsep [PType loc -> Doc
forall a. Pretty a => a -> Doc
pretty PType loc
a, String -> Doc
text "~", PType loc -> Doc
forall a. Pretty a => a -> Doc
pretty PType loc
b]
        prettyPrec _ (P.TySplice _ s :: Splice loc
s) = Splice loc -> Doc
forall a. Pretty a => a -> Doc
pretty Splice loc
s
        prettyPrec _ (P.TyBang _ b :: BangType loc
b u :: Unpackedness loc
u t :: 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 _ (P.TyWildCard _ mn :: Maybe (Name loc)
mn) = Char -> Doc
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 _ (P.TyQuasiQuote _ n :: String
n qt :: String
qt) = String -> Doc
text ("[$" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ "|" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
qt String -> String -> String
forall a. [a] -> [a] -> [a]
++ "|]")