{-# OPTIONS_GHC -Wunused-imports #-}

------------------------------------------------------------------------
-- Pretty-printing of Haskell modules
------------------------------------------------------------------------

module Agda.Compiler.MAlonzo.Pretty where

import qualified Agda.Utils.Haskell.Syntax as HS

import Agda.Compiler.MAlonzo.Encode
import Agda.Syntax.Common.Pretty

import Agda.Utils.Null (empty)
import Agda.Utils.Function (applyWhen)


prettyPrint :: Pretty a => a -> String
prettyPrint :: forall a. Pretty a => a -> String
prettyPrint = Doc Aspects -> String
forall a. Show a => a -> String
show (Doc Aspects -> String) -> (a -> Doc Aspects) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty

instance Pretty HS.Module where
  pretty :: Module -> Doc Aspects
pretty (HS.Module ModuleName
m [ModulePragma]
pragmas [ImportDecl]
imps [Decl]
decls) =
    [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
vcat ([Doc Aspects] -> Doc Aspects) -> [Doc Aspects] -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ [[Doc Aspects]] -> [Doc Aspects]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [ (ModulePragma -> Doc Aspects) -> [ModulePragma] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map ModulePragma -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [ModulePragma]
pragmas
      , [ Doc Aspects
"" | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [ModulePragma] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ModulePragma]
pragmas ]
      , [ Doc Aspects
"module" Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> ModuleName -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty ModuleName
m Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Doc Aspects
"where" ]
      , [ Doc Aspects
"" ]
      , (ImportDecl -> Doc Aspects) -> [ImportDecl] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map ImportDecl -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [ImportDecl]
imps
      , [ Doc Aspects
"" ]
      , (Decl -> Doc Aspects) -> [Decl] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map Decl -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [Decl]
decls
      ]

instance Pretty HS.ModulePragma where
  pretty :: ModulePragma -> Doc Aspects
pretty (HS.LanguagePragma [Name]
ps) =
    Doc Aspects
"{-#" Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Doc Aspects
"LANGUAGE" Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
fsep (Doc Aspects -> [Doc Aspects] -> [Doc Aspects]
forall (t :: * -> *).
Foldable t =>
Doc Aspects -> t (Doc Aspects) -> [Doc Aspects]
punctuate Doc Aspects
comma ([Doc Aspects] -> [Doc Aspects]) -> [Doc Aspects] -> [Doc Aspects]
forall a b. (a -> b) -> a -> b
$ (Name -> Doc Aspects) -> [Name] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [Name]
ps) Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Doc Aspects
"#-}"
  pretty (HS.OtherPragma String
p) =
    String -> Doc Aspects
forall a. String -> Doc a
text String
p

instance Pretty HS.ImportDecl where
  pretty :: ImportDecl -> Doc Aspects
pretty HS.ImportDecl{ importModule :: ImportDecl -> ModuleName
HS.importModule    = ModuleName
m
                      , importQualified :: ImportDecl -> Bool
HS.importQualified = Bool
q
                      , importSpecs :: ImportDecl -> Maybe (Bool, [ImportSpec])
HS.importSpecs     = Maybe (Bool, [ImportSpec])
specs } =
      [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
hsep [ Doc Aspects
"import"
           , if Bool
q then Doc Aspects
"qualified" else Doc Aspects
forall a. Null a => a
empty
           , ModuleName -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty ModuleName
m
           , Doc Aspects
-> ((Bool, [ImportSpec]) -> Doc Aspects)
-> Maybe (Bool, [ImportSpec])
-> Doc Aspects
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc Aspects
forall a. Null a => a
empty (Bool, [ImportSpec]) -> Doc Aspects
forall {a}. Pretty a => (Bool, [a]) -> Doc Aspects
prSpecs Maybe (Bool, [ImportSpec])
specs ]
    where prSpecs :: (Bool, [a]) -> Doc Aspects
prSpecs (Bool
hide, [a]
specs) =
            [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
hsep [ if Bool
hide then Doc Aspects
"hiding" else Doc Aspects
forall a. Null a => a
empty
                 , Doc Aspects -> Doc Aspects
parens (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
fsep ([Doc Aspects] -> Doc Aspects) -> [Doc Aspects] -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ Doc Aspects -> [Doc Aspects] -> [Doc Aspects]
forall (t :: * -> *).
Foldable t =>
Doc Aspects -> t (Doc Aspects) -> [Doc Aspects]
punctuate Doc Aspects
comma ([Doc Aspects] -> [Doc Aspects]) -> [Doc Aspects] -> [Doc Aspects]
forall a b. (a -> b) -> a -> b
$ (a -> Doc Aspects) -> [a] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [a]
specs ]

instance Pretty HS.ImportSpec where
  pretty :: ImportSpec -> Doc Aspects
pretty (HS.IVar Name
x) = Name -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Name
x

instance Pretty HS.Decl where
  pretty :: Decl -> Doc Aspects
pretty = \case
    HS.TypeDecl Name
f [TyVarBind]
xs Type
t ->
      [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep [ Doc Aspects
"type" Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Name -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Name
f Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
fsep ((TyVarBind -> Doc Aspects) -> [TyVarBind] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map TyVarBind -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [TyVarBind]
xs) Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Doc Aspects
"="
          , Int -> Doc Aspects -> Doc Aspects
forall a. Int -> Doc a -> Doc a
nest Int
2 (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ Type -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Type
t ]
    HS.DataDecl DataOrNew
newt Name
d [TyVarBind]
xs [ConDecl]
cons [Deriving]
derv ->
      [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep [ DataOrNew -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty DataOrNew
newt Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Name -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Name
d Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
fsep ((TyVarBind -> Doc Aspects) -> [TyVarBind] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map TyVarBind -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [TyVarBind]
xs)
          , Int -> Doc Aspects -> Doc Aspects
forall a. Int -> Doc a -> Doc a
nest Int
2 (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ if [ConDecl] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ConDecl]
cons then Doc Aspects
forall a. Null a => a
empty
                     else Doc Aspects
"=" Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
fsep (Doc Aspects -> [Doc Aspects] -> [Doc Aspects]
forall (t :: * -> *).
Foldable t =>
Doc Aspects -> t (Doc Aspects) -> [Doc Aspects]
punctuate Doc Aspects
" |" ([Doc Aspects] -> [Doc Aspects]) -> [Doc Aspects] -> [Doc Aspects]
forall a b. (a -> b) -> a -> b
$ (ConDecl -> Doc Aspects) -> [ConDecl] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map ConDecl -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [ConDecl]
cons)
          , Int -> Doc Aspects -> Doc Aspects
forall a. Int -> Doc a -> Doc a
nest Int
2 (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ [Deriving] -> Doc Aspects
forall {t :: * -> *}.
Foldable t =>
[(QName, t Type)] -> Doc Aspects
prDeriving [Deriving]
derv ]
      where
        prDeriving :: [(QName, t Type)] -> Doc Aspects
prDeriving [] = Doc Aspects
forall a. Null a => a
empty
        prDeriving [(QName, t Type)]
ds = Doc Aspects
"deriving" Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Doc Aspects -> Doc Aspects
parens ([Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
fsep ([Doc Aspects] -> Doc Aspects) -> [Doc Aspects] -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ Doc Aspects -> [Doc Aspects] -> [Doc Aspects]
forall (t :: * -> *).
Foldable t =>
Doc Aspects -> t (Doc Aspects) -> [Doc Aspects]
punctuate Doc Aspects
comma ([Doc Aspects] -> [Doc Aspects]) -> [Doc Aspects] -> [Doc Aspects]
forall a b. (a -> b) -> a -> b
$ ((QName, t Type) -> Doc Aspects)
-> [(QName, t Type)] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map (QName, t Type) -> Doc Aspects
forall {t :: * -> *}. Foldable t => (QName, t Type) -> Doc Aspects
prDer [(QName, t Type)]
ds)
        prDer :: (QName, t Type) -> Doc Aspects
prDer (QName
d, t Type
ts) = Type -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty ((Type -> Type -> Type) -> Type -> t Type -> Type
forall b a. (b -> a -> b) -> b -> t a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Type -> Type -> Type
HS.TyApp (QName -> Type
HS.TyCon QName
d) t Type
ts)
    HS.TypeSig [Name]
fs Type
t ->
      [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep [ [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
hsep (Doc Aspects -> [Doc Aspects] -> [Doc Aspects]
forall (t :: * -> *).
Foldable t =>
Doc Aspects -> t (Doc Aspects) -> [Doc Aspects]
punctuate Doc Aspects
comma ((Name -> Doc Aspects) -> [Name] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [Name]
fs)) Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Doc Aspects
"::"
          , Int -> Doc Aspects -> Doc Aspects
forall a. Int -> Doc a -> Doc a
nest Int
2 (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ Type -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Type
t ]
    HS.FunBind [Match]
ms -> [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
vcat ([Doc Aspects] -> Doc Aspects) -> [Doc Aspects] -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ (Match -> Doc Aspects) -> [Match] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map Match -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [Match]
ms
    HS.LocalBind Strictness
s Name
f Rhs
rhs ->
      [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep [ Strictness -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Strictness
s Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Semigroup a => a -> a -> a
<> Name -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Name
f
          , Int -> Doc Aspects -> Doc Aspects
forall a. Int -> Doc a -> Doc a
nest Int
2 (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ String -> Rhs -> Doc Aspects
prettyRhs String
"=" Rhs
rhs
          ]
    HS.PatSyn Pat
p1 Pat
p2 -> [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep [ Doc Aspects
"pattern" Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Pat -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Pat
p1 Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Doc Aspects
"=" Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Pat -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Pat
p2 ]
    HS.FakeDecl String
s -> String -> Doc Aspects
forall a. String -> Doc a
text String
s
    HS.Comment String
s -> [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
vcat ([Doc Aspects] -> Doc Aspects) -> [Doc Aspects] -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ (String -> Doc Aspects) -> [String] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map ((Doc Aspects
"--" Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+>) (Doc Aspects -> Doc Aspects)
-> (String -> Doc Aspects) -> String -> Doc Aspects
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc Aspects
forall a. String -> Doc a
text) (String -> [String]
lines String
s)

instance Pretty HS.ConDecl where
  pretty :: ConDecl -> Doc Aspects
pretty (HS.ConDecl Name
c [(Maybe Strictness, Type)]
sts) =
    Name -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Name
c Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+>
    [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
fsep (((Maybe Strictness, Type) -> Doc Aspects)
-> [(Maybe Strictness, Type)] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map (\(Maybe Strictness
s, Type
t) -> Doc Aspects
-> (Strictness -> Doc Aspects) -> Maybe Strictness -> Doc Aspects
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc Aspects
forall a. Null a => a
empty Strictness -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Maybe Strictness
s Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Semigroup a => a -> a -> a
<> Int -> Type -> Doc Aspects
forall a. Pretty a => Int -> a -> Doc Aspects
prettyPrec Int
10 Type
t) [(Maybe Strictness, Type)]
sts)

instance Pretty HS.Strictness where
  pretty :: Strictness -> Doc Aspects
pretty Strictness
HS.Strict = Doc Aspects
"!"
  pretty Strictness
HS.Lazy   = Doc Aspects
forall a. Null a => a
empty

instance Pretty HS.Match where
  pretty :: Match -> Doc Aspects
pretty (HS.Match Name
f [Pat]
ps Rhs
rhs Maybe Binds
wh) =
    Maybe Binds -> Doc Aspects -> Doc Aspects
prettyWhere Maybe Binds
wh (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$
      [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep [ Name -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Name
f Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
fsep ((Pat -> Doc Aspects) -> [Pat] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Pat -> Doc Aspects
forall a. Pretty a => Int -> a -> Doc Aspects
prettyPrec Int
10) [Pat]
ps)
          , Int -> Doc Aspects -> Doc Aspects
forall a. Int -> Doc a -> Doc a
nest Int
2 (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ String -> Rhs -> Doc Aspects
prettyRhs String
"=" Rhs
rhs ]

prettyWhere :: Maybe HS.Binds -> Doc -> Doc
prettyWhere :: Maybe Binds -> Doc Aspects -> Doc Aspects
prettyWhere Maybe Binds
Nothing  Doc Aspects
doc = Doc Aspects
doc
prettyWhere (Just Binds
b) Doc Aspects
doc =
  [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
vcat [ Doc Aspects
doc, Int -> Doc Aspects -> Doc Aspects
forall a. Int -> Doc a -> Doc a
nest Int
2 (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep [ Doc Aspects
"where", Int -> Doc Aspects -> Doc Aspects
forall a. Int -> Doc a -> Doc a
nest Int
2 (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ Binds -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Binds
b ] ]

instance Pretty HS.Pat where
  prettyPrec :: Int -> Pat -> Doc Aspects
prettyPrec Int
pr Pat
pat =
    case Pat
pat of
      HS.PVar Name
x         -> Name -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Name
x
      HS.PLit Literal
l         -> Int -> Literal -> Doc Aspects
forall a. Pretty a => Int -> a -> Doc Aspects
prettyPrec Int
pr Literal
l
      HS.PAsPat Name
x Pat
p     -> Bool -> Doc Aspects -> Doc Aspects
mparens (Int
pr Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ Name -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Name
x Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Semigroup a => a -> a -> a
<> Doc Aspects
"@" Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Semigroup a => a -> a -> a
<> Int -> Pat -> Doc Aspects
forall a. Pretty a => Int -> a -> Doc Aspects
prettyPrec Int
11 Pat
p
      Pat
HS.PWildCard      -> Doc Aspects
"_"
      HS.PBangPat Pat
p     -> Doc Aspects
"!" Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Semigroup a => a -> a -> a
<> Int -> Pat -> Doc Aspects
forall a. Pretty a => Int -> a -> Doc Aspects
prettyPrec Int
11 Pat
p
      HS.PApp QName
c [Pat]
ps      -> Bool -> Doc Aspects -> Doc Aspects
mparens (Int
pr Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
9) (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ QName -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty QName
c Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
hsep ((Pat -> Doc Aspects) -> [Pat] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Pat -> Doc Aspects
forall a. Pretty a => Int -> a -> Doc Aspects
prettyPrec Int
10) [Pat]
ps)
      HS.PatTypeSig Pat
p Type
t -> Bool -> Doc Aspects -> Doc Aspects
mparens (Int
pr Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep [ Pat -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Pat
p Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Doc Aspects
"::", Int -> Doc Aspects -> Doc Aspects
forall a. Int -> Doc a -> Doc a
nest Int
2 (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ Type -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Type
t ]
      HS.PIrrPat Pat
p      -> Bool -> Doc Aspects -> Doc Aspects
mparens (Int
pr Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ Doc Aspects
"~" Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Semigroup a => a -> a -> a
<> Int -> Pat -> Doc Aspects
forall a. Pretty a => Int -> a -> Doc Aspects
prettyPrec Int
11 Pat
p

prettyRhs :: String -> HS.Rhs -> Doc
prettyRhs :: String -> Rhs -> Doc Aspects
prettyRhs String
eq (HS.UnGuardedRhs Exp
e)   = String -> Doc Aspects
forall a. String -> Doc a
text String
eq Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Exp -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Exp
e
prettyRhs String
eq (HS.GuardedRhss [GuardedRhs]
rhss) = [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
vcat ([Doc Aspects] -> Doc Aspects) -> [Doc Aspects] -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ (GuardedRhs -> Doc Aspects) -> [GuardedRhs] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map (String -> GuardedRhs -> Doc Aspects
prettyGuardedRhs String
eq) [GuardedRhs]
rhss

prettyGuardedRhs :: String -> HS.GuardedRhs -> Doc
prettyGuardedRhs :: String -> GuardedRhs -> Doc Aspects
prettyGuardedRhs String
eq (HS.GuardedRhs [Stmt]
ss Exp
e) =
    [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep [ Doc Aspects
"|" Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep (Doc Aspects -> [Doc Aspects] -> [Doc Aspects]
forall (t :: * -> *).
Foldable t =>
Doc Aspects -> t (Doc Aspects) -> [Doc Aspects]
punctuate Doc Aspects
comma ([Doc Aspects] -> [Doc Aspects]) -> [Doc Aspects] -> [Doc Aspects]
forall a b. (a -> b) -> a -> b
$ (Stmt -> Doc Aspects) -> [Stmt] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map Stmt -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [Stmt]
ss) Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> String -> Doc Aspects
forall a. String -> Doc a
text String
eq
        , Int -> Doc Aspects -> Doc Aspects
forall a. Int -> Doc a -> Doc a
nest Int
2 (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ Exp -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Exp
e ]

instance Pretty HS.Binds where
  pretty :: Binds -> Doc Aspects
pretty (HS.BDecls [Decl]
ds) = [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
vcat ([Doc Aspects] -> Doc Aspects) -> [Doc Aspects] -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ (Decl -> Doc Aspects) -> [Decl] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map Decl -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [Decl]
ds

instance Pretty HS.DataOrNew where
  pretty :: DataOrNew -> Doc Aspects
pretty DataOrNew
HS.DataType = Doc Aspects
"data"
  pretty DataOrNew
HS.NewType  = Doc Aspects
"newtype"

instance Pretty HS.TyVarBind where
  pretty :: TyVarBind -> Doc Aspects
pretty (HS.UnkindedVar Name
x) = Name -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Name
x

instance Pretty HS.Type where
  prettyPrec :: Int -> Type -> Doc Aspects
prettyPrec Int
pr Type
t =
    case Type
t of
      HS.TyForall [TyVarBind]
xs Type
t ->
        Bool -> Doc Aspects -> Doc Aspects
mparens (Int
pr Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$
          [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep [ (Doc Aspects
"forall" Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
fsep ((TyVarBind -> Doc Aspects) -> [TyVarBind] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map TyVarBind -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [TyVarBind]
xs)) Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Semigroup a => a -> a -> a
<> Doc Aspects
"."
              , Int -> Doc Aspects -> Doc Aspects
forall a. Int -> Doc a -> Doc a
nest Int
2 (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ Type -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Type
t ]
      HS.TyFun Type
a Type
b ->
        Bool -> Doc Aspects -> Doc Aspects
mparens (Int
pr Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
4) (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$
          [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep [ Int -> Type -> Doc Aspects
forall a. Pretty a => Int -> a -> Doc Aspects
prettyPrec Int
5 Type
a Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Doc Aspects
"->", Int -> Type -> Doc Aspects
forall a. Pretty a => Int -> a -> Doc Aspects
prettyPrec Int
4 Type
b ]
      HS.TyCon QName
c -> QName -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty QName
c
      HS.TyVar Name
x -> Name -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Name
x
      HS.TyApp (HS.TyCon (HS.UnQual (HS.Ident String
"[]"))) Type
t ->
        Doc Aspects -> Doc Aspects
brackets (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ Type -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Type
t
      t :: Type
t@HS.TyApp{} ->
        Bool -> Doc Aspects -> Doc Aspects
mparens (Int
pr Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
9) (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$
          [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep [ Int -> Type -> Doc Aspects
forall a. Pretty a => Int -> a -> Doc Aspects
prettyPrec Int
9 Type
f
              , Int -> Doc Aspects -> Doc Aspects
forall a. Int -> Doc a -> Doc a
nest Int
2 (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
fsep ([Doc Aspects] -> Doc Aspects) -> [Doc Aspects] -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ (Type -> Doc Aspects) -> [Type] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Type -> Doc Aspects
forall a. Pretty a => Int -> a -> Doc Aspects
prettyPrec Int
10) [Type]
ts ]
        where
          Type
f : [Type]
ts = Type -> [Type] -> [Type]
appView Type
t []
          appView :: Type -> [Type] -> [Type]
appView (HS.TyApp Type
a Type
b) [Type]
as = Type -> [Type] -> [Type]
appView Type
a (Type
b Type -> [Type] -> [Type]
forall a. a -> [a] -> [a]
: [Type]
as)
          appView Type
t [Type]
as = Type
t Type -> [Type] -> [Type]
forall a. a -> [a] -> [a]
: [Type]
as
      HS.FakeType String
s -> String -> Doc Aspects
forall a. String -> Doc a
text String
s

instance Pretty HS.Stmt where
  pretty :: Stmt -> Doc Aspects
pretty (HS.Qualifier Exp
e) = Exp -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Exp
e
  pretty (HS.Generator Pat
p Exp
e) = [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep [ Pat -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Pat
p Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Doc Aspects
"<-", Int -> Doc Aspects -> Doc Aspects
forall a. Int -> Doc a -> Doc a
nest Int
2 (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ Exp -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Exp
e ]

instance Pretty HS.Literal where
  prettyPrec :: Int -> Literal -> Doc Aspects
prettyPrec Int
pr = \case
    HS.Int Integer
n    -> Integer -> Doc Aspects -> Doc Aspects
forall n. (Ord n, Num n) => n -> Doc Aspects -> Doc Aspects
parensIfNeg Integer
n (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ Integer -> Doc Aspects
forall a. Integer -> Doc a
integer Integer
n
    HS.Frac Rational
x   -> Double -> Doc Aspects -> Doc Aspects
forall n. (Ord n, Num n) => n -> Doc Aspects -> Doc Aspects
parensIfNeg Double
d (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ Double -> Doc Aspects
forall a. Double -> Doc a
double Double
d
                   where
                   d :: Double
d = Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
x
    HS.Char Char
c   -> String -> Doc Aspects
forall a. String -> Doc a
text (Char -> String
forall a. Show a => a -> String
show Char
c)
    HS.String Text
s -> String -> Doc Aspects
forall a. String -> Doc a
text (Text -> String
forall a. Show a => a -> String
show Text
s)
    where
    parensIfNeg :: (Ord n, Num n) => n -> Doc -> Doc
    parensIfNeg :: forall n. (Ord n, Num n) => n -> Doc Aspects -> Doc Aspects
parensIfNeg n
x = Bool -> (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall b a. IsBool b => b -> (a -> a) -> a -> a
applyWhen (n
x n -> n -> Bool
forall a. Ord a => a -> a -> Bool
< n
0) ((Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects)
-> (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ Bool -> Doc Aspects -> Doc Aspects
mparens (Int
pr Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10)

instance Pretty HS.Exp where
  prettyPrec :: Int -> Exp -> Doc Aspects
prettyPrec Int
pr Exp
e =
    case Exp
e of
      HS.Var QName
x -> QName -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty QName
x
      HS.Con QName
c -> QName -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty QName
c
      HS.Lit Literal
l -> Literal -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Literal
l
      HS.InfixApp Exp
a QOp
qop Exp
b -> Bool -> Doc Aspects -> Doc Aspects
mparens (Int
pr Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$
        [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep [ Int -> Exp -> Doc Aspects
forall a. Pretty a => Int -> a -> Doc Aspects
prettyPrec Int
1 Exp
a
            , QOp -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty QOp
qop Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Int -> Exp -> Doc Aspects
forall a. Pretty a => Int -> a -> Doc Aspects
prettyPrec Int
1 Exp
b ]
      HS.Ann Exp
e Type
ty -> Bool -> Doc Aspects -> Doc Aspects
mparens (Int
pr Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$
        [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep [ Int -> Exp -> Doc Aspects
forall a. Pretty a => Int -> a -> Doc Aspects
prettyPrec Int
1 Exp
e
            , Doc Aspects
"::"
            , Int -> Type -> Doc Aspects
forall a. Pretty a => Int -> a -> Doc Aspects
prettyPrec Int
1 Type
ty
            ]
      HS.App{} -> Bool -> Doc Aspects -> Doc Aspects
mparens (Int
pr Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
9) (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$
        [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep [ Int -> Exp -> Doc Aspects
forall a. Pretty a => Int -> a -> Doc Aspects
prettyPrec Int
9 Exp
f
            , Int -> Doc Aspects -> Doc Aspects
forall a. Int -> Doc a -> Doc a
nest Int
2 (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
fsep ([Doc Aspects] -> Doc Aspects) -> [Doc Aspects] -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ (Exp -> Doc Aspects) -> [Exp] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Exp -> Doc Aspects
forall a. Pretty a => Int -> a -> Doc Aspects
prettyPrec Int
10) [Exp]
es ]
        where
          Exp
f : [Exp]
es = Exp -> [Exp] -> [Exp]
appView Exp
e []
          appView :: Exp -> [Exp] -> [Exp]
appView (HS.App Exp
f Exp
e) [Exp]
es = Exp -> [Exp] -> [Exp]
appView Exp
f (Exp
e Exp -> [Exp] -> [Exp]
forall a. a -> [a] -> [a]
: [Exp]
es)
          appView Exp
f [Exp]
es = Exp
f Exp -> [Exp] -> [Exp]
forall a. a -> [a] -> [a]
: [Exp]
es
      HS.Lambda [Pat]
ps Exp
e -> Bool -> Doc Aspects -> Doc Aspects
mparens (Int
pr Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$
        [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep [ Doc Aspects
"\\" Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
fsep ((Pat -> Doc Aspects) -> [Pat] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Pat -> Doc Aspects
forall a. Pretty a => Int -> a -> Doc Aspects
prettyPrec Int
10) [Pat]
ps) Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Doc Aspects
"->"
            , Int -> Doc Aspects -> Doc Aspects
forall a. Int -> Doc a -> Doc a
nest Int
2 (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ Exp -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Exp
e ]
      HS.Let Binds
bs Exp
e -> Bool -> Doc Aspects -> Doc Aspects
mparens (Int
pr Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$
        [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep [ Doc Aspects
"let" Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Binds -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Binds
bs Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Doc Aspects
"in"
            , Exp -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Exp
e ]
      HS.If Exp
a Exp
b Exp
c -> Bool -> Doc Aspects -> Doc Aspects
mparens (Int
pr Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$
        [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep [ Doc Aspects
"if" Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Exp -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Exp
a
            , Int -> Doc Aspects -> Doc Aspects
forall a. Int -> Doc a -> Doc a
nest Int
2 (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ Doc Aspects
"then" Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Exp -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Exp
b
            , Int -> Doc Aspects -> Doc Aspects
forall a. Int -> Doc a -> Doc a
nest Int
2 (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ Doc Aspects
"else" Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Int -> Exp -> Doc Aspects
forall a. Pretty a => Int -> a -> Doc Aspects
prettyPrec Int
1 Exp
c ]
      HS.Case Exp
e [Alt]
bs -> Bool -> Doc Aspects -> Doc Aspects
mparens (Int
pr Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$
        [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
vcat [ Doc Aspects
"case" Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Exp -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Exp
e Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Doc Aspects
"of"
             , Int -> Doc Aspects -> Doc Aspects
forall a. Int -> Doc a -> Doc a
nest Int
2 (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
vcat ([Doc Aspects] -> Doc Aspects) -> [Doc Aspects] -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ (Alt -> Doc Aspects) -> [Alt] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map Alt -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [Alt]
bs ]
      HS.ExpTypeSig Exp
e Type
t -> Bool -> Doc Aspects -> Doc Aspects
mparens (Int
pr Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$
        [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep [ Exp -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Exp
e Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Doc Aspects
"::"
            , Int -> Doc Aspects -> Doc Aspects
forall a. Int -> Doc a -> Doc a
nest Int
2 (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ Type -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Type
t ]
      HS.NegApp Exp
exp -> Doc Aspects -> Doc Aspects
parens (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ Doc Aspects
"-" Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Semigroup a => a -> a -> a
<> Exp -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Exp
exp
      HS.FakeExp String
s -> String -> Doc Aspects
forall a. String -> Doc a
text String
s

instance Pretty HS.Alt where
  pretty :: Alt -> Doc Aspects
pretty (HS.Alt Pat
pat Rhs
rhs Maybe Binds
wh) =
    Maybe Binds -> Doc Aspects -> Doc Aspects
prettyWhere Maybe Binds
wh (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$
      [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep [ Pat -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Pat
pat, Int -> Doc Aspects -> Doc Aspects
forall a. Int -> Doc a -> Doc a
nest Int
2 (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ String -> Rhs -> Doc Aspects
prettyRhs String
"->" Rhs
rhs ]

instance Pretty HS.ModuleName where
  pretty :: ModuleName -> Doc Aspects
pretty ModuleName
m = String -> Doc Aspects
forall a. String -> Doc a
text String
s
    where HS.ModuleName String
s = ModuleName -> ModuleName
encodeModuleName ModuleName
m

instance Pretty HS.QName where
  pretty :: QName -> Doc Aspects
pretty QName
q = Bool -> Doc Aspects -> Doc Aspects
mparens (QName -> Bool
isOperator QName
q) (QName -> Doc Aspects
prettyQName QName
q)

instance Pretty HS.Name where
  pretty :: Name -> Doc Aspects
pretty (HS.Ident  String
s) = String -> Doc Aspects
forall a. String -> Doc a
text String
s
  pretty (HS.Symbol String
s) = String -> Doc Aspects
forall a. String -> Doc a
text String
s

instance Pretty HS.QOp where
  pretty :: QOp -> Doc Aspects
pretty (HS.QVarOp QName
x)
    | QName -> Bool
isOperator QName
x = QName -> Doc Aspects
prettyQName QName
x
    | Bool
otherwise    = Doc Aspects
"`" Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Semigroup a => a -> a -> a
<> QName -> Doc Aspects
prettyQName QName
x Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Semigroup a => a -> a -> a
<> Doc Aspects
"`"

isOperator :: HS.QName -> Bool
isOperator :: QName -> Bool
isOperator QName
q =
  case QName
q of
    HS.Qual ModuleName
_ Name
x           -> Name -> Bool
isOp Name
x
    HS.UnQual Name
x           -> Name -> Bool
isOp Name
x
  where
    isOp :: Name -> Bool
isOp HS.Symbol{} = Bool
True
    isOp HS.Ident{}  = Bool
False

prettyQName :: HS.QName -> Doc
prettyQName :: QName -> Doc Aspects
prettyQName (HS.Qual ModuleName
m Name
x)           = ModuleName -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty ModuleName
m Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Semigroup a => a -> a -> a
<> Doc Aspects
"." Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Semigroup a => a -> a -> a
<> Name -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Name
x
prettyQName (HS.UnQual Name
x)           = Name -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Name
x