{-# OPTIONS_GHC -fno-warn-orphans #-}

{-# LANGUAGE DeriveAnyClass      #-}
{-# LANGUAGE DeriveGeneric       #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving  #-}

module Language.ATS.PrettyPrint ( printATS
                                , printATSCustom
                                , printATSFast
                                ) where

import           Control.Composition          hiding ((&))
import           Control.Recursion            (cata)
import           Data.Bool                    (bool)
import           Data.Foldable                (toList)
import           Data.List                    (isPrefixOf)
import           Data.List.NonEmpty           (NonEmpty (..))
import qualified Data.List.NonEmpty           as NE
import           Data.These                   (These (..))
import           Language.ATS.Types
import           Lens.Micro
import           Prelude                      hiding ((<$>))
import           Text.PrettyPrint.ANSI.Leijen hiding (bool)

infixr 5 $$

instance Eq Doc where
    == :: Doc -> Doc -> Bool
(==) = String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) (String -> String -> Bool) -> (Doc -> String) -> Doc -> Doc -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (((String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"") ((String -> String) -> String)
-> (Doc -> String -> String) -> Doc -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleDoc -> String -> String
displayS (SimpleDoc -> String -> String)
-> (Doc -> SimpleDoc) -> Doc -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> SimpleDoc
renderCompact)


-- | Pretty-print with sensible defaults.
printATS :: Eq a => ATS a -> String
printATS :: ATS a -> String
printATS = (String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n") (String -> String) -> (ATS a -> String) -> ATS a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Int -> ATS a -> String
forall a. Eq a => Float -> Int -> ATS a -> String
printATSCustom Float
0.6 Int
120

printATSCustom :: Eq a
               => Float -- ^ Ribbon fraction
               -> Int -- ^ Ribbon width
               -> ATS a -> String
printATSCustom :: Float -> Int -> ATS a -> String
printATSCustom Float
r Int
i ATS a
x = String -> String
g String
forall a. Monoid a => a
mempty
    where g :: String -> String
g = (SimpleDoc -> String -> String
displayS (SimpleDoc -> String -> String)
-> (ATS a -> SimpleDoc) -> ATS a -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Int -> Doc -> SimpleDoc
renderSmart Float
r Int
i (Doc -> SimpleDoc) -> (ATS a -> Doc) -> ATS a -> SimpleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ATS a -> Doc
forall a. Pretty a => a -> Doc
pretty) ATS a
x

-- | Slightly faster pretty-printer without indendation (for code generation).
printATSFast :: Eq a => ATS a -> String
printATSFast :: ATS a -> String
printATSFast ATS a
x = String -> String
g String
forall a. Monoid a => a
mempty
    where g :: String -> String
g = (SimpleDoc -> String -> String
displayS (SimpleDoc -> String -> String)
-> (ATS a -> SimpleDoc) -> ATS a -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> SimpleDoc
renderCompact (Doc -> SimpleDoc) -> (ATS a -> Doc) -> ATS a -> SimpleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"\n") (Doc -> Doc) -> (ATS a -> Doc) -> ATS a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ATS a -> Doc
forall a. Pretty a => a -> Doc
pretty) ATS a
x

instance Pretty (Name a) where
    pretty :: Name a -> Doc
pretty (Unqualified String
n)    = String -> Doc
text String
n
    pretty (Qualified a
_ String
i String
n)  = Doc
"$" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
n Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"." Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
i
    pretty (SpecialName a
_ String
s)  = Doc
"$" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
s
    pretty (Functorial String
s String
s')  = String -> Doc
text String
s Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"$" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
s'
    pretty (FieldName a
_ String
n String
n') = String -> Doc
text String
n Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"." Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
n'

instance Pretty (LambdaType a) where
    pretty :: LambdaType a -> Doc
pretty Plain{}      = Doc
"=>"
    pretty Spear{}      = Doc
"=>>"
    pretty ProofArrow{} = Doc
"=/=>"
    pretty ProofSpear{} = Doc
"=/=>>"
    pretty (Full a
_ String
v)   = Doc
"=<" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
v Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
">"

instance Pretty (BinOp a) where
    pretty :: BinOp a -> Doc
pretty BinOp a
Mult               = Doc
"*"
    pretty BinOp a
Add                = Doc
"+"
    pretty BinOp a
Div                = Doc
"/"
    pretty BinOp a
Sub                = Doc
"-"
    pretty BinOp a
GreaterThan        = Doc
">"
    pretty BinOp a
LessThan           = Doc
"<"
    pretty BinOp a
Equal              = Doc
"="
    pretty BinOp a
NotEq              = Doc
"!="
    pretty BinOp a
LogicalAnd         = Doc
"&&"
    pretty BinOp a
LogicalOr          = Doc
"||"
    pretty BinOp a
LessThanEq         = Doc
"<="
    pretty BinOp a
GreaterThanEq      = Doc
">="
    pretty BinOp a
StaticEq           = Doc
"=="
    pretty BinOp a
Mod                = Doc
"%"
    pretty BinOp a
Mutate             = Doc
":="
    pretty BinOp a
SpearOp            = Doc
"->"
    pretty BinOp a
At                 = Doc
"@"
    pretty BinOp a
RShift             = Doc
">>"
    pretty BinOp a
LShift             = Doc
"<<"
    pretty (SpecialInfix a
_ String
s) = String -> Doc
text String
s

splits :: BinOp a -> Bool
splits :: BinOp a -> Bool
splits BinOp a
Mult       = Bool
True
splits BinOp a
Add        = Bool
True
splits BinOp a
Div        = Bool
True
splits BinOp a
LogicalAnd = Bool
True
splits BinOp a
LogicalOr  = Bool
True
splits BinOp a
_          = Bool
False

startsParens :: Doc -> Bool
startsParens :: Doc -> Bool
startsParens Doc
d = String -> Bool
f (Doc -> String
forall a. Show a => a -> String
show Doc
d) where
    f :: String -> Bool
f (Char
'(':String
_) = Bool
True
    f String
_       = Bool
False

prettySmall :: Doc -> [Doc] -> Doc
prettySmall :: Doc -> [Doc] -> Doc
prettySmall Doc
op [Doc]
es = [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat (Doc -> [Doc] -> [Doc]
punctuate (Doc
" " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
op Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
" ") [Doc]
es)

prettyBinary :: Doc -> [Doc] -> Doc
prettyBinary :: Doc -> [Doc] -> Doc
prettyBinary Doc
op [Doc]
es
    | String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Doc -> String
showFast (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat [Doc]
es) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
80 = Doc -> [Doc] -> Doc
prettySmall Doc
op [Doc]
es
    | Bool
otherwise = Doc -> [Doc] -> Doc
prettyLarge Doc
op [Doc]
es

prettyLarge :: Doc -> [Doc] -> Doc
prettyLarge :: Doc -> [Doc] -> Doc
prettyLarge Doc
_ []      = Doc
forall a. Monoid a => a
mempty
prettyLarge Doc
op (Doc
e:[Doc]
es) = Doc
e Doc -> Doc -> Doc
<$> [Doc] -> Doc
vsep ((Doc -> Doc) -> [Doc] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Doc
op Doc -> Doc -> Doc
<+>) [Doc]
es)

lengthAlt :: Doc -> Doc -> Doc
lengthAlt :: Doc -> Doc -> Doc
lengthAlt Doc
d1 Doc
d2
    | String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Doc -> String
showFast Doc
d2) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
30 = Doc
d1 Doc -> Doc -> Doc
<$> Int -> Doc -> Doc
indent Int
4 Doc
d2
    | Bool
otherwise = Doc
d1 Doc -> Doc -> Doc
<+> Doc
d2

prettyArgsProof :: (Pretty a) => Maybe [a] -> [Doc] -> Doc
prettyArgsProof :: Maybe [a] -> [Doc] -> Doc
prettyArgsProof (Just [a]
e) = Doc -> Doc -> [Doc] -> Doc
forall (t :: * -> *). Foldable t => Doc -> Doc -> t Doc -> Doc
prettyArgsG (Doc
"(" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc -> [Doc] -> Doc
forall (t :: * -> *). Foldable t => Doc -> Doc -> t Doc -> Doc
prettyArgsG Doc
forall a. Monoid a => a
mempty Doc
forall a. Monoid a => a
mempty ((a -> Doc) -> [a] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Doc
forall a. Pretty a => a -> Doc
pretty [a]
e) Doc -> Doc -> Doc
<+> Doc
"| ") Doc
")"
prettyArgsProof Maybe [a]
Nothing  = [Doc] -> Doc
forall a (f :: * -> *).
(Pretty a, Foldable f, Functor f) =>
f a -> Doc
prettyArgs

instance Pretty (UnOp a) where
    pretty :: UnOp a -> Doc
pretty UnOp a
Negate          = Doc
"~"
    pretty UnOp a
Deref           = Doc
"!"
    pretty (SpecialOp a
_ String
s) = String -> Doc
text String
s

prettyProofExpr :: NonEmpty Doc -> Doc
prettyProofExpr :: NonEmpty Doc -> Doc
prettyProofExpr (Doc
e:|[]) = Doc
e
prettyProofExpr NonEmpty Doc
es      = [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat (Doc -> [Doc] -> [Doc]
punctuate Doc
", " (NonEmpty Doc -> [Doc]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty Doc
es))

prettyLam :: (Pretty a, Pretty b) => Doc -> a -> b -> Doc -> Doc
prettyLam :: Doc -> a -> b -> Doc -> Doc
prettyLam Doc
bind a
p b
lt Doc
e = let pre :: Doc
pre = Doc
bind Doc -> Doc -> Doc
<+> a -> Doc
forall a. Pretty a => a -> Doc
pretty a
p Doc -> Doc -> Doc
<+> b -> Doc
forall a. Pretty a => a -> Doc
pretty b
lt in Doc -> Doc -> Doc
flatAlt (Doc -> Doc -> Doc
lengthAlt Doc
pre Doc
e) (Doc
pre Doc -> Doc -> Doc
<+> Doc
e)

instance Eq a => Pretty (Expression a) where
    pretty :: Expression a -> Doc
pretty = (Base (Expression a) Doc -> Doc) -> Expression a -> Doc
forall t a. Recursive t => (Base t a -> a) -> t -> a
cata Base (Expression a) Doc -> Doc
forall a. Eq a => ExpressionF a Doc -> Doc
a where
        a :: ExpressionF a Doc -> Doc
a (IfF Doc
e Doc
e' (Just Doc
e''))         = Doc
"if" Doc -> Doc -> Doc
<+> Doc
e Doc -> Doc -> Doc
<+> Doc
"then" Doc -> Doc -> Doc
<$> Int -> Doc -> Doc
indent Int
2 Doc
e' Doc -> Doc -> Doc
<$> Doc
"else" Doc -> Doc -> Doc
<$> Int -> Doc -> Doc
indent Int
2 Doc
e''
        a (IfF Doc
e Doc
e' Maybe Doc
Nothing)            = Doc
"if" Doc -> Doc -> Doc
<+> Doc
e Doc -> Doc -> Doc
<+> Doc
"then" Doc -> Doc -> Doc
<$> Int -> Doc -> Doc
indent Int
2 Doc
e'
        a (LetF a
_ ATS a
e Maybe Doc
e')          = Doc -> Doc -> Doc
flatAlt
            (Doc
"let" Doc -> Doc -> Doc
<$> Int -> Doc -> Doc
indent Int
2 (ATS a -> Doc
forall a. Pretty a => a -> Doc
pretty ATS a
e) Doc -> Doc -> Doc
<$> Maybe Doc -> Doc
endLet Maybe Doc
e')
            (Doc
"let" Doc -> Doc -> Doc
<+> ATS a -> Doc
forall a. Pretty a => a -> Doc
pretty ATS a
e Doc -> Doc -> Doc
<$> Maybe Doc -> Doc
endLet Maybe Doc
e')
        a (UintLitF Natural
u)                  = Integer -> Doc
forall a. Pretty a => a -> Doc
pretty (Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
u :: Integer) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"u"
        a (IntLitF Integer
i)                   = Integer -> Doc
forall a. Pretty a => a -> Doc
pretty Integer
i
        a (HexLitF String
hi)                  = Doc
"0x" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
hi
        a (HexUintLitF String
hi)              = Doc
"0x" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
hi Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"u"
        a (LambdaF a
_ LambdaType a
lt Pattern a
p Doc
e)            = Doc -> Pattern a -> LambdaType a -> Doc -> Doc
forall a b. (Pretty a, Pretty b) => Doc -> a -> b -> Doc -> Doc
prettyLam Doc
"lam" Pattern a
p LambdaType a
lt Doc
e
        a (LinearLambdaF a
_ LambdaType a
lt Pattern a
p Doc
e)      = Doc -> Pattern a -> LambdaType a -> Doc -> Doc
forall a b. (Pretty a, Pretty b) => Doc -> a -> b -> Doc -> Doc
prettyLam Doc
"llam" Pattern a
p LambdaType a
lt Doc
e
        a (FloatLitF Float
f)                 = Float -> Doc
forall a. Pretty a => a -> Doc
pretty Float
f Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"f"
        a (DoubleLitF Double
f)                = Double -> Doc
forall a. Pretty a => a -> Doc
pretty Double
f
        a (StringLitF String
s)                = String -> Doc
text String
s -- FIXME escape indentation in multi-line strings.
        a (ParenExprF a
_ Doc
e)              = Doc -> Doc
parens Doc
e
        a (UnaryF UnOp a
op Doc
e) = UnOp a -> Doc
forall a. Pretty a => a -> Doc
pretty UnOp a
op Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
forall a. Pretty a => a -> Doc
pretty Doc
e
        a (BinListF op :: BinOp a
op@BinOp a
Add [Doc]
es)          = Doc -> [Doc] -> Doc
prettyBinary (BinOp a -> Doc
forall a. Pretty a => a -> Doc
pretty BinOp a
op) [Doc]
es
        a (BinListF op :: BinOp a
op@Con{} [Doc]
es)        = Doc -> [Doc] -> Doc
prettyBinary (BinOp a -> Doc
forall a. Pretty a => a -> Doc
pretty BinOp a
op) [Doc]
es
        a (BinaryF BinOp a
op Doc
e Doc
e')
            | BinOp a -> Bool
forall a. BinOp a -> Bool
splits BinOp a
op = Doc
e Doc -> Doc -> Doc
</> BinOp a -> Doc
forall a. Pretty a => a -> Doc
pretty BinOp a
op Doc -> Doc -> Doc
<+> Doc
e'
            | Bool
otherwise = Doc
e Doc -> Doc -> Doc
<+> BinOp a -> Doc
forall a. Pretty a => a -> Doc
pretty BinOp a
op Doc -> Doc -> Doc
<+> Doc
e'
        a (IndexF a
_ Name a
n Doc
e)                = Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
n Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
brackets Doc
e
        a (NamedValF Name a
nam)               = Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
nam
        a (CallF Name a
nam [] [] Maybe [Doc]
Nothing [])  = Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
nam Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"()"
        a (CallF Name a
nam [] [] Maybe [Doc]
e [Doc]
xs)        = Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
nam Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Maybe [Doc] -> [Doc] -> Doc
forall a. Pretty a => Maybe [a] -> [Doc] -> Doc
prettyArgsProof Maybe [Doc]
e [Doc]
xs
        a (CallF Name a
nam [] [[Type a]]
us Maybe [Doc]
Nothing [])  = Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
nam Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [[Type a]] -> Doc
forall a. Pretty a => [[a]] -> Doc
prettyTypes [[Type a]]
us
        a (CallF Name a
nam [] [[Type a]]
us Maybe [Doc]
Nothing [Doc
"()"]) = Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
nam Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [[Type a]] -> Doc
forall a. Pretty a => [[a]] -> Doc
prettyTypes [[Type a]]
us Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"()"
        a (CallF Name a
nam [] [[Type a]]
us Maybe [Doc]
e [Doc]
xs)        = Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
nam Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [[Type a]] -> Doc
forall a. Pretty a => [[a]] -> Doc
prettyTypes [[Type a]]
us Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Maybe [Doc] -> [Doc] -> Doc
forall a. Pretty a => Maybe [a] -> [Doc] -> Doc
prettyArgsProof Maybe [Doc]
e [Doc]
xs
        a (CallF Name a
nam [[Type a]]
is [] Maybe [Doc]
Nothing [])  = Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
nam Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [[Type a]] -> Doc
forall a. Pretty a => [[a]] -> Doc
prettyImplicits [[Type a]]
is
        a (CallF Name a
nam [[Type a]]
is [] Maybe [Doc]
Nothing [Doc
"()"]) = Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
nam Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [[Type a]] -> Doc
forall a. Pretty a => [[a]] -> Doc
prettyImplicits [[Type a]]
is Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"()"
        a (CallF Name a
nam [[Type a]]
is [] Maybe [Doc]
e [Doc]
xs)        = Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
nam Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [[Type a]] -> Doc
forall a. Pretty a => [[a]] -> Doc
prettyImplicits [[Type a]]
is Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Maybe [Doc] -> [Doc] -> Doc
forall a. Pretty a => Maybe [a] -> [Doc] -> Doc
prettyArgsProof Maybe [Doc]
e [Doc]
xs
        a (CallF Name a
nam [[Type a]]
is [[Type a]]
us Maybe [Doc]
Nothing [Doc
"()"]) = Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
nam Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [[Type a]] -> Doc
forall a. Pretty a => [[a]] -> Doc
prettyImplicits [[Type a]]
is Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [[Type a]] -> Doc
forall a. Pretty a => [[a]] -> Doc
prettyTypes [[Type a]]
us Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"()"
        a (CallF Name a
nam [[Type a]]
is [[Type a]]
us Maybe [Doc]
e [Doc]
xs)        = Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
nam Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [[Type a]] -> Doc
forall a. Pretty a => [[a]] -> Doc
prettyImplicits [[Type a]]
is Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [[Type a]] -> Doc
forall a. Pretty a => [[a]] -> Doc
prettyTypes [[Type a]]
us Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Maybe [Doc] -> [Doc] -> Doc
forall a. Pretty a => Maybe [a] -> [Doc] -> Doc
prettyArgsProof Maybe [Doc]
e [Doc]
xs
        a (CaseF a
_ Addendum
add' Doc
e [(Pattern a, LambdaType a, Doc)]
cs)           = Doc
"case" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Addendum -> Doc
forall a. Pretty a => a -> Doc
pretty Addendum
add' Doc -> Doc -> Doc
<+> Doc
e Doc -> Doc -> Doc
<+> Doc
"of" Doc -> Doc -> Doc
<$> Int -> Doc -> Doc
indent Int
2 ([(Pattern a, LambdaType a, Doc)] -> Doc
forall a b. (Pretty a, Pretty b) => [(a, b, Doc)] -> Doc
prettyCases [(Pattern a, LambdaType a, Doc)]
cs)
        a (IfCaseF a
_ [(Doc, LambdaType a, Doc)]
cs)                = Doc
"ifcase" Doc -> Doc -> Doc
<$> Int -> Doc -> Doc
indent Int
2 ([(Doc, LambdaType a, Doc)] -> Doc
forall a. Pretty a => [(Doc, a, Doc)] -> Doc
prettyIfCase [(Doc, LambdaType a, Doc)]
cs)
        a (VoidLiteralF a
_)              = Doc
"()"
        a (RecordValueF a
_ NonEmpty (String, Doc)
es)           = NonEmpty (String, Doc) -> Doc
forall a. Pretty a => NonEmpty (String, a) -> Doc
prettyRecord NonEmpty (String, Doc)
es
        a (BoxRecordValueF a
_ NonEmpty (String, Doc)
es)        = Doc
"'" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> NonEmpty (String, Doc) -> Doc
forall a. Pretty a => NonEmpty (String, a) -> Doc
prettyRecord NonEmpty (String, Doc)
es
        a (PrecedeF Doc
e Doc
e')               = Doc -> Doc
parens (Doc
e Doc -> Doc -> Doc
<+> Doc
";" Doc -> Doc -> Doc
</> Doc
e')
        a (PrecedeListF [Doc]
es)             = Doc -> Doc -> Doc
lineAlt (Doc -> Doc -> Doc -> [Doc] -> Doc
forall (t :: * -> *).
Foldable t =>
Doc -> Doc -> Doc -> t Doc -> Doc
prettyArgsList Doc
"; " Doc
"(" Doc
")" [Doc]
es) (Doc
"(" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat (Doc -> [Doc] -> [Doc]
punctuate Doc
" ; " [Doc]
es) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
")")
        a (AccessF a
_ Doc
e Name a
n)
            | Doc -> Bool
noParens Doc
e = Doc
e Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"." Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
n
            | Bool
otherwise  = Doc -> Doc
parens Doc
e Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"." Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
n
        a (CharLitF Char
'\\')              = Doc
"'\\\\'"
        a (CharLitF Char
'\n')              = Doc
"'\\n'"
        a (CharLitF Char
'\t')              = Doc
"'\\t'"
        a (CharLitF Char
'\0')              = Doc
"'\\0'"
        a (CharLitF Char
'\'')              = Doc
"'\\''"
        a (CharLitF Char
'{')               = Doc
"'\\{'"
        a (CharLitF Char
c)                 = Doc
"'" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
c Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"'"
        a (ProofExprF a
_ NonEmpty Doc
es Doc
e')         = Doc
"(" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> NonEmpty Doc -> Doc
prettyProofExpr NonEmpty Doc
es Doc -> Doc -> Doc
<+> Doc
"|" Doc -> Doc -> Doc
<+> Doc
e' Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
")"
        a (TypeSignatureF Doc
e Type a
t)         = Doc
e Doc -> Doc -> Doc
<+> Doc
":" Doc -> Doc -> Doc
<+> Type a -> Doc
forall a. Pretty a => a -> Doc
pretty Type a
t
        a (WhereExpF Doc
e ATS a
d)              = Doc -> ATS a -> Doc
forall a. Pretty a => Doc -> a -> Doc
prettyWhere Doc
e ATS a
d
        a (ArrayLitF a
_ Type a
ty (Just StaticExpression a
se) [Doc]
e) = Doc
"@[" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Type a -> Doc
forall a. Pretty a => a -> Doc
pretty Type a
ty Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"][" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> StaticExpression a -> Doc
forall a. Pretty a => a -> Doc
pretty StaticExpression a
se Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"]" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
forall a (f :: * -> *).
(Pretty a, Foldable f, Functor f) =>
f a -> Doc
prettyArgs [Doc]
e
        a (ArrayLitF a
_ Type a
ty Maybe (StaticExpression a)
Nothing [Doc]
e)   = Doc
"@[" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Type a -> Doc
forall a. Pretty a => a -> Doc
pretty Type a
ty Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"]" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
forall a (f :: * -> *).
(Pretty a, Foldable f, Functor f) =>
f a -> Doc
prettyArgs [Doc]
e
        a (TupleExF a
_ NonEmpty Doc
es)              = Doc -> Doc
parens ([Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
", " (NonEmpty Doc -> [Doc]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty Doc -> [Doc]) -> NonEmpty Doc -> [Doc]
forall a b. (a -> b) -> a -> b
$ NonEmpty Doc -> NonEmpty Doc
forall a. NonEmpty a -> NonEmpty a
NE.reverse NonEmpty Doc
es))
        a (BoxTupleExF a
_ NonEmpty Doc
es)           = Doc
"'(" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat (Doc -> [Doc] -> [Doc]
punctuate Doc
", " (NonEmpty Doc -> [Doc]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty Doc -> [Doc]) -> NonEmpty Doc -> [Doc]
forall a b. (a -> b) -> a -> b
$ NonEmpty Doc -> NonEmpty Doc
forall a. NonEmpty a -> NonEmpty a
NE.reverse NonEmpty Doc
es)) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
")"
        a (WhileF a
_ Doc
e Doc
e')              = Doc
"while" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens Doc
e Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
e'
        a (ForF a
_ Doc
e Doc
e')                = Doc
"for" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens Doc
e Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
e'
        a (WhileStarF a
_ [Universal a]
us StaticExpression a
t [Arg a]
as Doc
e Doc
e' Maybe [Arg a]
Nothing)   = Doc
"while*" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Universal a] -> Doc
forall a. Eq a => [Universal a] -> Doc
prettyUsStarNil [Universal a]
us Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> StaticExpression a -> Doc
forall a. Pretty a => a -> Doc
prettyTermetric StaticExpression a
t Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Arg a] -> Doc
forall a (f :: * -> *).
(Pretty a, Foldable f, Functor f) =>
f a -> Doc
prettyArgs [Arg a]
as Doc -> Doc -> Doc
<+> Doc
"=>" Doc -> Doc -> Doc
<$> Int -> Doc -> Doc
indent Int
4 Doc
e Doc -> Doc -> Doc
<$> Int -> Doc -> Doc
indent Int
4 Doc
e'
        a (WhileStarF a
_ [Universal a]
us StaticExpression a
t [Arg a]
as Doc
e Doc
e' (Just [Arg a]
ty)) = Doc
"while*" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Universal a] -> Doc
forall a. Eq a => [Universal a] -> Doc
prettyUsStarNil [Universal a]
us Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> StaticExpression a -> Doc
forall a. Pretty a => a -> Doc
prettyTermetric StaticExpression a
t Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Arg a] -> Doc
forall a (f :: * -> *).
(Pretty a, Foldable f, Functor f) =>
f a -> Doc
prettyArgs [Arg a]
as Doc -> Doc -> Doc
<+> Doc
":" Doc -> Doc -> Doc
<+> [Arg a] -> Doc
forall a (f :: * -> *).
(Pretty a, Foldable f, Functor f) =>
f a -> Doc
prettyArgs [Arg a]
ty Doc -> Doc -> Doc
<+> Doc
"=>" Doc -> Doc -> Doc
<$> Int -> Doc -> Doc
indent Int
4 Doc
e Doc -> Doc -> Doc
<$> Int -> Doc -> Doc
indent Int
4 Doc
e'
        a (ForStarF a
_ [Universal a]
us StaticExpression a
t [Arg a]
as Doc
e Doc
e')    = Doc
"for*" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Universal a] -> Doc
forall a. Eq a => [Universal a] -> Doc
prettyUsStarNil [Universal a]
us Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> StaticExpression a -> Doc
forall a. Pretty a => a -> Doc
prettyTermetric StaticExpression a
t Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Arg a] -> Doc
forall a (f :: * -> *).
(Pretty a, Foldable f, Functor f) =>
f a -> Doc
prettyArgs [Arg a]
as Doc -> Doc -> Doc
<+> Doc
"=>" Doc -> Doc -> Doc
<$> Int -> Doc -> Doc
indent Int
4 Doc
e Doc -> Doc -> Doc
<$> Int -> Doc -> Doc
indent Int
4 Doc
e'
        a (ActionsF (ATS [Declaration a
d]))         = Doc
"{" Doc -> Doc -> Doc
<+> Declaration a -> Doc
forall a. Pretty a => a -> Doc
pretty Declaration a
d Doc -> Doc -> Doc
<+> Doc
"}"
        a (ActionsF ATS a
as)                = Doc
"{" Doc -> Doc -> Doc
<$> Int -> Doc -> Doc
indent Int
2 (ATS a -> Doc
forall a. Pretty a => a -> Doc
pretty ATS a
as) Doc -> Doc -> Doc
<$> Doc
"}"
        a UnderscoreLitF{}             = Doc
"_"
        a (BeginF a
_ Doc
e)
            | Bool -> Bool
not (Doc -> Bool
startsParens Doc
e) = Doc
linebreak Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Doc -> Doc
indent Int
2 (Doc
"begin" Doc -> Doc -> Doc
<$> Int -> Doc -> Doc
indent Int
2 Doc
e Doc -> Doc -> Doc
<$> Doc
"end")
            | Bool
otherwise          = Doc
e
        a (FixAtF a
_ String
n (StackF String
s [Arg a]
as Type a
t Expression a
e))  = Doc
"fix@" Doc -> Doc -> Doc
<+> String -> Doc
text String
n Doc -> Doc -> Doc
<+> [Arg a] -> Doc
forall a (f :: * -> *).
(Pretty a, Foldable f, Functor f) =>
f a -> Doc
prettyArgs [Arg a]
as Doc -> Doc -> Doc
<+> Doc
":" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
forall a. Pretty a => a -> Doc
pretty String
s Doc -> Doc -> Doc
<+> Type a -> Doc
forall a. Pretty a => a -> Doc
pretty Type a
t Doc -> Doc -> Doc
<+> Doc
"=>" Doc -> Doc -> Doc
<$> Int -> Doc -> Doc
indent Int
2 (Expression a -> Doc
forall a. Pretty a => a -> Doc
pretty Expression a
e)
        a (LambdaAtF a
_ (StackF String
s [Arg a]
as Type a
t Expression a
e)) = Doc
"lam@" Doc -> Doc -> Doc
<+> [Arg a] -> Doc
forall a (f :: * -> *).
(Pretty a, Foldable f, Functor f) =>
f a -> Doc
prettyArgs [Arg a]
as Doc -> Doc -> Doc
<+> Doc
":" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
forall a. Pretty a => a -> Doc
pretty String
s Doc -> Doc -> Doc
<+> Type a -> Doc
forall a. Pretty a => a -> Doc
pretty Type a
t Doc -> Doc -> Doc
<+> Doc
"=>" Doc -> Doc -> Doc
<$> Int -> Doc -> Doc
indent Int
2 (Expression a -> Doc
forall a. Pretty a => a -> Doc
pretty Expression a
e)
        a (LinearLambdaAtF a
_ (StackF String
s [Arg a]
as Type a
t Expression a
e)) = Doc
"llam@" Doc -> Doc -> Doc
<+> [Arg a] -> Doc
forall a (f :: * -> *).
(Pretty a, Foldable f, Functor f) =>
f a -> Doc
prettyArgs [Arg a]
as Doc -> Doc -> Doc
<+> Doc
":" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
forall a. Pretty a => a -> Doc
pretty String
s Doc -> Doc -> Doc
<+> Type a -> Doc
forall a. Pretty a => a -> Doc
pretty Type a
t Doc -> Doc -> Doc
<+> Doc
"=>" Doc -> Doc -> Doc
<$> Int -> Doc -> Doc
indent Int
2 (Expression a -> Doc
forall a. Pretty a => a -> Doc
pretty Expression a
e)
        a (AddrAtF a
_ Doc
e)                   = Doc
"addr@" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
e
        a (ViewAtF a
_ Doc
e)                   = Doc
"view@" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
e
        a (ListLiteralF a
_ String
s Type a
t [Doc]
es)         = Doc
"list" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
string String
s Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"{" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Type a -> Doc
forall a. Pretty a => a -> Doc
pretty Type a
t Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"}" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
forall a (f :: * -> *).
(Pretty a, Foldable f, Functor f) =>
f a -> Doc
prettyArgs [Doc]
es
        a (CommentExprF String
c Doc
e) = String -> Doc
text String
c Doc -> Doc -> Doc
<$> Doc
e
        a (MacroVarF a
_ String
s) = Doc
",(" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
s Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
")"
        a BinListF{} = Doc
forall a. HasCallStack => a
undefined -- Shouldn't happen

        prettyIfCase :: [(Doc, a, Doc)] -> Doc
prettyIfCase []              = Doc
forall a. Monoid a => a
mempty
        prettyIfCase [(Doc
s, a
l, Doc
t)]     = Doc
"|" Doc -> Doc -> Doc
<+> Doc
s Doc -> Doc -> Doc
<+> a -> Doc
forall a. Pretty a => a -> Doc
pretty a
l Doc -> Doc -> Doc
<+> Doc
t
        prettyIfCase ((Doc
s, a
l, Doc
t): [(Doc, a, Doc)]
xs) = [(Doc, a, Doc)] -> Doc
prettyIfCase [(Doc, a, Doc)]
xs Doc -> Doc -> Doc
$$ Doc
"|" Doc -> Doc -> Doc
<+> Doc
s Doc -> Doc -> Doc
<+> a -> Doc
forall a. Pretty a => a -> Doc
pretty a
l Doc -> Doc -> Doc
<+> Doc
t

prettyCases :: (Pretty a, Pretty b) => [(a, b, Doc)] -> Doc
prettyCases :: [(a, b, Doc)] -> Doc
prettyCases []              = Doc
forall a. Monoid a => a
mempty
prettyCases [(a
s, b
l, Doc
t)]     = Doc
"|" Doc -> Doc -> Doc
<+> a -> Doc
forall a. Pretty a => a -> Doc
pretty a
s Doc -> Doc -> Doc
<+> b -> Doc
forall a. Pretty a => a -> Doc
pretty b
l Doc -> Doc -> Doc
<+> Doc
t
prettyCases ((a
s, b
l, Doc
t): [(a, b, Doc)]
xs) = [(a, b, Doc)] -> Doc
forall a b. (Pretty a, Pretty b) => [(a, b, Doc)] -> Doc
prettyCases [(a, b, Doc)]
xs Doc -> Doc -> Doc
$$ Doc
"|" Doc -> Doc -> Doc
<+> a -> Doc
forall a. Pretty a => a -> Doc
pretty a
s Doc -> Doc -> Doc
<+> b -> Doc
forall a. Pretty a => a -> Doc
pretty b
l Doc -> Doc -> Doc
<+> Doc
t -- FIXME can leave space with e.g. => \n begin ...

noParens :: Doc -> Bool
noParens :: Doc -> Bool
noParens = (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (String
"()" :: String)) (String -> Bool) -> (Doc -> String) -> Doc -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> String
forall a. Show a => a -> String
show

patternHelper :: [Doc] -> Doc
patternHelper :: [Doc] -> Doc
patternHelper [Doc]
ps = [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat (Doc -> [Doc] -> [Doc]
punctuate Doc
", " [Doc]
ps)

instance Eq a => Pretty (Pattern a) where
    pretty :: Pattern a -> Doc
pretty = (Base (Pattern a) Doc -> Doc) -> Pattern a -> Doc
forall t a. Recursive t => (Base t a -> a) -> t -> a
cata Base (Pattern a) Doc -> Doc
forall a. Eq a => PatternF a Doc -> Doc
a where
        a :: PatternF a Doc -> Doc
a (PSumF String
s Doc
x)                         = String -> Doc
string String
s Doc -> Doc -> Doc
<+> Doc
x
        a (PLiteralF Expression a
e)                       = Expression a -> Doc
forall a. Pretty a => a -> Doc
pretty Expression a
e
        a (PNameF Name a
s [])                       = Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
s
        a (PNameF Name a
s [Doc
x])                      = Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
s Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens Doc
x
        a (PNameF Name a
s [Doc]
ps)                       = Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
s Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens ([Doc] -> Doc
patternHelper [Doc]
ps)
        a (FreeF Doc
p)                           = Doc
"~" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
p
        a (GuardedF a
_ Expression a
e Doc
p)                    = Doc
p Doc -> Doc -> Doc
<+> Doc
"when" Doc -> Doc -> Doc
<+> Expression a -> Doc
forall a. Pretty a => a -> Doc
pretty Expression a
e
        a (ProofF a
_ [Doc]
p [Doc]
p')                     = Doc -> Doc
parens ([Doc] -> Doc
patternHelper [Doc]
p Doc -> Doc -> Doc
<+> Doc
"|" Doc -> Doc -> Doc
<+> [Doc] -> Doc
patternHelper [Doc]
p')
        a (TuplePatternF [Doc]
ps)                  = Doc -> Doc
parens ([Doc] -> Doc
patternHelper [Doc]
ps)
        a (BoxTuplePatternF a
_ [Doc]
ps)             = Doc
"'(" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
patternHelper [Doc]
ps Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
")"
        a (AtPatternF a
_ Doc
p)                    = Doc
"@" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
p
        a (UniversalPatternF a
_ String
n [Universal a]
us (Just Doc
p)) = String -> Doc
text String
n Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc -> [Universal a] -> Doc
forall a (f :: * -> *).
(Pretty a, Foldable f, Functor f) =>
Doc -> Doc -> f a -> Doc
prettyArgsU Doc
"" Doc
"" [Universal a]
us Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
p
        a (UniversalPatternF a
_ String
n [Universal a]
us Maybe Doc
Nothing)  = String -> Doc
text String
n Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc -> [Universal a] -> Doc
forall a (f :: * -> *).
(Pretty a, Foldable f, Functor f) =>
Doc -> Doc -> f a -> Doc
prettyArgsU Doc
"" Doc
"" [Universal a]
us
        a (ExistentialPatternF Existential a
e Doc
p)           = Existential a -> Doc
forall a. Pretty a => a -> Doc
pretty Existential a
e Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
p
        a (AsF a
_ Doc
p Doc
p')                        = Doc
p Doc -> Doc -> Doc
<+> Doc
"as" Doc -> Doc -> Doc
<+> Doc
p'
        a (BinPatternF a
_ BinOp a
op Doc
p Doc
p')             = Doc
p Doc -> Doc -> Doc
<+> BinOp a -> Doc
forall a. Pretty a => a -> Doc
pretty BinOp a
op Doc -> Doc -> Doc
<+> Doc
p'

argHelper :: Eq a => (Doc -> Doc -> Doc) -> Arg a -> Doc
argHelper :: (Doc -> Doc -> Doc) -> Arg a -> Doc
argHelper Doc -> Doc -> Doc
_ (Arg (This String
s))     = String -> Doc
forall a. Pretty a => a -> Doc
pretty String
s
argHelper Doc -> Doc -> Doc
_ (Arg (That Type a
t))     = Type a -> Doc
forall a. Pretty a => a -> Doc
pretty Type a
t
argHelper Doc -> Doc -> Doc
op (Arg (These String
s Type a
t)) = String -> Doc
forall a. Pretty a => a -> Doc
pretty String
s Doc -> Doc -> Doc
`op` Doc
colon Doc -> Doc -> Doc
`op` Type a -> Doc
forall a. Pretty a => a -> Doc
pretty Type a
t
argHelper Doc -> Doc -> Doc
op (PrfArg [Arg a]
a Arg a
a')     = Doc -> Doc -> Doc -> [Arg a] -> Doc
forall a (f :: * -> *).
(Pretty a, Functor f, Foldable f) =>
Doc -> Doc -> Doc -> f a -> Doc
prettyArgs' Doc
", " Doc
forall a. Monoid a => a
mempty Doc
forall a. Monoid a => a
mempty [Arg a]
a Doc -> Doc -> Doc
</> Doc
"|" Doc -> Doc -> Doc
`op` Arg a -> Doc
forall a. Pretty a => a -> Doc
pretty Arg a
a'

instance Eq a => Pretty (SortArg a) where
    pretty :: SortArg a -> Doc
pretty (SortArg String
n Sort a
st) = String -> Doc
text String
n Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
":" Doc -> Doc -> Doc
<+> Sort a -> Doc
forall a. Pretty a => a -> Doc
pretty Sort a
st
    pretty (Anonymous Sort a
s)  = Sort a -> Doc
forall a. Pretty a => a -> Doc
pretty Sort a
s

instance Eq a => Pretty (Arg a) where
    pretty :: Arg a -> Doc
pretty = (Doc -> Doc -> Doc) -> Arg a -> Doc
forall a. Eq a => (Doc -> Doc -> Doc) -> Arg a -> Doc
argHelper Doc -> Doc -> Doc
(<+>)

squish :: BinOp a -> Bool
squish :: BinOp a -> Bool
squish BinOp a
Add  = Bool
True
squish BinOp a
Sub  = Bool
True
squish BinOp a
Mult = Bool
True
squish BinOp a
_    = Bool
False

endLet :: Maybe Doc -> Doc
endLet :: Maybe Doc -> Doc
endLet Maybe Doc
Nothing  = Doc
"in end"
endLet (Just Doc
d) = Doc
"in" Doc -> Doc -> Doc
<$> Int -> Doc -> Doc
indent Int
2 Doc
d Doc -> Doc -> Doc
<$> Doc
"end"

prettyExtras :: Pretty a => Doc -> Doc -> [[a]] -> Doc
prettyExtras :: Doc -> Doc -> [[a]] -> Doc
prettyExtras Doc
d1 Doc
d2 = ([a] -> Doc) -> [[a]] -> Doc
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Doc -> Doc -> [a] -> Doc
forall a (f :: * -> *).
(Pretty a, Foldable f, Functor f) =>
Doc -> Doc -> f a -> Doc
prettyArgsU Doc
d1 Doc
d2) ([[a]] -> Doc) -> ([[a]] -> [[a]]) -> [[a]] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[a]] -> [[a]]
forall a. [a] -> [a]
reverse

prettyTypes :: Pretty a => [[a]] -> Doc
prettyTypes :: [[a]] -> Doc
prettyTypes = Doc -> Doc -> [[a]] -> Doc
forall a. Pretty a => Doc -> Doc -> [[a]] -> Doc
prettyExtras Doc
"{" Doc
"}"

prettyImplicits :: Pretty a => [[a]] -> Doc
prettyImplicits :: [[a]] -> Doc
prettyImplicits = Doc -> Doc -> [[a]] -> Doc
forall a. Pretty a => Doc -> Doc -> [[a]] -> Doc
prettyExtras Doc
"<" Doc
">"

prettyWhere :: Pretty a => Doc -> a -> Doc
prettyWhere :: Doc -> a -> Doc
prettyWhere Doc
e a
d = Doc
e Doc -> Doc -> Doc
<+> Doc
"where" Doc -> Doc -> Doc
<$> Doc -> Doc
braces (Doc
" " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Doc -> Doc
nest Int
2 (a -> Doc
forall a. Pretty a => a -> Doc
pretty a
d) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
" ")

instance Eq a => Pretty (StaticExpression a) where
    pretty :: StaticExpression a -> Doc
pretty = (Base (StaticExpression a) Doc -> Doc) -> StaticExpression a -> Doc
forall t a. Recursive t => (Base t a -> a) -> t -> a
cata Base (StaticExpression a) Doc -> Doc
forall a. Eq a => StaticExpressionF a Doc -> Doc
a where
        a :: StaticExpressionF a Doc -> Doc
a (StaticValF Name a
n)            = Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
n
        a (StaticBinaryF BinOp a
op Doc
se Doc
se')
            | BinOp a -> Bool
forall a. BinOp a -> Bool
squish BinOp a
op = Doc
se Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> BinOp a -> Doc
forall a. Pretty a => a -> Doc
pretty BinOp a
op Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
se'
            | Bool
otherwise = Doc
se Doc -> Doc -> Doc
<+> BinOp a -> Doc
forall a. Pretty a => a -> Doc
pretty BinOp a
op Doc -> Doc -> Doc
<+> Doc
se'
        a (StaticIntF Integer
i)               = Integer -> Doc
forall a. Pretty a => a -> Doc
pretty Integer
i
        a (StaticHexF String
h)               = String -> Doc
text String
h
        a StaticVoidF{}                = Doc
"()"
        a (SifF Doc
e Doc
e' Doc
e'')              = Doc
"sif" Doc -> Doc -> Doc
<+> Doc
e Doc -> Doc -> Doc
<+> Doc
"then" Doc -> Doc -> Doc
<$> Int -> Doc -> Doc
indent Int
2 Doc
e' Doc -> Doc -> Doc
<$> Doc
"else" Doc -> Doc -> Doc
<$> Int -> Doc -> Doc
indent Int
2 Doc
e''
        a (SCallF Name a
n [] [] [Doc
"()"] Maybe [Expression a]
Nothing)      = Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
n Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"()"
        a (SCallF Name a
n [] [[Type a]]
us [Doc
"()"] Maybe [Expression a]
Nothing)      = Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
n Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [[Type a]] -> Doc
forall a. Pretty a => [[a]] -> Doc
prettyTypes [[Type a]]
us Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"()"
        a (SCallF Name a
n [] [] [Doc]
cs Maybe [Expression a]
Nothing)          = Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
n Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens ([Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat (Doc -> [Doc] -> [Doc]
punctuate Doc
"," ([Doc] -> [Doc]) -> ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc -> Doc) -> [Doc] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Doc
forall a. Pretty a => a -> Doc
pretty ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ [Doc]
cs))
        a (SCallF Name a
n [] [[Type a]]
us [Doc]
cs Maybe [Expression a]
Nothing)          = Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
n Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [[Type a]] -> Doc
forall a. Pretty a => [[a]] -> Doc
prettyTypes [[Type a]]
us Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens ([Doc] -> Doc
commaTight [Doc]
cs)
        a (SCallF Name a
n [[Type a]]
is [] [Doc
"()"] Maybe [Expression a]
Nothing)      = Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
n Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [[Type a]] -> Doc
forall a. Pretty a => [[a]] -> Doc
prettyImplicits [[Type a]]
is Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"()"
        a (SCallF Name a
n [[Type a]]
is [[Type a]]
us [Doc
"()"] Maybe [Expression a]
Nothing)      = Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
n Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [[Type a]] -> Doc
forall a. Pretty a => [[a]] -> Doc
prettyImplicits [[Type a]]
is Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [[Type a]] -> Doc
forall a. Pretty a => [[a]] -> Doc
prettyTypes [[Type a]]
us Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"()"
        a (SCallF Name a
n [[Type a]]
is [] [Doc]
cs Maybe [Expression a]
Nothing)          = Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
n Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [[Type a]] -> Doc
forall a. Pretty a => [[a]] -> Doc
prettyImplicits [[Type a]]
is Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens ([Doc] -> Doc
commaTight [Doc]
cs)
        a (SCallF Name a
n [[Type a]]
is [[Type a]]
us [Doc]
cs Maybe [Expression a]
Nothing)          = Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
n Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [[Type a]] -> Doc
forall a. Pretty a => [[a]] -> Doc
prettyImplicits [[Type a]]
is Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [[Type a]] -> Doc
forall a. Pretty a => [[a]] -> Doc
prettyTypes [[Type a]]
us Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens ([Doc] -> Doc
commaTight [Doc]
cs)
        a (SCallF Name a
n [] [] [Doc]
cs (Just [Expression a]
ds))        = Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
n Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens ([Doc] -> Doc
commaTight [Doc]
cs Doc -> Doc -> Doc
<+> Doc
"|" Doc -> Doc -> Doc
<+> [Expression a] -> Doc
forall b. Pretty b => [b] -> Doc
commaTightDyn [Expression a]
ds)
        a (SCallF Name a
n [] [[Type a]]
us [Doc]
cs (Just [Expression a]
ds))        = Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
n Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [[Type a]] -> Doc
forall a. Pretty a => [[a]] -> Doc
prettyTypes [[Type a]]
us Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens ([Doc] -> Doc
commaTight [Doc]
cs Doc -> Doc -> Doc
<+> Doc
"|" Doc -> Doc -> Doc
<+> [Expression a] -> Doc
forall b. Pretty b => [b] -> Doc
commaTightDyn [Expression a]
ds)
        a (SCallF Name a
n [[Type a]]
is [] [Doc]
cs (Just [Expression a]
ds))        = Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
n Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [[Type a]] -> Doc
forall a. Pretty a => [[a]] -> Doc
prettyImplicits [[Type a]]
is Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens ([Doc] -> Doc
commaTight [Doc]
cs Doc -> Doc -> Doc
<+> Doc
"|" Doc -> Doc -> Doc
<+> [Expression a] -> Doc
forall b. Pretty b => [b] -> Doc
commaTightDyn [Expression a]
ds)
        a (SCallF Name a
n [[Type a]]
is [[Type a]]
us [Doc]
cs (Just [Expression a]
ds))        = Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
n Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [[Type a]] -> Doc
forall a. Pretty a => [[a]] -> Doc
prettyImplicits [[Type a]]
is Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [[Type a]] -> Doc
forall a. Pretty a => [[a]] -> Doc
prettyTypes [[Type a]]
us Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens ([Doc] -> Doc
commaTight [Doc]
cs Doc -> Doc -> Doc
<+> Doc
"|" Doc -> Doc -> Doc
<+> [Expression a] -> Doc
forall b. Pretty b => [b] -> Doc
commaTightDyn [Expression a]
ds)
        a (SPrecedeF Doc
e Doc
e')             = Doc
e Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
";" Doc -> Doc -> Doc
<+> Doc
e'
        a (SPrecedeListF [Doc]
es)           = Doc -> Doc -> Doc
lineAlt (Doc -> Doc -> Doc -> [Doc] -> Doc
forall (t :: * -> *).
Foldable t =>
Doc -> Doc -> Doc -> t Doc -> Doc
prettyArgsList Doc
"; " Doc
"(" Doc
")" [Doc]
es) (Doc
"(" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat (Doc -> [Doc] -> [Doc]
punctuate Doc
" ; " [Doc]
es) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
")")
        a (SParensF Doc
e)                 = Doc -> Doc
parens Doc
e
        a (SUnaryF UnOp a
op Doc
e)               = UnOp a -> Doc
forall a. Pretty a => a -> Doc
pretty UnOp a
op Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
e
        a (SLetF a
_ [Declaration a]
e Maybe Doc
e') = Doc -> Doc -> Doc
flatAlt
            (Doc
"let" Doc -> Doc -> Doc
<$> Int -> Doc -> Doc
indent Int
2 ([Declaration a] -> Doc
forall a. Eq a => [Declaration a] -> Doc
concatSame [Declaration a]
e) Doc -> Doc -> Doc
<$> Maybe Doc -> Doc
endLet Maybe Doc
e')
            (Doc
"let" Doc -> Doc -> Doc
<+> [Declaration a] -> Doc
forall a. Eq a => [Declaration a] -> Doc
concatSame [Declaration a]
e Doc -> Doc -> Doc
<$> Maybe Doc -> Doc
endLet Maybe Doc
e')
        a (SCaseF Addendum
ad Doc
e [(Pattern a, LambdaType a, Doc)]
sls) = Doc
"case" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Addendum -> Doc
forall a. Pretty a => a -> Doc
pretty Addendum
ad Doc -> Doc -> Doc
<+> Doc
e Doc -> Doc -> Doc
<+> Doc
"of" Doc -> Doc -> Doc
<$> Int -> Doc -> Doc
indent Int
2 ([(Pattern a, LambdaType a, Doc)] -> Doc
forall a b. (Pretty a, Pretty b) => [(a, b, Doc)] -> Doc
prettyCases [(Pattern a, LambdaType a, Doc)]
sls)
        a (SStringF String
s)      = String -> Doc
text String
s
        a (WitnessF a
_ Doc
e Doc
e') = Doc
"#[" Doc -> Doc -> Doc
<+> Doc
e Doc -> Doc -> Doc
<+> Doc
"|" Doc -> Doc -> Doc
<+> Doc
e' Doc -> Doc -> Doc
<+> Doc
"]"
        a (ProofLambdaF a
_ LambdaType a
lt Pattern a
p Doc
e)       = Doc -> Pattern a -> LambdaType a -> Doc -> Doc
forall a b. (Pretty a, Pretty b) => Doc -> a -> b -> Doc -> Doc
prettyLam Doc
"lam" Pattern a
p LambdaType a
lt Doc
e
        a (ProofLinearLambdaF a
_ LambdaType a
lt Pattern a
p Doc
e) = Doc -> Pattern a -> LambdaType a -> Doc -> Doc
forall a b. (Pretty a, Pretty b) => Doc -> a -> b -> Doc -> Doc
prettyLam Doc
"llam" Pattern a
p LambdaType a
lt Doc
e
        a (WhereStaExpF Doc
e ATS a
ds) = Doc -> ATS a -> Doc
forall a. Pretty a => Doc -> a -> Doc
prettyWhere Doc
e ATS a
ds

        commaTight :: [Doc] -> Doc
        commaTight :: [Doc] -> Doc
commaTight = [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
","

        commaTightDyn :: Pretty b => [b] -> Doc
        commaTightDyn :: [b] -> Doc
commaTightDyn = [Doc] -> Doc
commaTight ([Doc] -> Doc) -> ([b] -> [Doc]) -> [b] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> Doc) -> [b] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Doc
forall a. Pretty a => a -> Doc
pretty

instance Eq a => Pretty (Sort a) where
    pretty :: Sort a -> Doc
pretty = (Base (Sort a) Doc -> Doc) -> Sort a -> Doc
forall t a. Recursive t => (Base t a -> a) -> t -> a
cata Base (Sort a) Doc -> Doc
forall a. SortF a Doc -> Doc
a where
        a :: SortF a Doc -> Doc
a (T0pF Addendum
ad)           = Doc
"t@ype" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Addendum -> Doc
forall a. Pretty a => a -> Doc
pretty Addendum
ad
        a (Vt0pF Addendum
ad)          = Doc
"vt@ype" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Addendum -> Doc
forall a. Pretty a => a -> Doc
pretty Addendum
ad
        a (NamedSortF String
s)      = String -> Doc
text String
s
        a SortF a Doc
AddrF               = Doc
"addr"
        a (ViewF a
_ Addendum
t)         = Doc
"view" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Addendum -> Doc
forall a. Pretty a => a -> Doc
pretty Addendum
t
        a (VTypeF a
_ Addendum
a')       = Doc
"vtype" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Addendum -> Doc
forall a. Pretty a => a -> Doc
pretty Addendum
a'
        a (TupleSortF a
_ Doc
s Doc
s') = Doc -> Doc
parens (Doc
s Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"," Doc -> Doc -> Doc
<+> Doc
s')
        a (ArrowSortF a
_ Doc
s Doc
s') = Doc
s Doc -> Doc -> Doc
<+> Doc
"->" Doc -> Doc -> Doc
<+> Doc
s'

instance Eq a => Pretty (Type a) where
    pretty :: Type a -> Doc
pretty = (Base (Type a) Doc -> Doc) -> Type a -> Doc
forall t a. Recursive t => (Base t a -> a) -> t -> a
cata Base (Type a) Doc -> Doc
forall a. Eq a => TypeF a Doc -> Doc
a where
        a :: TypeF a Doc -> Doc
a (NamedF Name a
n)                       = Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
n
        a (ViewTypeF a
_ Doc
t)                  = Doc
"view@" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens Doc
t
        a (ExF Existential a
e (Just Doc
t))
            | String -> Char
forall a. [a] -> a
head (Doc -> String
forall a. Show a => a -> String
show Doc
t) Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'['         = Existential a -> Doc
forall a. Pretty a => a -> Doc
pretty Existential a
e Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
t -- FIXME this is kinda dumb
            | Bool
otherwise                    = Existential a -> Doc
forall a. Pretty a => a -> Doc
pretty Existential a
e Doc -> Doc -> Doc
<+> Doc
t
        a (ExF Existential a
e Maybe Doc
Nothing)                  = Existential a -> Doc
forall a. Pretty a => a -> Doc
pretty Existential a
e
        a (DependentF n :: Name a
n@SpecialName{} [Doc
t]) = Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
n Doc -> Doc -> Doc
<+> Doc -> Doc
forall a. Pretty a => a -> Doc
pretty Doc
t
        a (DependentF Name a
n [Doc]
ts)                = Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
n Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens ([Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat (Doc -> [Doc] -> [Doc]
punctuate Doc
", " ((Doc -> Doc) -> [Doc] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Doc
forall a. Pretty a => a -> Doc
pretty ([Doc] -> [Doc]
forall a. [a] -> [a]
reverse [Doc]
ts))))
        a (ForAF Universal a
u Doc
t)                      = Universal a -> Doc
forall a. Pretty a => a -> Doc
pretty Universal a
u Doc -> Doc -> Doc
<+> Doc
t
        a (UnconsumedF Doc
t)                  = Doc
"!" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
t
        a (AsProofF Doc
t (Just Doc
t'))           = Doc
t Doc -> Doc -> Doc
<+> Doc
">>" Doc -> Doc -> Doc
<+> Doc
t'
        a (AsProofF Doc
t Maybe Doc
Nothing)             = Doc
t Doc -> Doc -> Doc
<+> Doc
">> _"
        a (FromVTF Doc
t)                      = Doc
t Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"?!"
        a (MaybeValF Doc
t)                    = Doc
t Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"?"
        a (AtExprF a
_ Doc
t StaticExpression a
t')                 = Doc
t Doc -> Doc -> Doc
<+> Doc
"@" Doc -> Doc -> Doc
<+> StaticExpression a -> Doc
forall a. Pretty a => a -> Doc
pretty StaticExpression a
t'
        a (ArrayTypeF a
_ Doc
t StaticExpression a
n)               = Doc
"@[" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
t Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"][" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> StaticExpression a -> Doc
forall a. Pretty a => a -> Doc
pretty StaticExpression a
n Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"]"
        a (ProofTypeF a
_ NonEmpty Doc
t NonEmpty Doc
t')              = Doc -> Doc
parens (Doc
pre' Doc -> Doc -> Doc
`op` Doc
"|" Doc -> Doc -> Doc
<+> Doc -> Doc -> NonEmpty Doc -> Doc
forall (t :: * -> *). Foldable t => Doc -> Doc -> t Doc -> Doc
prettyArgsG Doc
forall a. Monoid a => a
mempty Doc
forall a. Monoid a => a
mempty NonEmpty Doc
t')
            where pre' :: Doc
pre' = Doc -> Doc -> NonEmpty Doc -> Doc
forall (t :: * -> *). Foldable t => Doc -> Doc -> t Doc -> Doc
prettyArgsG Doc
forall a. Monoid a => a
mempty Doc
forall a. Monoid a => a
mempty NonEmpty Doc
t
                  op :: Doc -> Doc -> Doc
op = if Char
'\n' Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Doc -> String
showFast Doc
pre' then Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
(<>) else Doc -> Doc -> Doc
(<+>)
        a (ConcreteTypeF StaticExpression a
e)                = StaticExpression a -> Doc
forall a. Pretty a => a -> Doc
pretty StaticExpression a
e
        a (TupleF a
_ [Doc]
ts)                    = Doc -> Doc
parens ([Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat (Doc -> [Doc] -> [Doc]
punctuate Doc
", " ((Doc -> Doc) -> [Doc] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Doc
forall a. Pretty a => a -> Doc
pretty ([Doc] -> [Doc]
forall a. [a] -> [a]
reverse [Doc]
ts))))
        a (BoxTupleF a
_ NonEmpty Doc
ts)                 = Doc
"'(" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat (Doc -> [Doc] -> [Doc]
punctuate Doc
", " (NonEmpty Doc -> [Doc]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty Doc -> [Doc]) -> NonEmpty Doc -> [Doc]
forall a b. (a -> b) -> a -> b
$ (Doc -> Doc) -> NonEmpty Doc -> NonEmpty Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Doc
forall a. Pretty a => a -> Doc
pretty (NonEmpty Doc -> NonEmpty Doc
forall a. NonEmpty a -> NonEmpty a
NE.reverse NonEmpty Doc
ts))) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
")"
        a (RefTypeF Doc
t)                     = Doc
"&" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
t
        a (FunctionTypeF String
s Doc
t Doc
t')           = Doc
t Doc -> Doc -> Doc
<+> String -> Doc
string String
s Doc -> Doc -> Doc
<+> Doc
t'
        a (ViewLiteralF Addendum
c)                 = Doc
"view" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Addendum -> Doc
forall a. Pretty a => a -> Doc
pretty Addendum
c
        a ImplicitTypeF{}                  = Doc
".."
        a (AnonymousRecordF a
_ NonEmpty (String, Doc)
rs)          = NonEmpty (String, Doc) -> Doc
forall a. Pretty a => NonEmpty (String, a) -> Doc
prettyRecord NonEmpty (String, Doc)
rs
        a (WhereTypeF a
_ Doc
t String
i SortArgs a
sa Doc
t')         = Doc
t Doc -> Doc -> Doc
<#> Int -> Doc -> Doc
indent Int
2 (Doc
"where" Doc -> Doc -> Doc
</> String -> Doc
forall a. Pretty a => a -> Doc
pretty String
i Doc -> Doc -> Doc
<+> SortArgs a -> Doc
forall a. Pretty a => Maybe [a] -> Doc
prettySortArgs SortArgs a
sa Doc -> Doc -> Doc
<+> Doc
"=" Doc -> Doc -> Doc
<+> Doc -> Doc
forall a. Pretty a => a -> Doc
pretty Doc
t')
        a AddrTypeF{}                      = Doc
"addr"

gan :: Eq a => Maybe (Sort a) -> Doc
gan :: Maybe (Sort a) -> Doc
gan (Just Sort a
t) = Doc
" : " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Sort a -> Doc
forall a. Pretty a => a -> Doc
pretty Sort a
t Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
" "
gan Maybe (Sort a)
Nothing  = Doc
""

withHashtag :: Bool -> Doc
withHashtag :: Bool -> Doc
withHashtag Bool
True = Doc
"#["
withHashtag Bool
_    = Doc
lbracket

instance Eq a => Pretty (Existential a) where
    pretty :: Existential a -> Doc
pretty (Existential [] Bool
b (Just Sort a
st) (Just StaticExpression a
e')) = Bool -> Doc
withHashtag Bool
b Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Sort a -> Doc
forall a. Pretty a => a -> Doc
pretty Sort a
st Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> StaticExpression a -> Doc
forall a. Pretty a => a -> Doc
pretty StaticExpression a
e' Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
rbracket
    pretty (Existential [] Bool
b Maybe (Sort a)
Nothing (Just StaticExpression a
e'))   = Bool -> Doc
withHashtag Bool
b Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> StaticExpression a -> Doc
forall a. Pretty a => a -> Doc
pretty StaticExpression a
e' Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
rbracket
    pretty (Existential [String
e] Bool
b (Just Sort a
st) Maybe (StaticExpression a)
Nothing)  = Bool -> Doc
withHashtag Bool
b Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
e Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
":" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Sort a -> Doc
forall a. Pretty a => a -> Doc
pretty Sort a
st Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
rbracket
    pretty (Existential [String]
bs Bool
b Maybe (Sort a)
st Maybe (StaticExpression a)
Nothing)          = Bool -> Doc
withHashtag Bool
b Doc -> Doc -> Doc
<+> [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat (Doc -> [Doc] -> [Doc]
punctuate Doc
", " ((String -> Doc) -> [String] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Doc
forall a. Pretty a => a -> Doc
pretty [String]
bs)) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Maybe (Sort a) -> Doc
forall a. Eq a => Maybe (Sort a) -> Doc
gan Maybe (Sort a)
st Doc -> Doc -> Doc
<+> Doc
rbracket
    pretty (Existential [String]
bs Bool
b Maybe (Sort a)
st (Just StaticExpression a
e))         = Bool -> Doc
withHashtag Bool
b Doc -> Doc -> Doc
<+> [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat (Doc -> [Doc] -> [Doc]
punctuate Doc
", " ((String -> Doc) -> [String] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Doc
forall a. Pretty a => a -> Doc
pretty [String]
bs)) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Maybe (Sort a) -> Doc
forall a. Eq a => Maybe (Sort a) -> Doc
gan Maybe (Sort a)
st Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"|" Doc -> Doc -> Doc
<+> StaticExpression a -> Doc
forall a. Pretty a => a -> Doc
pretty StaticExpression a
e Doc -> Doc -> Doc
<+> Doc
rbracket

instance Eq a => Pretty (Universal a) where
    pretty :: Universal a -> Doc
pretty (Universal [String
x] Maybe (Sort a)
Nothing []) = Doc
lbrace Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
x Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
rbrace
    pretty (Universal [String
x] (Just Sort a
st) []) = Doc
lbrace Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
x Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
":" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Sort a -> Doc
forall a. Pretty a => a -> Doc
pretty Sort a
st Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
rbrace
    pretty (Universal [String]
bs Maybe (Sort a)
Nothing []) = Doc
lbrace Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat (Doc -> [Doc] -> [Doc]
punctuate Doc
"," ((String -> Doc) -> [String] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Doc
forall a. Pretty a => a -> Doc
pretty [String]
bs)) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
rbrace
    pretty (Universal [String]
bs (Just Sort a
ty) []) = Doc
lbrace Doc -> Doc -> Doc
<+> [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat (Doc -> [Doc] -> [Doc]
punctuate Doc
", " ((String -> Doc) -> [String] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Doc
forall a. Pretty a => a -> Doc
pretty [String]
bs)) Doc -> Doc -> Doc
<+> Doc
":" Doc -> Doc -> Doc
<+> Sort a -> Doc
forall a. Pretty a => a -> Doc
pretty Sort a
ty Doc -> Doc -> Doc
<+> Doc
rbrace
    pretty (Universal [String]
bs Maybe (Sort a)
ty [StaticExpression a]
es) = Doc
lbrace Doc -> Doc -> Doc
<+> [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat (Doc -> [Doc] -> [Doc]
punctuate Doc
", " ((String -> Doc) -> [String] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Doc
forall a. Pretty a => a -> Doc
pretty [String]
bs)) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Maybe (Sort a) -> Doc
forall a. Eq a => Maybe (Sort a) -> Doc
gan Maybe (Sort a)
ty Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"|" Doc -> Doc -> Doc
<+> [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat (Doc -> [Doc] -> [Doc]
punctuate Doc
"; " ((StaticExpression a -> Doc) -> [StaticExpression a] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StaticExpression a -> Doc
forall a. Pretty a => a -> Doc
pretty [StaticExpression a]
es)) Doc -> Doc -> Doc
<+> Doc
rbrace

instance Eq a => Pretty (ATS a) where
    pretty :: ATS a -> Doc
pretty (ATS [Declaration a]
xs) = [Declaration a] -> Doc
forall a. Eq a => [Declaration a] -> Doc
concatSame [Declaration a]
xs

prettyOr :: (Pretty a, Eq a) => [[a]] -> Doc
prettyOr :: [[a]] -> Doc
prettyOr [] = Doc
forall a. Monoid a => a
mempty
prettyOr [[a]]
is = [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat (([a] -> Doc) -> [[a]] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Doc -> Doc -> [a] -> Doc
forall a (f :: * -> *).
(Pretty a, Foldable f, Functor f) =>
Doc -> Doc -> f a -> Doc
prettyArgsU Doc
"<" Doc
">") [[a]]
is)

prettyImplExpr :: Eq a => Either (StaticExpression a) (Expression a) -> Doc
prettyImplExpr :: Either (StaticExpression a) (Expression a) -> Doc
prettyImplExpr (Left StaticExpression a
se) = StaticExpression a -> Doc
forall a. Pretty a => a -> Doc
pretty StaticExpression a
se
prettyImplExpr (Right Expression a
e) = Expression a -> Doc
forall a. Pretty a => a -> Doc
pretty Expression a
e

instance Eq a => Pretty (Implementation a) where
    pretty :: Implementation a -> Doc
pretty (Implement a
_ [] [[Type a]]
is [] Name a
n (Just []) Either (StaticExpression a) (Expression a)
e)  = Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
n Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [[Type a]] -> Doc
forall a. (Pretty a, Eq a) => [[a]] -> Doc
prettyOr [[Type a]]
is Doc -> Doc -> Doc
<+> Doc
"() =" Doc -> Doc -> Doc
<$> Int -> Doc -> Doc
indent Int
2 (Either (StaticExpression a) (Expression a) -> Doc
forall a. Eq a => Either (StaticExpression a) (Expression a) -> Doc
prettyImplExpr Either (StaticExpression a) (Expression a)
e)
    pretty (Implement a
_ [] [[Type a]]
is [] Name a
n Maybe [Arg a]
Nothing Either (StaticExpression a) (Expression a)
e)    = Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
n Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [[Type a]] -> Doc
forall a. (Pretty a, Eq a) => [[a]] -> Doc
prettyOr [[Type a]]
is Doc -> Doc -> Doc
<+> Doc
"=" Doc -> Doc -> Doc
<$> Int -> Doc -> Doc
indent Int
2 (Either (StaticExpression a) (Expression a) -> Doc
forall a. Eq a => Either (StaticExpression a) (Expression a) -> Doc
prettyImplExpr Either (StaticExpression a) (Expression a)
e)
    pretty (Implement a
_ [] [[Type a]]
is [] Name a
n (Just [Arg a]
ias) Either (StaticExpression a) (Expression a)
e) = Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
n Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [[Type a]] -> Doc
forall a. (Pretty a, Eq a) => [[a]] -> Doc
prettyOr [[Type a]]
is Doc -> Doc -> Doc
<+> [Arg a] -> Doc
forall a (f :: * -> *).
(Pretty a, Foldable f, Functor f) =>
f a -> Doc
prettyArgs [Arg a]
ias Doc -> Doc -> Doc
<+> Doc
"=" Doc -> Doc -> Doc
<$> Int -> Doc -> Doc
indent Int
2 (Either (StaticExpression a) (Expression a) -> Doc
forall a. Eq a => Either (StaticExpression a) (Expression a) -> Doc
prettyImplExpr Either (StaticExpression a) (Expression a)
e)
    pretty (Implement a
_ [] [[Type a]]
is [Universal a]
us Name a
n (Just [Arg a]
ias) Either (StaticExpression a) (Expression a)
e) = Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
n Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [[Type a]] -> Doc
forall a. (Pretty a, Eq a) => [[a]] -> Doc
prettyOr [[Type a]]
is Doc -> Doc -> Doc
<+> (Universal a -> Doc) -> [Universal a] -> Doc
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Universal a -> Doc
forall a. Pretty a => a -> Doc
pretty [Universal a]
us Doc -> Doc -> Doc
</> [Arg a] -> Doc
forall a (f :: * -> *).
(Pretty a, Foldable f, Functor f) =>
f a -> Doc
prettyArgs [Arg a]
ias Doc -> Doc -> Doc
<+> Doc
"=" Doc -> Doc -> Doc
<$> Int -> Doc -> Doc
indent Int
2 (Either (StaticExpression a) (Expression a) -> Doc
forall a. Eq a => Either (StaticExpression a) (Expression a) -> Doc
prettyImplExpr Either (StaticExpression a) (Expression a)
e)
    pretty (Implement a
_ [] [[Type a]]
is [Universal a]
us Name a
n Maybe [Arg a]
Nothing Either (StaticExpression a) (Expression a)
e) = Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
n Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [[Type a]] -> Doc
forall a. (Pretty a, Eq a) => [[a]] -> Doc
prettyOr [[Type a]]
is Doc -> Doc -> Doc
<+> (Universal a -> Doc) -> [Universal a] -> Doc
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Universal a -> Doc
forall a. Pretty a => a -> Doc
pretty [Universal a]
us Doc -> Doc -> Doc
</> Doc
"=" Doc -> Doc -> Doc
<$> Int -> Doc -> Doc
indent Int
2 (Either (StaticExpression a) (Expression a) -> Doc
forall a. Eq a => Either (StaticExpression a) (Expression a) -> Doc
prettyImplExpr Either (StaticExpression a) (Expression a)
e)
    pretty (Implement a
_ [Universal a]
ps [[Type a]]
is [] Name a
n (Just [Arg a]
ias) Either (StaticExpression a) (Expression a)
e) = (Universal a -> Doc) -> [Universal a] -> Doc
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Universal a -> Doc
forall a. Pretty a => a -> Doc
pretty [Universal a]
ps Doc -> Doc -> Doc
</> Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
n Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [[Type a]] -> Doc
forall a. (Pretty a, Eq a) => [[a]] -> Doc
prettyOr [[Type a]]
is Doc -> Doc -> Doc
<+> [Arg a] -> Doc
forall a (f :: * -> *).
(Pretty a, Foldable f, Functor f) =>
f a -> Doc
prettyArgs [Arg a]
ias Doc -> Doc -> Doc
<+> Doc
"=" Doc -> Doc -> Doc
<$> Int -> Doc -> Doc
indent Int
2 (Either (StaticExpression a) (Expression a) -> Doc
forall a. Eq a => Either (StaticExpression a) (Expression a) -> Doc
prettyImplExpr Either (StaticExpression a) (Expression a)
e)
    pretty (Implement a
_ [Universal a]
ps [[Type a]]
is [] Name a
n Maybe [Arg a]
Nothing Either (StaticExpression a) (Expression a)
e)    = (Universal a -> Doc) -> [Universal a] -> Doc
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Universal a -> Doc
forall a. Pretty a => a -> Doc
pretty [Universal a]
ps Doc -> Doc -> Doc
</> Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
n Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [[Type a]] -> Doc
forall a. (Pretty a, Eq a) => [[a]] -> Doc
prettyOr [[Type a]]
is Doc -> Doc -> Doc
<+> Doc
"=" Doc -> Doc -> Doc
<$> Int -> Doc -> Doc
indent Int
2 (Either (StaticExpression a) (Expression a) -> Doc
forall a. Eq a => Either (StaticExpression a) (Expression a) -> Doc
prettyImplExpr Either (StaticExpression a) (Expression a)
e)
    pretty (Implement a
_ [Universal a]
ps [[Type a]]
is [Universal a]
us Name a
n (Just [Arg a]
ias) Either (StaticExpression a) (Expression a)
e) = (Universal a -> Doc) -> [Universal a] -> Doc
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Universal a -> Doc
forall a. Pretty a => a -> Doc
pretty [Universal a]
ps Doc -> Doc -> Doc
</> Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
n Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [[Type a]] -> Doc
forall a. (Pretty a, Eq a) => [[a]] -> Doc
prettyOr [[Type a]]
is Doc -> Doc -> Doc
</> (Universal a -> Doc) -> [Universal a] -> Doc
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Universal a -> Doc
forall a. Pretty a => a -> Doc
pretty [Universal a]
us Doc -> Doc -> Doc
<+> [Arg a] -> Doc
forall a (f :: * -> *).
(Pretty a, Foldable f, Functor f) =>
f a -> Doc
prettyArgs [Arg a]
ias Doc -> Doc -> Doc
<+> Doc
"=" Doc -> Doc -> Doc
<$> Int -> Doc -> Doc
indent Int
2 (Either (StaticExpression a) (Expression a) -> Doc
forall a. Eq a => Either (StaticExpression a) (Expression a) -> Doc
prettyImplExpr Either (StaticExpression a) (Expression a)
e)
    pretty (Implement a
_ [Universal a]
ps [[Type a]]
is [Universal a]
us Name a
n Maybe [Arg a]
Nothing Either (StaticExpression a) (Expression a)
e) = (Universal a -> Doc) -> [Universal a] -> Doc
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Universal a -> Doc
forall a. Pretty a => a -> Doc
pretty [Universal a]
ps Doc -> Doc -> Doc
</> Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
n Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [[Type a]] -> Doc
forall a. (Pretty a, Eq a) => [[a]] -> Doc
prettyOr [[Type a]]
is Doc -> Doc -> Doc
</> (Universal a -> Doc) -> [Universal a] -> Doc
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Universal a -> Doc
forall a. Pretty a => a -> Doc
pretty [Universal a]
us Doc -> Doc -> Doc
<+> Doc
"=" Doc -> Doc -> Doc
<$> Int -> Doc -> Doc
indent Int
2 (Either (StaticExpression a) (Expression a) -> Doc
forall a. Eq a => Either (StaticExpression a) (Expression a) -> Doc
prettyImplExpr Either (StaticExpression a) (Expression a)
e)

isVal :: Declaration a -> Bool
isVal :: Declaration a -> Bool
isVal Val{}     = Bool
True
isVal Var{}     = Bool
True
isVal PrVal{}   = Bool
True
isVal PrVar{}   = Bool
True
isVal AndDecl{} = Bool
True
isVal Declaration a
_         = Bool
False

isTyDecl :: Declaration a -> Bool
isTyDecl :: Declaration a -> Bool
isTyDecl ViewTypeDef{} = Bool
True
isTyDecl TypeDef{}     = Bool
True
isTyDecl ViewDef{}     = Bool
True
isTyDecl Declaration a
_             = Bool
False

isAbsTyDecl :: Declaration a -> Bool
isAbsTyDecl :: Declaration a -> Bool
isAbsTyDecl AbsView{}     = Bool
True
isAbsTyDecl AbsViewType{} = Bool
True
isAbsTyDecl AbsVT0p{}     = Bool
True
isAbsTyDecl AbsT0p{}      = Bool
True
isAbsTyDecl AbsType{}     = Bool
True
isAbsTyDecl Declaration a
_             = Bool
False

isOverload :: Declaration a -> Bool
isOverload :: Declaration a -> Bool
isOverload OverloadOp{}    = Bool
True
isOverload OverloadIdent{} = Bool
True
isOverload Declaration a
_               = Bool
False

-- isTypeDef :: Declaration a -> Bool
-- isTypeDef ViewTypeDef{} = True
-- isTypeDef TypeDef{} = True

notDefine :: String -> Bool
notDefine :: String -> Bool
notDefine = Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"#define" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`)

glue :: Declaration a -> Declaration a -> Bool
glue :: Declaration a -> Declaration a -> Bool
glue Declaration a
x Declaration a
y
    | Declaration a -> Bool
forall a. Declaration a -> Bool
isVal Declaration a
x Bool -> Bool -> Bool
&& Declaration a -> Bool
forall a. Declaration a -> Bool
isVal Declaration a
y = Bool
True
    | Declaration a -> Bool
forall a. Declaration a -> Bool
isOverload Declaration a
x Bool -> Bool -> Bool
&& Declaration a -> Bool
forall a. Declaration a -> Bool
isOverload Declaration a
y = Bool
True
    | Declaration a -> Bool
forall a. Declaration a -> Bool
isTyDecl Declaration a
x Bool -> Bool -> Bool
&& Declaration a -> Bool
forall a. Declaration a -> Bool
isTyDecl Declaration a
y = Bool
True
    | Declaration a -> Bool
forall a. Declaration a -> Bool
isAbsTyDecl Declaration a
x Bool -> Bool -> Bool
&& Declaration a -> Bool
forall a. Declaration a -> Bool
isAbsTyDecl Declaration a
y = Bool
True
glue Stadef{} Stadef{}             = Bool
True
glue Load{} Load{}                 = Bool
True
glue Define{} Define{}             = Bool
True
glue Include{} Include{}           = Bool
True
glue FixityDecl{} FixityDecl{}     = Bool
True
glue AbsImpl{} AbsImpl{}           = Bool
True
glue Comment{} Declaration a
_                   = Bool
True
glue (Func a
_ Fnx{}) (Func a
_ And{}) = Bool
True
glue Assume{} Assume{}             = Bool
True
glue (Define String
s) Declaration a
_ | String -> Bool
notDefine String
s    = Bool
True
glue Declaration a
_ (Define String
s) | String -> Bool
notDefine String
s    = Bool
True
glue Declaration a
_ Declaration a
_                           = Bool
False

concatSame :: Eq a => [Declaration a] -> Doc
concatSame :: [Declaration a] -> Doc
concatSame []  = Doc
forall a. Monoid a => a
mempty
concatSame [Declaration a
x] = Declaration a -> Doc
forall a. Pretty a => a -> Doc
pretty Declaration a
x
concatSame (Declaration a
x:Declaration a
x':[Declaration a]
xs)
    | Declaration a -> Declaration a -> Bool
forall a. Declaration a -> Declaration a -> Bool
glue Declaration a
x Declaration a
x' = Declaration a -> Doc
forall a. Pretty a => a -> Doc
pretty Declaration a
x Doc -> Doc -> Doc
<$> [Declaration a] -> Doc
forall a. Eq a => [Declaration a] -> Doc
concatSame (Declaration a
x'Declaration a -> [Declaration a] -> [Declaration a]
forall a. a -> [a] -> [a]
:[Declaration a]
xs)
    | Bool
otherwise = Declaration a -> Doc
forall a. Pretty a => a -> Doc
pretty Declaration a
x Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
line Doc -> Doc -> Doc
<$> [Declaration a] -> Doc
forall a. Eq a => [Declaration a] -> Doc
concatSame (Declaration a
x'Declaration a -> [Declaration a] -> [Declaration a]
forall a. a -> [a] -> [a]
:[Declaration a]
xs)

($$) :: Doc -> Doc -> Doc
Doc
x $$ :: Doc -> Doc -> Doc
$$ Doc
y = Doc -> Doc
align (Doc
x Doc -> Doc -> Doc
<$> Doc
y)

lineAlt :: Doc -> Doc -> Doc
lineAlt :: Doc -> Doc -> Doc
lineAlt = Doc -> Doc
group (Doc -> Doc) -> (Doc -> Doc -> Doc) -> Doc -> Doc -> Doc
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.* Doc -> Doc -> Doc
flatAlt

showFast :: Doc -> String
showFast :: Doc -> String
showFast Doc
d = SimpleDoc -> String -> String
displayS (Doc -> SimpleDoc
renderCompact Doc
d) String
forall a. Monoid a => a
mempty

prettyRecord :: (Pretty a) => NonEmpty (String, a) -> Doc
prettyRecord :: NonEmpty (String, a) -> Doc
prettyRecord NonEmpty (String, a)
es
    | ((String, a) -> Bool) -> NonEmpty (String, a) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
40) (Int -> Bool) -> ((String, a) -> Int) -> (String, a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> ((String, a) -> String) -> (String, a) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> String
showFast (Doc -> String) -> ((String, a) -> Doc) -> (String, a) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, a) -> Doc
forall a. Pretty a => a -> Doc
pretty) NonEmpty (String, a)
es = Bool -> [(String, a)] -> Doc
forall a. Pretty a => Bool -> [(String, a)] -> Doc
prettyRecordF Bool
True (NonEmpty (String, a) -> [(String, a)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (String, a)
es)
    | Bool
otherwise                                   = Doc -> Doc -> Doc
lineAlt (Bool -> [(String, a)] -> Doc
forall a. Pretty a => Bool -> [(String, a)] -> Doc
prettyRecordF Bool
True (NonEmpty (String, a) -> [(String, a)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (String, a)
es)) (Bool -> [(String, a)] -> Doc
forall a. Pretty a => Bool -> [(String, a)] -> Doc
prettyRecordS Bool
True (NonEmpty (String, a) -> [(String, a)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (String, a)
es))

prettyRecordS :: (Pretty a) => Bool -> [(String, a)] -> Doc
prettyRecordS :: Bool -> [(String, a)] -> Doc
prettyRecordS Bool
_ []             = Doc
forall a. Monoid a => a
mempty
prettyRecordS Bool
True [(String
s, a
t)]    = Doc
"@{" Doc -> Doc -> Doc
<+> String -> Doc
text String
s Doc -> Doc -> Doc
<+> Doc
"=" Doc -> Doc -> Doc
<+> a -> Doc
forall a. Pretty a => a -> Doc
pretty a
t Doc -> Doc -> Doc
<+> Doc
"}"
prettyRecordS Bool
_ [(String
s, a
t)]       = Doc
"@{" Doc -> Doc -> Doc
<+> String -> Doc
text String
s Doc -> Doc -> Doc
<+> Doc
"=" Doc -> Doc -> Doc
<+> a -> Doc
forall a. Pretty a => a -> Doc
pretty a
t
prettyRecordS Bool
True ((String
s, a
t):[(String, a)]
xs) = Bool -> [(String, a)] -> Doc
forall a. Pretty a => Bool -> [(String, a)] -> Doc
prettyRecordS Bool
False [(String, a)]
xs Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"," Doc -> Doc -> Doc
<+> String -> Doc
text String
s Doc -> Doc -> Doc
<+> (Doc
"=" Doc -> Doc -> Doc
<+> a -> Doc
forall a. Pretty a => a -> Doc
pretty a
t) Doc -> Doc -> Doc
<+> Doc
"}"
prettyRecordS Bool
x ((String
s, a
t):[(String, a)]
xs)    = Bool -> [(String, a)] -> Doc
forall a. Pretty a => Bool -> [(String, a)] -> Doc
prettyRecordS Bool
x [(String, a)]
xs Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"," Doc -> Doc -> Doc
<+> String -> Doc
text String
s Doc -> Doc -> Doc
<+> (Doc
"=" Doc -> Doc -> Doc
<+> a -> Doc
forall a. Pretty a => a -> Doc
pretty a
t)

prettyRecordF :: (Pretty a) => Bool -> [(String, a)] -> Doc
prettyRecordF :: Bool -> [(String, a)] -> Doc
prettyRecordF Bool
_ []             = Doc
forall a. Monoid a => a
mempty
prettyRecordF Bool
True [(String
s, a
t)]    = Doc
"@{" Doc -> Doc -> Doc
<+> String -> Doc
text String
s Doc -> Doc -> Doc
<+> Doc -> Doc
align (Doc
"=" Doc -> Doc -> Doc
<+> a -> Doc
forall a. Pretty a => a -> Doc
pretty a
t) Doc -> Doc -> Doc
<+> Doc
"}"
prettyRecordF Bool
_ [(String
s, a
t)]       = Doc
"@{" Doc -> Doc -> Doc
<+> String -> Doc
text String
s Doc -> Doc -> Doc
<+> Doc -> Doc
align (Doc
"=" Doc -> Doc -> Doc
<+> a -> Doc
forall a. Pretty a => a -> Doc
pretty a
t)
prettyRecordF Bool
True ((String
s, a
t):[(String, a)]
xs) = Bool -> [(String, a)] -> Doc
forall a. Pretty a => Bool -> [(String, a)] -> Doc
prettyRecordF Bool
False [(String, a)]
xs Doc -> Doc -> Doc
$$ Int -> Doc -> Doc
indent Int
1 (Doc
"," Doc -> Doc -> Doc
<+> String -> Doc
text String
s Doc -> Doc -> Doc
<+> Doc -> Doc
align (Doc
"=" Doc -> Doc -> Doc
<+> a -> Doc
forall a. Pretty a => a -> Doc
pretty a
t) Doc -> Doc -> Doc
<$> Doc
"}")
prettyRecordF Bool
x ((String
s, a
t):[(String, a)]
xs)    = Bool -> [(String, a)] -> Doc
forall a. Pretty a => Bool -> [(String, a)] -> Doc
prettyRecordF Bool
x [(String, a)]
xs Doc -> Doc -> Doc
$$ Int -> Doc -> Doc
indent Int
1 (Doc
"," Doc -> Doc -> Doc
<+> String -> Doc
text String
s Doc -> Doc -> Doc
<+> Doc -> Doc
align (Doc
"=" Doc -> Doc -> Doc
<+> a -> Doc
forall a. Pretty a => a -> Doc
pretty a
t))

prettyUsNil :: Eq a => [Universal a] -> Doc
prettyUsNil :: [Universal a] -> Doc
prettyUsNil [] = Doc
space
prettyUsNil [Universal a]
us = Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> (Universal a -> Doc) -> [Universal a] -> Doc
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Universal a -> Doc
forall a. Pretty a => a -> Doc
pretty [Universal a]
us Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
space

prettyUsStarNil :: Eq a => [Universal a] -> Doc
prettyUsStarNil :: [Universal a] -> Doc
prettyUsStarNil [] = Doc
space
prettyUsStarNil [Universal a]
us = Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> (Universal a -> Doc) -> [Universal a] -> Doc
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Universal a -> Doc
forall a. Pretty a => a -> Doc
pretty [Universal a]
us

prettyOf :: (Pretty a) => Maybe a -> Doc
prettyOf :: Maybe a -> Doc
prettyOf Maybe a
Nothing  = Doc
forall a. Monoid a => a
mempty
prettyOf (Just a
x) = Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"of" Doc -> Doc -> Doc
<+> a -> Doc
forall a. Pretty a => a -> Doc
pretty a
x

prettyDL :: Eq a => [DataPropLeaf a] -> Doc
prettyDL :: [DataPropLeaf a] -> Doc
prettyDL []                        = Doc
forall a. Monoid a => a
mempty
prettyDL [DataPropLeaf [Universal a]
us Expression a
e Maybe (Expression a)
e']    = Int -> Doc -> Doc
indent Int
2 (Doc
"|" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Universal a] -> Doc
forall a. Eq a => [Universal a] -> Doc
prettyUsNil [Universal a]
us Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Expression a -> Doc
forall a. Pretty a => a -> Doc
pretty Expression a
e Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Maybe (Expression a) -> Doc
forall a. Pretty a => Maybe a -> Doc
prettyOf Maybe (Expression a)
e')
prettyDL (DataPropLeaf [Universal a]
us Expression a
e Maybe (Expression a)
e':[DataPropLeaf a]
xs) = [DataPropLeaf a] -> Doc
forall a. Eq a => [DataPropLeaf a] -> Doc
prettyDL [DataPropLeaf a]
xs Doc -> Doc -> Doc
$$ Int -> Doc -> Doc
indent Int
2 (Doc
"|" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Universal a] -> Doc
forall a. Eq a => [Universal a] -> Doc
prettyUsNil [Universal a]
us Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Expression a -> Doc
forall a. Pretty a => a -> Doc
pretty Expression a
e Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Maybe (Expression a) -> Doc
forall a. Pretty a => Maybe a -> Doc
prettyOf Maybe (Expression a)
e')

prettyDSL :: Eq a => [DataSortLeaf a] -> Doc
prettyDSL :: [DataSortLeaf a] -> Doc
prettyDSL []                          = Doc
forall a. Monoid a => a
mempty
prettyDSL [DataSortLeaf [Universal a]
us Sort a
sr Maybe (Sort a)
sr']    = Int -> Doc -> Doc
indent Int
2 (Doc
"|" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Universal a] -> Doc
forall a. Eq a => [Universal a] -> Doc
prettyUsNil [Universal a]
us Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Sort a -> Doc
forall a. Pretty a => a -> Doc
pretty Sort a
sr Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Maybe (Sort a) -> Doc
forall a. Pretty a => Maybe a -> Doc
prettyOf Maybe (Sort a)
sr')
prettyDSL (DataSortLeaf [Universal a]
us Sort a
sr Maybe (Sort a)
sr':[DataSortLeaf a]
xs) = [DataSortLeaf a] -> Doc
forall a. Eq a => [DataSortLeaf a] -> Doc
prettyDSL [DataSortLeaf a]
xs Doc -> Doc -> Doc
$$ Int -> Doc -> Doc
indent Int
2 (Doc
"|" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Universal a] -> Doc
forall a. Eq a => [Universal a] -> Doc
prettyUsNil [Universal a]
us Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Sort a -> Doc
forall a. Pretty a => a -> Doc
pretty Sort a
sr Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Maybe (Sort a) -> Doc
forall a. Pretty a => Maybe a -> Doc
prettyOf Maybe (Sort a)
sr')

prettyLeaf :: Eq a => [Leaf a] -> Doc
prettyLeaf :: [Leaf a] -> Doc
prettyLeaf []                         = Doc
forall a. Monoid a => a
mempty
prettyLeaf [Leaf [] String
s [] Maybe (Type a)
Nothing]     = Int -> Doc -> Doc
indent Int
2 (Doc
"|" Doc -> Doc -> Doc
<+> String -> Doc
text String
s)
prettyLeaf [Leaf [] String
s [] (Just Type a
e)]    = Int -> Doc -> Doc
indent Int
2 (Doc
"|" Doc -> Doc -> Doc
<+> String -> Doc
text String
s Doc -> Doc -> Doc
<+> Doc
"of" Doc -> Doc -> Doc
<+> Type a -> Doc
forall a. Pretty a => a -> Doc
pretty Type a
e)
prettyLeaf (Leaf [] String
s [] Maybe (Type a)
Nothing:[Leaf a]
xs)  = [Leaf a] -> Doc
forall a. Eq a => [Leaf a] -> Doc
prettyLeaf [Leaf a]
xs Doc -> Doc -> Doc
$$ Int -> Doc -> Doc
indent Int
2 (Doc
"|" Doc -> Doc -> Doc
<+> String -> Doc
text String
s)
prettyLeaf (Leaf [] String
s [] (Just Type a
e):[Leaf a]
xs) = [Leaf a] -> Doc
forall a. Eq a => [Leaf a] -> Doc
prettyLeaf [Leaf a]
xs Doc -> Doc -> Doc
$$ Int -> Doc -> Doc
indent Int
2 (Doc
"|" Doc -> Doc -> Doc
<+> String -> Doc
text String
s Doc -> Doc -> Doc
<+> Doc
"of" Doc -> Doc -> Doc
<+> Type a -> Doc
forall a. Pretty a => a -> Doc
pretty Type a
e)
prettyLeaf [Leaf [] String
s [StaticExpression a]
as Maybe (Type a)
Nothing]     = Int -> Doc -> Doc
indent Int
2 (Doc
"|" Doc -> Doc -> Doc
<+> String -> Doc
text String
s Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [StaticExpression a] -> Doc
forall a (f :: * -> *).
(Pretty a, Foldable f, Functor f) =>
f a -> Doc
prettyArgs [StaticExpression a]
as)
prettyLeaf [Leaf [] String
s [StaticExpression a]
as (Just Type a
e)]    = Int -> Doc -> Doc
indent Int
2 (Doc
"|" Doc -> Doc -> Doc
<+> String -> Doc
text String
s Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [StaticExpression a] -> Doc
forall a (f :: * -> *).
(Pretty a, Foldable f, Functor f) =>
f a -> Doc
prettyArgs [StaticExpression a]
as Doc -> Doc -> Doc
<+> Doc
"of" Doc -> Doc -> Doc
<+> Type a -> Doc
forall a. Pretty a => a -> Doc
pretty Type a
e)
prettyLeaf (Leaf [] String
s [StaticExpression a]
as Maybe (Type a)
Nothing:[Leaf a]
xs)  = [Leaf a] -> Doc
forall a. Eq a => [Leaf a] -> Doc
prettyLeaf [Leaf a]
xs Doc -> Doc -> Doc
$$ Int -> Doc -> Doc
indent Int
2 (Doc
"|" Doc -> Doc -> Doc
<+> String -> Doc
text String
s Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [StaticExpression a] -> Doc
forall a (f :: * -> *).
(Pretty a, Foldable f, Functor f) =>
f a -> Doc
prettyArgs [StaticExpression a]
as)
prettyLeaf (Leaf [] String
s [StaticExpression a]
as (Just Type a
e):[Leaf a]
xs) = [Leaf a] -> Doc
forall a. Eq a => [Leaf a] -> Doc
prettyLeaf [Leaf a]
xs Doc -> Doc -> Doc
$$ Int -> Doc -> Doc
indent Int
2 (Doc
"|" Doc -> Doc -> Doc
<+> String -> Doc
text String
s Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [StaticExpression a] -> Doc
forall a (f :: * -> *).
(Pretty a, Foldable f, Functor f) =>
f a -> Doc
prettyArgs [StaticExpression a]
as Doc -> Doc -> Doc
<+> Doc
"of" Doc -> Doc -> Doc
<+> Type a -> Doc
forall a. Pretty a => a -> Doc
pretty Type a
e)
prettyLeaf [Leaf [Universal a]
us String
s [] Maybe (Type a)
Nothing]     = Int -> Doc -> Doc
indent Int
2 (Doc
"|" Doc -> Doc -> Doc
<+> [Universal a] -> Doc
forall b. Pretty b => [b] -> Doc
fancyU [Universal a]
us Doc -> Doc -> Doc
<+> String -> Doc
text String
s)
prettyLeaf [Leaf [Universal a]
us String
s [] (Just Type a
e)]    = Int -> Doc -> Doc
indent Int
2 (Doc
"|" Doc -> Doc -> Doc
<+> [Universal a] -> Doc
forall b. Pretty b => [b] -> Doc
fancyU [Universal a]
us Doc -> Doc -> Doc
<+> String -> Doc
text String
s Doc -> Doc -> Doc
<+> Doc
"of" Doc -> Doc -> Doc
<+> Type a -> Doc
forall a. Pretty a => a -> Doc
pretty Type a
e)
prettyLeaf (Leaf [Universal a]
us String
s [] Maybe (Type a)
Nothing:[Leaf a]
xs)  = [Leaf a] -> Doc
forall a. Eq a => [Leaf a] -> Doc
prettyLeaf [Leaf a]
xs Doc -> Doc -> Doc
$$ Int -> Doc -> Doc
indent Int
2 (Doc
"|" Doc -> Doc -> Doc
<+> [Universal a] -> Doc
forall b. Pretty b => [b] -> Doc
fancyU [Universal a]
us Doc -> Doc -> Doc
<+> String -> Doc
text String
s)
prettyLeaf (Leaf [Universal a]
us String
s [] (Just Type a
e):[Leaf a]
xs) = [Leaf a] -> Doc
forall a. Eq a => [Leaf a] -> Doc
prettyLeaf [Leaf a]
xs Doc -> Doc -> Doc
$$ Int -> Doc -> Doc
indent Int
2 (Doc
"|" Doc -> Doc -> Doc
<+> [Universal a] -> Doc
forall b. Pretty b => [b] -> Doc
fancyU [Universal a]
us Doc -> Doc -> Doc
<+> String -> Doc
text String
s Doc -> Doc -> Doc
<+> Doc
"of" Doc -> Doc -> Doc
<+> Type a -> Doc
forall a. Pretty a => a -> Doc
pretty Type a
e)
prettyLeaf [Leaf [Universal a]
us String
s [StaticExpression a]
as Maybe (Type a)
Nothing]     = Int -> Doc -> Doc
indent Int
2 (Doc
"|" Doc -> Doc -> Doc
<+> [Universal a] -> Doc
forall b. Pretty b => [b] -> Doc
fancyU [Universal a]
us Doc -> Doc -> Doc
<+> String -> Doc
text String
s Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [StaticExpression a] -> Doc
forall a (f :: * -> *).
(Pretty a, Foldable f, Functor f) =>
f a -> Doc
prettyArgs [StaticExpression a]
as)
prettyLeaf [Leaf [Universal a]
us String
s [StaticExpression a]
as (Just Type a
e)]    = Int -> Doc -> Doc
indent Int
2 (Doc
"|" Doc -> Doc -> Doc
<+> [Universal a] -> Doc
forall b. Pretty b => [b] -> Doc
fancyU [Universal a]
us Doc -> Doc -> Doc
<+> String -> Doc
text String
s Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [StaticExpression a] -> Doc
forall a (f :: * -> *).
(Pretty a, Foldable f, Functor f) =>
f a -> Doc
prettyArgs [StaticExpression a]
as Doc -> Doc -> Doc
<+> Doc
"of" Doc -> Doc -> Doc
<+> Type a -> Doc
forall a. Pretty a => a -> Doc
pretty Type a
e)
prettyLeaf (Leaf [Universal a]
us String
s [StaticExpression a]
as Maybe (Type a)
Nothing:[Leaf a]
xs)  = [Leaf a] -> Doc
forall a. Eq a => [Leaf a] -> Doc
prettyLeaf [Leaf a]
xs Doc -> Doc -> Doc
$$ Int -> Doc -> Doc
indent Int
2 (Doc
"|" Doc -> Doc -> Doc
<+> [Universal a] -> Doc
forall b. Pretty b => [b] -> Doc
fancyU [Universal a]
us Doc -> Doc -> Doc
<+> String -> Doc
text String
s Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [StaticExpression a] -> Doc
forall a (f :: * -> *).
(Pretty a, Foldable f, Functor f) =>
f a -> Doc
prettyArgs [StaticExpression a]
as)
prettyLeaf (Leaf [Universal a]
us String
s [StaticExpression a]
as (Just Type a
e):[Leaf a]
xs) = [Leaf a] -> Doc
forall a. Eq a => [Leaf a] -> Doc
prettyLeaf [Leaf a]
xs Doc -> Doc -> Doc
$$ Int -> Doc -> Doc
indent Int
2 (Doc
"|" Doc -> Doc -> Doc
<+> [Universal a] -> Doc
forall b. Pretty b => [b] -> Doc
fancyU [Universal a]
us Doc -> Doc -> Doc
<+> String -> Doc
text String
s Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [StaticExpression a] -> Doc
forall a (f :: * -> *).
(Pretty a, Foldable f, Functor f) =>
f a -> Doc
prettyArgs [StaticExpression a]
as Doc -> Doc -> Doc
<+> Doc
"of" Doc -> Doc -> Doc
<+> Type a -> Doc
forall a. Pretty a => a -> Doc
pretty Type a
e)

prettyHelper :: Doc -> [Doc] -> [Doc]
prettyHelper :: Doc -> [Doc] -> [Doc]
prettyHelper Doc
_ [Doc
x]    = [Doc
x]
prettyHelper Doc
c (Doc
x:[Doc]
xs) = Doc -> Doc -> Doc
flatAlt (Doc
" " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
x) Doc
x Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (Doc -> Doc) -> [Doc] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Doc
c Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>) [Doc]
xs
prettyHelper Doc
_ [Doc]
x      = [Doc]
x

prettyBody :: Doc -> Doc -> [Doc] -> Doc
prettyBody :: Doc -> Doc -> [Doc] -> Doc
prettyBody Doc
c1 Doc
c2 [Doc
d] = Doc
c1 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
d Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
c2
prettyBody Doc
c1 Doc
c2 [Doc]
ds  = (Doc
c1 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>) (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
align (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc -> Doc
indent (-Int
1) (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
cat ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Doc] -> [Doc] -> [Doc]
forall a. Semigroup a => a -> a -> a
<> Doc -> [Doc]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc
c2) ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc]
ds

prettyArgsG' :: Foldable t => Doc -> Doc -> Doc -> t Doc -> Doc
prettyArgsG' :: Doc -> Doc -> Doc -> t Doc -> Doc
prettyArgsG' Doc
c3 Doc
c1 Doc
c2 = Doc -> Doc -> [Doc] -> Doc
prettyBody Doc
c1 Doc
c2 ([Doc] -> Doc) -> (t Doc -> [Doc]) -> t Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
prettyHelper Doc
c3 ([Doc] -> [Doc]) -> (t Doc -> [Doc]) -> t Doc -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> [Doc]
forall a. [a] -> [a]
reverse ([Doc] -> [Doc]) -> (t Doc -> [Doc]) -> t Doc -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t Doc -> [Doc]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

prettyArgsList :: Foldable t => Doc -> Doc -> Doc -> t Doc -> Doc
prettyArgsList :: Doc -> Doc -> Doc -> t Doc -> Doc
prettyArgsList Doc
c3 Doc
c1 Doc
c2 = Doc -> Doc -> [Doc] -> Doc
prettyBody Doc
c1 Doc
c2 ([Doc] -> Doc) -> (t Doc -> [Doc]) -> t Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> [Doc]
va ([Doc] -> [Doc]) -> (t Doc -> [Doc]) -> t Doc -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
prettyHelper Doc
c3 ([Doc] -> [Doc]) -> (t Doc -> [Doc]) -> t Doc -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t Doc -> [Doc]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
    where va :: [Doc] -> [Doc]
va = ([Doc] -> ([Doc] -> [Doc]) -> [Doc]
forall a b. a -> (a -> b) -> b
& ([Doc] -> Identity [Doc]) -> [Doc] -> Identity [Doc]
forall s a. Cons s s a a => Traversal' s s
_tail(([Doc] -> Identity [Doc]) -> [Doc] -> Identity [Doc])
-> ((Doc -> Identity Doc) -> [Doc] -> Identity [Doc])
-> (Doc -> Identity Doc)
-> [Doc]
-> Identity [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Doc -> Identity Doc) -> [Doc] -> Identity [Doc]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Doc -> Identity Doc) -> [Doc] -> Identity [Doc])
-> (Doc -> Doc) -> [Doc] -> [Doc]
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Doc -> Doc
group)

prettyArgsG :: Foldable t => Doc -> Doc -> t Doc -> Doc
prettyArgsG :: Doc -> Doc -> t Doc -> Doc
prettyArgsG = Doc -> Doc -> Doc -> t Doc -> Doc
forall (t :: * -> *).
Foldable t =>
Doc -> Doc -> Doc -> t Doc -> Doc
prettyArgsG' Doc
", "

prettyArgsU :: (Pretty a, Foldable f, Functor f) => Doc -> Doc -> f a -> Doc
prettyArgsU :: Doc -> Doc -> f a -> Doc
prettyArgsU = Doc -> Doc -> Doc -> f a -> Doc
forall a (f :: * -> *).
(Pretty a, Functor f, Foldable f) =>
Doc -> Doc -> Doc -> f a -> Doc
prettyArgs' Doc
","

prettyArgs' :: (Pretty a, Functor f, Foldable f) => Doc -> Doc -> Doc -> f a -> Doc
prettyArgs' :: Doc -> Doc -> Doc -> f a -> Doc
prettyArgs' = (a -> Doc) -> f a -> f Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Doc
forall a. Pretty a => a -> Doc
pretty (f a -> f Doc)
-> (Doc -> Doc -> Doc -> f Doc -> Doc)
-> Doc
-> Doc
-> Doc
-> f a
-> Doc
forall d e a b c f.
(d -> e) -> (a -> b -> c -> e -> f) -> a -> b -> c -> d -> f
.@@@ Doc -> Doc -> Doc -> f Doc -> Doc
forall (t :: * -> *).
Foldable t =>
Doc -> Doc -> Doc -> t Doc -> Doc
prettyArgsG'

prettyArgs :: (Pretty a, Foldable f, Functor f) => f a -> Doc
prettyArgs :: f a -> Doc
prettyArgs = Doc -> Doc -> Doc -> f a -> Doc
forall a (f :: * -> *).
(Pretty a, Functor f, Foldable f) =>
Doc -> Doc -> Doc -> f a -> Doc
prettyArgs' Doc
", " Doc
"(" Doc
")"

prettyArgsNil :: Eq a => Maybe [Arg a] -> Doc
prettyArgsNil :: Maybe [Arg a] -> Doc
prettyArgsNil Maybe [Arg a]
Nothing   = Doc
forall a. Monoid a => a
mempty
prettyArgsNil (Just [Arg a]
as) = Doc -> Doc -> Doc -> [Arg a] -> Doc
forall a (f :: * -> *).
(Pretty a, Functor f, Foldable f) =>
Doc -> Doc -> Doc -> f a -> Doc
prettyArgs' Doc
", " Doc
"(" Doc
")" [Arg a]
as

fancyU :: Pretty a => [a] -> Doc
fancyU :: [a] -> Doc
fancyU = (a -> Doc) -> [a] -> Doc
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> Doc
forall a. Pretty a => a -> Doc
pretty

(<#>) :: Doc -> Doc -> Doc
<#> :: Doc -> Doc -> Doc
(<#>) Doc
a Doc
b = Doc -> Doc -> Doc
lineAlt (Doc
a Doc -> Doc -> Doc
<$> Int -> Doc -> Doc
indent Int
2 Doc
b) (Doc
a Doc -> Doc -> Doc
<+> Doc
b)

prettySigG :: (Pretty a) => Doc -> Doc -> Maybe String -> Maybe a -> Doc
prettySigG :: Doc -> Doc -> Maybe String -> Maybe a -> Doc
prettySigG Doc
d Doc
d' (Just String
si) (Just a
rt) = Doc
d Doc -> Doc -> Doc
`op` Doc
":" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
si Doc -> Doc -> Doc
<#> a -> Doc
forall a. Pretty a => a -> Doc
pretty a
rt Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
d'
    where op :: Doc -> Doc -> Doc
op Doc
a Doc
b = Doc -> Doc -> Doc
lineAlt (Doc
a Doc -> Doc -> Doc
<$> Int -> Doc -> Doc
indent Int
2 Doc
b) (Doc
a Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
b)
prettySigG Doc
_ Doc
_ Maybe String
_ Maybe a
_                  = Doc
forall a. Monoid a => a
mempty

prettySigNull :: (Pretty a) => Maybe String -> Maybe a -> Doc
prettySigNull :: Maybe String -> Maybe a -> Doc
prettySigNull = Doc -> Doc -> Maybe String -> Maybe a -> Doc
forall a. Pretty a => Doc -> Doc -> Maybe String -> Maybe a -> Doc
prettySigG Doc
space Doc
forall a. Monoid a => a
mempty

prettySig :: (Pretty a) => Maybe String -> Maybe a -> Doc
prettySig :: Maybe String -> Maybe a -> Doc
prettySig = Doc -> Doc -> Maybe String -> Maybe a -> Doc
forall a. Pretty a => Doc -> Doc -> Maybe String -> Maybe a -> Doc
prettySigG Doc
space Doc
space

prettyTermetric :: Pretty a => a -> Doc
prettyTermetric :: a -> Doc
prettyTermetric a
t = Doc
softline Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
".<" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> a -> Doc
forall a. Pretty a => a -> Doc
pretty a
t Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
">." Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
softline

prettyETermetric :: Pretty a => Maybe a -> Doc
prettyETermetric :: Maybe a -> Doc
prettyETermetric Maybe a
Nothing  = Doc
softline Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
".<>." Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
softline
prettyETermetric (Just a
t) = Doc
softline Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
".<" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> a -> Doc
forall a. Pretty a => a -> Doc
pretty a
t Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
">." Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
softline

prettyMTermetric :: Pretty a => Maybe (Maybe a) -> Doc
prettyMTermetric :: Maybe (Maybe a) -> Doc
prettyMTermetric = Doc -> (Maybe a -> Doc) -> Maybe (Maybe a) -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
forall a. Monoid a => a
mempty Maybe a -> Doc
forall a. Pretty a => Maybe a -> Doc
prettyETermetric

-- FIXME figure out a nicer algorithm for when/how to split lines.
instance (Eq a, Pretty (ek a)) => Pretty (PreFunction ek a) where
    pretty :: PreFunction ek a -> Doc
pretty (PreF Name a
i Maybe String
si [] [] Args a
as Maybe (Type a)
rt Maybe (Maybe (StaticExpression a))
Nothing (Just ek a
e)) = Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
i Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Args a -> Doc
forall a. Eq a => Maybe [Arg a] -> Doc
prettyArgsNil Args a
as Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Maybe String -> Maybe (Type a) -> Doc
forall a. Pretty a => Maybe String -> Maybe a -> Doc
prettySig Maybe String
si Maybe (Type a)
rt Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"=" Doc -> Doc -> Doc
<$> Int -> Doc -> Doc
indent Int
2 (ek a -> Doc
forall a. Pretty a => a -> Doc
pretty ek a
e)
    pretty (PreF Name a
i Maybe String
si [] [Universal a]
us Args a
as Maybe (Type a)
rt Maybe (Maybe (StaticExpression a))
t (Just ek a
e)) = Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
i Doc -> Doc -> Doc
</> [Universal a] -> Doc
forall b. Pretty b => [b] -> Doc
fancyU [Universal a]
us Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Maybe (Maybe (StaticExpression a)) -> Doc
forall a. Pretty a => Maybe (Maybe a) -> Doc
prettyMTermetric Maybe (Maybe (StaticExpression a))
t Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Args a -> Doc
forall a. Eq a => Maybe [Arg a] -> Doc
prettyArgsNil Args a
as Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Maybe String -> Maybe (Type a) -> Doc
forall a. Pretty a => Maybe String -> Maybe a -> Doc
prettySig Maybe String
si Maybe (Type a)
rt Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"=" Doc -> Doc -> Doc
<$> Int -> Doc -> Doc
indent Int
2 (ek a -> Doc
forall a. Pretty a => a -> Doc
pretty ek a
e)
    pretty (PreF Name a
i Maybe String
si [Universal a]
pus [] Args a
as Maybe (Type a)
rt Maybe (Maybe (StaticExpression a))
Nothing (Just ek a
e)) = [Universal a] -> Doc
forall b. Pretty b => [b] -> Doc
fancyU [Universal a]
pus Doc -> Doc -> Doc
</> Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
i Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Args a -> Doc
forall a. Eq a => Maybe [Arg a] -> Doc
prettyArgsNil Args a
as Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Maybe String -> Maybe (Type a) -> Doc
forall a. Pretty a => Maybe String -> Maybe a -> Doc
prettySig Maybe String
si Maybe (Type a)
rt Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"=" Doc -> Doc -> Doc
<$> Int -> Doc -> Doc
indent Int
2 (ek a -> Doc
forall a. Pretty a => a -> Doc
pretty ek a
e)
    pretty (PreF Name a
i Maybe String
si [Universal a]
pus [Universal a]
us Args a
as Maybe (Type a)
rt Maybe (Maybe (StaticExpression a))
t (Just ek a
e)) = [Universal a] -> Doc
forall b. Pretty b => [b] -> Doc
fancyU [Universal a]
pus Doc -> Doc -> Doc
</> Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
i Doc -> Doc -> Doc
</> [Universal a] -> Doc
forall b. Pretty b => [b] -> Doc
fancyU [Universal a]
us Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Maybe (Maybe (StaticExpression a)) -> Doc
forall a. Pretty a => Maybe (Maybe a) -> Doc
prettyMTermetric Maybe (Maybe (StaticExpression a))
t Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Args a -> Doc
forall a. Eq a => Maybe [Arg a] -> Doc
prettyArgsNil Args a
as Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Maybe String -> Maybe (Type a) -> Doc
forall a. Pretty a => Maybe String -> Maybe a -> Doc
prettySig Maybe String
si Maybe (Type a)
rt Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"=" Doc -> Doc -> Doc
<$> Int -> Doc -> Doc
indent Int
2 (ek a -> Doc
forall a. Pretty a => a -> Doc
pretty ek a
e)
    pretty (PreF Name a
i Maybe String
si [] [] Args a
as Maybe (Type a)
rt Maybe (Maybe (StaticExpression a))
Nothing Maybe (ek a)
Nothing) = Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
i Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Args a -> Doc
forall a. Eq a => Maybe [Arg a] -> Doc
prettyArgsNil Args a
as Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Maybe String -> Maybe (Type a) -> Doc
forall a. Pretty a => Maybe String -> Maybe a -> Doc
prettySigNull Maybe String
si Maybe (Type a)
rt
    pretty (PreF Name a
i Maybe String
si [] [Universal a]
us Args a
Nothing Maybe (Type a)
rt Maybe (Maybe (StaticExpression a))
Nothing Maybe (ek a)
Nothing) = Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
i Doc -> Doc -> Doc
</> [Universal a] -> Doc
forall b. Pretty b => [b] -> Doc
fancyU [Universal a]
us Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Maybe String -> Maybe (Type a) -> Doc
forall a. Pretty a => Maybe String -> Maybe a -> Doc
prettySigNull Maybe String
si Maybe (Type a)
rt
    pretty (PreF Name a
i Maybe String
si [] [Universal a]
us Args a
as Maybe (Type a)
rt Maybe (Maybe (StaticExpression a))
Nothing Maybe (ek a)
Nothing) = Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
i Doc -> Doc -> Doc
</> [Universal a] -> Doc
forall b. Pretty b => [b] -> Doc
fancyU [Universal a]
us Doc -> Doc -> Doc
</> Args a -> Doc
forall a. Eq a => Maybe [Arg a] -> Doc
prettyArgsNil Args a
as Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Maybe String -> Maybe (Type a) -> Doc
forall a. Pretty a => Maybe String -> Maybe a -> Doc
prettySigNull Maybe String
si Maybe (Type a)
rt
    pretty (PreF Name a
i Maybe String
si [Universal a]
pus [] Args a
as Maybe (Type a)
rt Maybe (Maybe (StaticExpression a))
t Maybe (ek a)
Nothing) = [Universal a] -> Doc
forall b. Pretty b => [b] -> Doc
fancyU [Universal a]
pus Doc -> Doc -> Doc
</> Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
i Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Maybe (Maybe (StaticExpression a)) -> Doc
forall a. Pretty a => Maybe (Maybe a) -> Doc
prettyMTermetric Maybe (Maybe (StaticExpression a))
t Doc -> Doc -> Doc
</> Args a -> Doc
forall a. Eq a => Maybe [Arg a] -> Doc
prettyArgsNil Args a
as Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Maybe String -> Maybe (Type a) -> Doc
forall a. Pretty a => Maybe String -> Maybe a -> Doc
prettySigNull Maybe String
si Maybe (Type a)
rt
    pretty (PreF Name a
i Maybe String
si [Universal a]
pus [Universal a]
us Args a
as Maybe (Type a)
rt Maybe (Maybe (StaticExpression a))
t Maybe (ek a)
Nothing) = [Universal a] -> Doc
forall b. Pretty b => [b] -> Doc
fancyU [Universal a]
pus Doc -> Doc -> Doc
</> Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
i Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Maybe (Maybe (StaticExpression a)) -> Doc
forall a. Pretty a => Maybe (Maybe a) -> Doc
prettyMTermetric Maybe (Maybe (StaticExpression a))
t Doc -> Doc -> Doc
</> [Universal a] -> Doc
forall b. Pretty b => [b] -> Doc
fancyU [Universal a]
us Doc -> Doc -> Doc
</> Args a -> Doc
forall a. Eq a => Maybe [Arg a] -> Doc
prettyArgsNil Args a
as Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Maybe String -> Maybe (Type a) -> Doc
forall a. Pretty a => Maybe String -> Maybe a -> Doc
prettySigNull Maybe String
si Maybe (Type a)
rt

prettyFix :: (Pretty a) => Either a String -> Doc
prettyFix :: Either a String -> Doc
prettyFix (Left a
i)  = a -> Doc
forall a. Pretty a => a -> Doc
pretty a
i
prettyFix (Right String
s) = Doc -> Doc
parens (String -> Doc
text String
s)

instance Eq a => Pretty (Fixity a) where
    pretty :: Fixity a -> Doc
pretty (Infix a
_ Fix
i)    = Doc
"infix" Doc -> Doc -> Doc
<+> Fix -> Doc
forall a. Pretty a => Either a String -> Doc
prettyFix Fix
i
    pretty (RightFix a
_ Fix
i) = Doc
"infixr" Doc -> Doc -> Doc
<+> Fix -> Doc
forall a. Pretty a => Either a String -> Doc
prettyFix Fix
i
    pretty (LeftFix a
_ Fix
i)  = Doc
"infixl" Doc -> Doc -> Doc
<+> Fix -> Doc
forall a. Pretty a => Either a String -> Doc
prettyFix Fix
i
    pretty (Pre a
_ Fix
i)      = Doc
"prefix" Doc -> Doc -> Doc
<+> Fix -> Doc
forall a. Pretty a => Either a String -> Doc
prettyFix Fix
i
    pretty (Post a
_ Fix
i)     = Doc
"postfix" Doc -> Doc -> Doc
<+> Fix -> Doc
forall a. Pretty a => Either a String -> Doc
prettyFix Fix
i

prettyMaybeType :: (Pretty a) => Maybe a -> Doc
prettyMaybeType :: Maybe a -> Doc
prettyMaybeType (Just a
a) = Doc
" =" Doc -> Doc -> Doc
<+> a -> Doc
forall a. Pretty a => a -> Doc
pretty a
a
prettyMaybeType Maybe a
_        = Doc
forall a. Monoid a => a
mempty

valSig :: (Pretty a) => Maybe a -> Doc
valSig :: Maybe a -> Doc
valSig = Doc -> Doc -> Maybe String -> Maybe a -> Doc
forall a. Pretty a => Doc -> Doc -> Maybe String -> Maybe a -> Doc
prettySigG Doc
forall a. Monoid a => a
mempty Doc
forall a. Monoid a => a
mempty (String -> Maybe String
forall a. a -> Maybe a
Just String
forall a. Monoid a => a
mempty)

prettySortArgs :: (Pretty a) => Maybe [a] -> Doc
prettySortArgs :: Maybe [a] -> Doc
prettySortArgs = Doc -> ([a] -> Doc) -> Maybe [a] -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
forall a. Monoid a => a
mempty (Doc -> Doc -> Doc -> [a] -> Doc
forall a (f :: * -> *).
(Pretty a, Functor f, Foldable f) =>
Doc -> Doc -> Doc -> f a -> Doc
prettyArgs' Doc
", " Doc
"(" Doc
")")

maybeT :: Pretty a => Maybe a -> Doc
maybeT :: Maybe a -> Doc
maybeT (Just a
x) = Doc
":" Doc -> Doc -> Doc
<+> a -> Doc
forall a. Pretty a => a -> Doc
pretty a
x
maybeT Maybe a
Nothing  = Doc
forall a. Monoid a => a
mempty

instance Eq a => Pretty (Declaration a) where
    pretty :: Declaration a -> Doc
pretty (Exception String
s Type a
t)                  = Doc
"exception" Doc -> Doc -> Doc
<+> String -> Doc
text String
s Doc -> Doc -> Doc
<+> Doc
"of" Doc -> Doc -> Doc
<+> Type a -> Doc
forall a. Pretty a => a -> Doc
pretty Type a
t
    pretty (AbsType a
_ String
s SortArgs a
as Maybe (Type a)
t)               = Doc
"abstype" Doc -> Doc -> Doc
<+> String -> Doc
text String
s Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> SortArgs a -> Doc
forall a. Pretty a => Maybe [a] -> Doc
prettySortArgs SortArgs a
as Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Maybe (Type a) -> Doc
forall a. Pretty a => Maybe a -> Doc
prettyMaybeType Maybe (Type a)
t
    pretty (AbsViewType a
_ String
s SortArgs a
as Maybe (Type a)
Nothing)     = Doc
"absvtype" Doc -> Doc -> Doc
<+> String -> Doc
text String
s Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> SortArgs a -> Doc
forall a. Pretty a => Maybe [a] -> Doc
prettySortArgs SortArgs a
as
    pretty (AbsViewType a
_ String
s SortArgs a
as (Just Type a
t))    = Doc
"absvtype" Doc -> Doc -> Doc
<+> String -> Doc
text String
s Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> SortArgs a -> Doc
forall a. Pretty a => Maybe [a] -> Doc
prettySortArgs SortArgs a
as Doc -> Doc -> Doc
<+> Doc
"=" Doc -> Doc -> Doc
<+> Type a -> Doc
forall a. Pretty a => a -> Doc
pretty Type a
t
    pretty (SumViewType String
s SortArgs a
as NonEmpty (Leaf a)
ls)            = Doc
"datavtype" Doc -> Doc -> Doc
<+> String -> Doc
text String
s Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> SortArgs a -> Doc
forall a. Pretty a => Maybe [a] -> Doc
prettySortArgs SortArgs a
as Doc -> Doc -> Doc
<+> Doc
"=" Doc -> Doc -> Doc
<$> [Leaf a] -> Doc
forall a. Eq a => [Leaf a] -> Doc
prettyLeaf (NonEmpty (Leaf a) -> [Leaf a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (Leaf a)
ls)
    pretty (AndD Declaration a
d (SumViewType String
s SortArgs a
as NonEmpty (Leaf a)
ls))   = Declaration a -> Doc
forall a. Pretty a => a -> Doc
pretty Declaration a
d Doc -> Doc -> Doc
<$> Doc
"and" Doc -> Doc -> Doc
<+> String -> Doc
text String
s Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> SortArgs a -> Doc
forall a. Pretty a => Maybe [a] -> Doc
prettySortArgs SortArgs a
as Doc -> Doc -> Doc
<+> Doc
"=" Doc -> Doc -> Doc
<$> [Leaf a] -> Doc
forall a. Eq a => [Leaf a] -> Doc
prettyLeaf (NonEmpty (Leaf a) -> [Leaf a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (Leaf a)
ls)
    pretty (AndD Declaration a
d (SumType String
s SortArgs a
as NonEmpty (Leaf a)
ls))       = Declaration a -> Doc
forall a. Pretty a => a -> Doc
pretty Declaration a
d Doc -> Doc -> Doc
<$> Doc
"and" Doc -> Doc -> Doc
<+> String -> Doc
text String
s Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> SortArgs a -> Doc
forall a. Pretty a => Maybe [a] -> Doc
prettySortArgs SortArgs a
as Doc -> Doc -> Doc
<+> Doc
"=" Doc -> Doc -> Doc
<$> [Leaf a] -> Doc
forall a. Eq a => [Leaf a] -> Doc
prettyLeaf (NonEmpty (Leaf a) -> [Leaf a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (Leaf a)
ls)
    pretty (AndD Declaration a
d (DataView a
_ String
s SortArgs a
as NonEmpty (Leaf a)
ls))    = Declaration a -> Doc
forall a. Pretty a => a -> Doc
pretty Declaration a
d Doc -> Doc -> Doc
<$> Doc
"and" Doc -> Doc -> Doc
<+> String -> Doc
text String
s Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> SortArgs a -> Doc
forall a. Pretty a => Maybe [a] -> Doc
prettySortArgs SortArgs a
as Doc -> Doc -> Doc
<+> Doc
"=" Doc -> Doc -> Doc
<$> [Leaf a] -> Doc
forall a. Eq a => [Leaf a] -> Doc
prettyLeaf (NonEmpty (Leaf a) -> [Leaf a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (Leaf a)
ls)
    pretty (DataView a
_ String
s SortArgs a
as NonEmpty (Leaf a)
ls)             = Doc
"dataview" Doc -> Doc -> Doc
<+> String -> Doc
text String
s Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> SortArgs a -> Doc
forall a. Pretty a => Maybe [a] -> Doc
prettySortArgs SortArgs a
as Doc -> Doc -> Doc
<+> Doc
"=" Doc -> Doc -> Doc
<$> [Leaf a] -> Doc
forall a. Eq a => [Leaf a] -> Doc
prettyLeaf (NonEmpty (Leaf a) -> [Leaf a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (Leaf a)
ls)
    pretty (SumType String
s SortArgs a
as NonEmpty (Leaf a)
ls)                = Doc
"datatype" Doc -> Doc -> Doc
<+> String -> Doc
text String
s Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> SortArgs a -> Doc
forall a. Pretty a => Maybe [a] -> Doc
prettySortArgs SortArgs a
as Doc -> Doc -> Doc
<+> Doc
"=" Doc -> Doc -> Doc
<$> [Leaf a] -> Doc
forall a. Eq a => [Leaf a] -> Doc
prettyLeaf (NonEmpty (Leaf a) -> [Leaf a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (Leaf a)
ls)
    pretty (DataSort a
_ String
s NonEmpty (DataSortLeaf a)
ls)                = Doc
"datasort" Doc -> Doc -> Doc
<+> String -> Doc
text String
s Doc -> Doc -> Doc
<+> Doc
"=" Doc -> Doc -> Doc
<$> [DataSortLeaf a] -> Doc
forall a. Eq a => [DataSortLeaf a] -> Doc
prettyDSL (NonEmpty (DataSortLeaf a) -> [DataSortLeaf a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (DataSortLeaf a)
ls)
    pretty (Impl Args a
as Implementation a
i)                      = Doc
"implement" Doc -> Doc -> Doc
<+> Args a -> Doc
forall a. Eq a => Maybe [Arg a] -> Doc
prettyArgsNil Args a
as Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Implementation a -> Doc
forall a. Pretty a => a -> Doc
pretty Implementation a
i
    pretty (ProofImpl Args a
as Implementation a
i)                 = Doc
"primplmnt" Doc -> Doc -> Doc
<+> Args a -> Doc
forall a. Eq a => Maybe [Arg a] -> Doc
prettyArgsNil Args a
as Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Implementation a -> Doc
forall a. Pretty a => a -> Doc
pretty Implementation a
i
    pretty (PrVal [Universal a]
us Pattern a
p (Just StaticExpression a
e) Maybe (Type a)
Nothing)    = Doc
"prval" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Universal a] -> Doc
forall a. Eq a => [Universal a] -> Doc
prettyUsNil [Universal a]
us Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Pattern a -> Doc
forall a. Pretty a => a -> Doc
pretty Pattern a
p Doc -> Doc -> Doc
<+> Doc
"=" Doc -> Doc -> Doc
<+> StaticExpression a -> Doc
forall a. Pretty a => a -> Doc
pretty StaticExpression a
e
    pretty (PrVal [Universal a]
us Pattern a
p Maybe (StaticExpression a)
Nothing (Just Type a
t))    = Doc
"prval" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Universal a] -> Doc
forall a. Eq a => [Universal a] -> Doc
prettyUsNil [Universal a]
us Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Pattern a -> Doc
forall a. Pretty a => a -> Doc
pretty Pattern a
p Doc -> Doc -> Doc
<+> Doc
":" Doc -> Doc -> Doc
<+> Type a -> Doc
forall a. Pretty a => a -> Doc
pretty Type a
t
    pretty (PrVal [Universal a]
us Pattern a
p (Just StaticExpression a
e) (Just Type a
t))   = Doc
"prval" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Universal a] -> Doc
forall a. Eq a => [Universal a] -> Doc
prettyUsNil [Universal a]
us Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Pattern a -> Doc
forall a. Pretty a => a -> Doc
pretty Pattern a
p Doc -> Doc -> Doc
<+> Doc
":" Doc -> Doc -> Doc
<+> Type a -> Doc
forall a. Pretty a => a -> Doc
pretty Type a
t Doc -> Doc -> Doc
<+> Doc
"=" Doc -> Doc -> Doc
<+> StaticExpression a -> Doc
forall a. Pretty a => a -> Doc
pretty StaticExpression a
e
    pretty PrVal{}                          = Doc
forall a. HasCallStack => a
undefined
    pretty (PrVar Pattern a
p (Just StaticExpression a
e) Maybe (Type a)
Nothing)       = Doc
"prvar" Doc -> Doc -> Doc
<+> Pattern a -> Doc
forall a. Pretty a => a -> Doc
pretty Pattern a
p Doc -> Doc -> Doc
<+> Doc
"=" Doc -> Doc -> Doc
<+> StaticExpression a -> Doc
forall a. Pretty a => a -> Doc
pretty StaticExpression a
e
    pretty (PrVar Pattern a
p Maybe (StaticExpression a)
Nothing (Just Type a
t))       = Doc
"prvar" Doc -> Doc -> Doc
<+> Pattern a -> Doc
forall a. Pretty a => a -> Doc
pretty Pattern a
p Doc -> Doc -> Doc
<+> Doc
":" Doc -> Doc -> Doc
<+> Type a -> Doc
forall a. Pretty a => a -> Doc
pretty Type a
t
    pretty (PrVar Pattern a
p (Just StaticExpression a
e) (Just Type a
t))      = Doc
"prvar" Doc -> Doc -> Doc
<+> Pattern a -> Doc
forall a. Pretty a => a -> Doc
pretty Pattern a
p Doc -> Doc -> Doc
<+> Doc
":" Doc -> Doc -> Doc
<+> Type a -> Doc
forall a. Pretty a => a -> Doc
pretty Type a
t Doc -> Doc -> Doc
<+> Doc
"=" Doc -> Doc -> Doc
<+> StaticExpression a -> Doc
forall a. Pretty a => a -> Doc
pretty StaticExpression a
e
    pretty PrVar{}                          = Doc
forall a. HasCallStack => a
undefined
    pretty (AndDecl Maybe (Type a)
t Pattern a
p Expression a
e)                  = Doc
"and" Doc -> Doc -> Doc
<+> Pattern a -> Doc
forall a. Pretty a => a -> Doc
pretty Pattern a
p Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Maybe (Type a) -> Doc
forall a. Pretty a => Maybe a -> Doc
valSig Maybe (Type a)
t Doc -> Doc -> Doc
<+> Doc
"=" Doc -> Doc -> Doc
<+> Expression a -> Doc
forall a. Pretty a => a -> Doc
pretty Expression a
e
    pretty (Val Addendum
a Maybe (Type a)
t Maybe (Pattern a)
p (Just Expression a
e))             = Doc
"val" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Addendum -> Doc
forall a. Pretty a => a -> Doc
pretty Addendum
a Doc -> Doc -> Doc
<+> Maybe (Pattern a) -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (Pattern a)
p Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Maybe (Type a) -> Doc
forall a. Pretty a => Maybe a -> Doc
valSig Maybe (Type a)
t Doc -> Doc -> Doc
<+> Doc
"=" Doc -> Doc -> Doc
<+> Expression a -> Doc
forall a. Pretty a => a -> Doc
pretty Expression a
e
    pretty (Val Addendum
a Maybe (Type a)
t Maybe (Pattern a)
p Maybe (Expression a)
Nothing)              = Doc
"val" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Addendum -> Doc
forall a. Pretty a => a -> Doc
pretty Addendum
a Doc -> Doc -> Doc
<+> Maybe (Pattern a) -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (Pattern a)
p Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Maybe (Type a) -> Doc
forall a. Pretty a => Maybe a -> Doc
valSig Maybe (Type a)
t
    pretty (Var Maybe (Type a)
t Pattern a
p Maybe (Expression a)
Nothing (Just Expression a
e))       = Doc
"var" Doc -> Doc -> Doc
<+> Pattern a -> Doc
forall a. Pretty a => a -> Doc
pretty Pattern a
p Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Maybe (Type a) -> Doc
forall a. Pretty a => Maybe a -> Doc
valSig Maybe (Type a)
t Doc -> Doc -> Doc
<+> Doc
"with" Doc -> Doc -> Doc
<+> Expression a -> Doc
forall a. Pretty a => a -> Doc
pretty Expression a
e
    pretty (Var Maybe (Type a)
t Pattern a
p (Just Expression a
e) Maybe (Expression a)
Nothing)       = Doc
"var" Doc -> Doc -> Doc
<+> Pattern a -> Doc
forall a. Pretty a => a -> Doc
pretty Pattern a
p Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Maybe (Type a) -> Doc
forall a. Pretty a => Maybe a -> Doc
valSig Maybe (Type a)
t Doc -> Doc -> Doc
<+> Doc
"=" Doc -> Doc -> Doc
<+> Expression a -> Doc
forall a. Pretty a => a -> Doc
pretty Expression a
e
    pretty (Var Maybe (Type a)
t Pattern a
p Maybe (Expression a)
Nothing Maybe (Expression a)
Nothing)        = Doc
"var" Doc -> Doc -> Doc
<+> Pattern a -> Doc
forall a. Pretty a => a -> Doc
pretty Pattern a
p Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Maybe (Type a) -> Doc
forall a. Pretty a => Maybe a -> Doc
valSig Maybe (Type a)
t
    pretty (Var Maybe (Type a)
_ Pattern a
_ Maybe (Expression a)
_ Just{})               = Doc
forall a. HasCallStack => a
undefined -- TODO figure out what this is supposed to be
    pretty (Include String
s)                      = Doc
"#include" Doc -> Doc -> Doc
<+> String -> Doc
forall a. Pretty a => a -> Doc
pretty String
s
    pretty (Load Bool
sta Bool
b Maybe String
Nothing String
s)           = Doc -> Doc -> Bool -> Doc
forall a. a -> a -> Bool -> a
bool Doc
"" Doc
"#" Bool
b Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc -> Bool -> Doc
forall a. a -> a -> Bool -> a
bool Doc
"dyn" Doc
"sta" Bool
sta Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"load" Doc -> Doc -> Doc
<+> String -> Doc
forall a. Pretty a => a -> Doc
pretty String
s
    pretty (Load Bool
sta Bool
b (Just String
q) String
s)          = Doc -> Doc -> Bool -> Doc
forall a. a -> a -> Bool -> a
bool Doc
"" Doc
"#" Bool
b Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc -> Bool -> Doc
forall a. a -> a -> Bool -> a
bool Doc
"dyn" Doc
"sta" Bool
sta Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"load" Doc -> Doc -> Doc
<+> String -> Doc
forall a. Pretty a => a -> Doc
pretty String
q Doc -> Doc -> Doc
<+> Doc
"=" Doc -> Doc -> Doc
<+> String -> Doc
forall a. Pretty a => a -> Doc
pretty String
s
    pretty (CBlock String
s)                       = String -> Doc
string String
s
    pretty (Comment String
s)                      = String -> Doc
string String
s
    pretty (OverloadOp a
_ BinOp a
o Name a
n (Just Int
n'))     = Doc
"overload" Doc -> Doc -> Doc
<+> BinOp a -> Doc
forall a. Pretty a => a -> Doc
pretty BinOp a
o Doc -> Doc -> Doc
<+> Doc
"with" Doc -> Doc -> Doc
<+> Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
n Doc -> Doc -> Doc
<+> Doc
"of" Doc -> Doc -> Doc
<+> Int -> Doc
forall a. Pretty a => a -> Doc
pretty Int
n'
    pretty (OverloadOp a
_ BinOp a
o Name a
n Maybe Int
Nothing)       = Doc
"overload" Doc -> Doc -> Doc
<+> BinOp a -> Doc
forall a. Pretty a => a -> Doc
pretty BinOp a
o Doc -> Doc -> Doc
<+> Doc
"with" Doc -> Doc -> Doc
<+> Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
n
    pretty (OverloadIdent a
_ String
i Name a
n Maybe Int
Nothing)    = Doc
"overload" Doc -> Doc -> Doc
<+> String -> Doc
text String
i Doc -> Doc -> Doc
<+> Doc
"with" Doc -> Doc -> Doc
<+> Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
n
    pretty (OverloadIdent a
_ String
i Name a
n (Just Int
n'))  = Doc
"overload" Doc -> Doc -> Doc
<+> String -> Doc
text String
i Doc -> Doc -> Doc
<+> Doc
"with" Doc -> Doc -> Doc
<+> Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
n Doc -> Doc -> Doc
<+> Doc
"of" Doc -> Doc -> Doc
<+> Int -> Doc
forall a. Pretty a => a -> Doc
pretty Int
n'
    -- We use 'text' here, which means indentation might get fucked up for
    -- C preprocessor macros, but you absolutely deserve it if you indent your
    -- macros.
    pretty (Define String
s) | String
"#if" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
s = String -> Doc
text (String
"\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
s)
                      | Bool
otherwise            = String -> Doc
text String
s
    pretty (Func a
_ (Fn PreFunction Expression a
pref))               = Doc
"fn" Doc -> Doc -> Doc
</> PreFunction Expression a -> Doc
forall a. Pretty a => a -> Doc
pretty PreFunction Expression a
pref
    pretty (Func a
_ (Fun PreFunction Expression a
pref))              = Doc
"fun" Doc -> Doc -> Doc
</> PreFunction Expression a -> Doc
forall a. Pretty a => a -> Doc
pretty PreFunction Expression a
pref
    pretty (Func a
_ (CastFn PreFunction Expression a
pref))           = Doc
"castfn" Doc -> Doc -> Doc
</> PreFunction Expression a -> Doc
forall a. Pretty a => a -> Doc
pretty PreFunction Expression a
pref
    pretty (Func a
_ (Fnx PreFunction Expression a
pref))              = Doc
"fnx" Doc -> Doc -> Doc
</> PreFunction Expression a -> Doc
forall a. Pretty a => a -> Doc
pretty PreFunction Expression a
pref
    pretty (Func a
_ (And PreFunction Expression a
pref))              = Doc
"and" Doc -> Doc -> Doc
</> PreFunction Expression a -> Doc
forall a. Pretty a => a -> Doc
pretty PreFunction Expression a
pref
    pretty (Func a
_ (Praxi PreFunction StaticExpression a
pref))            = Doc
"praxi" Doc -> Doc -> Doc
</> PreFunction StaticExpression a -> Doc
forall a. Pretty a => a -> Doc
pretty PreFunction StaticExpression a
pref
    pretty (Func a
_ (PrFun PreFunction StaticExpression a
pref))            = Doc
"prfun" Doc -> Doc -> Doc
</> PreFunction StaticExpression a -> Doc
forall a. Pretty a => a -> Doc
pretty PreFunction StaticExpression a
pref
    pretty (Func a
_ (PrFn PreFunction StaticExpression a
pref))             = Doc
"prfn" Doc -> Doc -> Doc
</> PreFunction StaticExpression a -> Doc
forall a. Pretty a => a -> Doc
pretty PreFunction StaticExpression a
pref
    pretty (Extern a
_ Declaration a
d)                     = Doc
"extern" Doc -> Doc -> Doc
<$> Declaration a -> Doc
forall a. Pretty a => a -> Doc
pretty Declaration a
d
    pretty (DataProp a
_ String
s SortArgs a
as [DataPropLeaf a]
ls)             = Doc
"dataprop" Doc -> Doc -> Doc
<+> String -> Doc
text String
s Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> SortArgs a -> Doc
forall a. Pretty a => Maybe [a] -> Doc
prettySortArgs SortArgs a
as Doc -> Doc -> Doc
<+> Doc
"=" Doc -> Doc -> Doc
<$> [DataPropLeaf a] -> Doc
forall a. Eq a => [DataPropLeaf a] -> Doc
prettyDL [DataPropLeaf a]
ls
    pretty (ViewTypeDef a
_ String
s SortArgs a
as Type a
t)           = Doc
"vtypedef" Doc -> Doc -> Doc
<+> String -> Doc
text String
s Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> SortArgs a -> Doc
forall a. Pretty a => Maybe [a] -> Doc
prettySortArgs SortArgs a
as Doc -> Doc -> Doc
<+> Doc
"=" Doc -> Doc -> Doc
<#> Type a -> Doc
forall a. Pretty a => a -> Doc
pretty Type a
t
    pretty (TypeDef a
_ String
s SortArgs a
as Type a
t Maybe (Sort a)
ms)            = Doc
"typedef" Doc -> Doc -> Doc
<+> String -> Doc
text String
s Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> SortArgs a -> Doc
forall a. Pretty a => Maybe [a] -> Doc
prettySortArgs SortArgs a
as Doc -> Doc -> Doc
<+> Doc
"=" Doc -> Doc -> Doc
<+> Type a -> Doc
forall a. Pretty a => a -> Doc
pretty Type a
t Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Maybe (Sort a) -> Doc
forall a. Pretty a => Maybe a -> Doc
maybeT Maybe (Sort a)
ms
    pretty (AbsProp a
_ String
n [Arg a]
as)                 = Doc
"absprop" Doc -> Doc -> Doc
<+> String -> Doc
text String
n Doc -> Doc -> Doc
<+> [Arg a] -> Doc
forall a (f :: * -> *).
(Pretty a, Foldable f, Functor f) =>
f a -> Doc
prettyArgs [Arg a]
as
    pretty (Assume Name a
n SortArgs a
as Type a
e)                  = Doc
"assume" Doc -> Doc -> Doc
</> Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
n Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> SortArgs a -> Doc
forall a. Pretty a => Maybe [a] -> Doc
prettySortArgs SortArgs a
as Doc -> Doc -> Doc
<+> Doc
"=" Doc -> Doc -> Doc
</> Type a -> Doc
forall a. Pretty a => a -> Doc
pretty Type a
e
    pretty (SymIntr a
_ [Name a]
ns)                   = Doc
"symintr" Doc -> Doc -> Doc
<+> [Doc] -> Doc
hsep ((Name a -> Doc) -> [Name a] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Name a -> Doc
forall a. Pretty a => a -> Doc
pretty [Name a]
ns)
    pretty (Stacst a
_ Name a
n Type a
t Maybe (StaticExpression a)
Nothing)           = Doc
"stacst" Doc -> Doc -> Doc
</> Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
n Doc -> Doc -> Doc
<+> Doc
":" Doc -> Doc -> Doc
</> Type a -> Doc
forall a. Pretty a => a -> Doc
pretty Type a
t
    pretty (Stacst a
_ Name a
n Type a
t (Just StaticExpression a
e))          = Doc
"stacst" Doc -> Doc -> Doc
</> Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
n Doc -> Doc -> Doc
<+> Doc
":" Doc -> Doc -> Doc
</> Type a -> Doc
forall a. Pretty a => a -> Doc
pretty Type a
t Doc -> Doc -> Doc
<+> Doc
"=" Doc -> Doc -> Doc
</> StaticExpression a -> Doc
forall a. Pretty a => a -> Doc
pretty StaticExpression a
e
    pretty (PropDef a
_ String
s as :: Args a
as@Just{} Type a
t)        = Doc
"propdef" Doc -> Doc -> Doc
</> String -> Doc
text String
s Doc -> Doc -> Doc
<+> Args a -> Doc
forall a. Eq a => Maybe [Arg a] -> Doc
prettyArgsNil Args a
as Doc -> Doc -> Doc
<+> Doc
"=" Doc -> Doc -> Doc
</> Type a -> Doc
forall a. Pretty a => a -> Doc
pretty Type a
t
    pretty (PropDef a
_ String
s Args a
Nothing Type a
t)          = Doc
"propdef" Doc -> Doc -> Doc
</> String -> Doc
text String
s Doc -> Doc -> Doc
<+> Doc
"=" Doc -> Doc -> Doc
</> Type a -> Doc
forall a. Pretty a => a -> Doc
pretty Type a
t
    pretty (Local a
_ (ATS [Declaration a]
ds) (ATS []))      = Doc
"local" Doc -> Doc -> Doc
<$> Int -> Doc -> Doc
indent Int
2 (ATS a -> Doc
forall a. Pretty a => a -> Doc
pretty ([Declaration a] -> ATS a
forall a. [Declaration a] -> ATS a
ATS [Declaration a]
ds)) Doc -> Doc -> Doc
<$> Doc
"in end"
    pretty (Local a
_ ATS a
d ATS a
d')                   = Doc
"local" Doc -> Doc -> Doc
<$> Int -> Doc -> Doc
indent Int
2 (ATS a -> Doc
forall a. Pretty a => a -> Doc
pretty ATS a
d) Doc -> Doc -> Doc
<$> Doc
"in" Doc -> Doc -> Doc
<$> Int -> Doc -> Doc
indent Int
2 (ATS a -> Doc
forall a. Pretty a => a -> Doc
pretty ATS a
d') Doc -> Doc -> Doc
<$> Doc
"end"
    pretty (FixityDecl Fixity a
f [String]
ss)                = Fixity a -> Doc
forall a. Pretty a => a -> Doc
pretty Fixity a
f Doc -> Doc -> Doc
<+> [Doc] -> Doc
hsep ((String -> Doc) -> [String] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Doc
text [String]
ss)
    pretty (StaVal [Universal a]
us String
i Type a
t)                  = Doc
"val" Doc -> Doc -> Doc
</> [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat ((Universal a -> Doc) -> [Universal a] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Universal a -> Doc
forall a. Pretty a => a -> Doc
pretty [Universal a]
us) Doc -> Doc -> Doc
<+> String -> Doc
text String
i Doc -> Doc -> Doc
<+> Doc
":" Doc -> Doc -> Doc
<+> Type a -> Doc
forall a. Pretty a => a -> Doc
pretty Type a
t
    pretty (Stadef String
i SortArgs a
as (Right (Maybe (Type a)
Nothing, Type a
t))) = Doc
"stadef" Doc -> Doc -> Doc
<+> String -> Doc
text String
i Doc -> Doc -> Doc
<+> SortArgs a -> Doc
forall a. Pretty a => Maybe [a] -> Doc
prettySortArgs SortArgs a
as Doc -> Doc -> Doc
<+> Doc
"=" Doc -> Doc -> Doc
<+> Type a -> Doc
forall a. Pretty a => a -> Doc
pretty Type a
t
    pretty (Stadef String
i SortArgs a
as (Right (Just Type a
ty, Type a
t))) = Doc
"stadef" Doc -> Doc -> Doc
<+> String -> Doc
text String
i Doc -> Doc -> Doc
<+> SortArgs a -> Doc
forall a. Pretty a => Maybe [a] -> Doc
prettySortArgs SortArgs a
as Doc -> Doc -> Doc
<+> Doc
":" Doc -> Doc -> Doc
<+> Type a -> Doc
forall a. Pretty a => a -> Doc
pretty Type a
ty Doc -> Doc -> Doc
<+> Doc
"=" Doc -> Doc -> Doc
<+> Type a -> Doc
forall a. Pretty a => a -> Doc
pretty Type a
t
    pretty (Stadef String
i SortArgs a
as (Left (StaticExpression a
se, Maybe (Sort a)
mt)))    = Doc
"stadef" Doc -> Doc -> Doc
<+> String -> Doc
text String
i Doc -> Doc -> Doc
<+> SortArgs a -> Doc
forall a. Pretty a => Maybe [a] -> Doc
prettySortArgs SortArgs a
as Doc -> Doc -> Doc
<+> Doc
"=" Doc -> Doc -> Doc
<+> StaticExpression a -> Doc
forall a. Pretty a => a -> Doc
pretty StaticExpression a
se Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Maybe (Sort a) -> Doc
forall a. Pretty a => Maybe a -> Doc
maybeT Maybe (Sort a)
mt
    pretty (AndD Declaration a
d (Stadef String
i SortArgs a
as (Right (Maybe (Type a)
Nothing, Type a
t)))) = Declaration a -> Doc
forall a. Pretty a => a -> Doc
pretty Declaration a
d Doc -> Doc -> Doc
<+> Doc
"and" Doc -> Doc -> Doc
<+> String -> Doc
text String
i Doc -> Doc -> Doc
<+> SortArgs a -> Doc
forall a. Pretty a => Maybe [a] -> Doc
prettySortArgs SortArgs a
as Doc -> Doc -> Doc
<+> Doc
"=" Doc -> Doc -> Doc
<+> Type a -> Doc
forall a. Pretty a => a -> Doc
pretty Type a
t
    pretty (AndD Declaration a
d (Stadef String
i SortArgs a
as (Right (Just Type a
ty, Type a
t)))) = Declaration a -> Doc
forall a. Pretty a => a -> Doc
pretty Declaration a
d Doc -> Doc -> Doc
<+> Doc
"and" Doc -> Doc -> Doc
<+> String -> Doc
text String
i Doc -> Doc -> Doc
<+> SortArgs a -> Doc
forall a. Pretty a => Maybe [a] -> Doc
prettySortArgs SortArgs a
as Doc -> Doc -> Doc
<+> Doc
":" Doc -> Doc -> Doc
<+> Type a -> Doc
forall a. Pretty a => a -> Doc
pretty Type a
ty Doc -> Doc -> Doc
<+> Doc
"=" Doc -> Doc -> Doc
<+> Type a -> Doc
forall a. Pretty a => a -> Doc
pretty Type a
t
    pretty (AndD Declaration a
d (Stadef String
i SortArgs a
as (Left (StaticExpression a
se, Maybe (Sort a)
mt)))) = Declaration a -> Doc
forall a. Pretty a => a -> Doc
pretty Declaration a
d Doc -> Doc -> Doc
<+> Doc
"and" Doc -> Doc -> Doc
<+> String -> Doc
text String
i Doc -> Doc -> Doc
<+> SortArgs a -> Doc
forall a. Pretty a => Maybe [a] -> Doc
prettySortArgs SortArgs a
as Doc -> Doc -> Doc
<+> Doc
"=" Doc -> Doc -> Doc
<+> StaticExpression a -> Doc
forall a. Pretty a => a -> Doc
pretty StaticExpression a
se Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Maybe (Sort a) -> Doc
forall a. Pretty a => Maybe a -> Doc
maybeT Maybe (Sort a)
mt
    pretty (AbsView a
_ String
i SortArgs a
as Maybe (Type a)
t)               = Doc
"absview" Doc -> Doc -> Doc
<+> String -> Doc
text String
i Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> SortArgs a -> Doc
forall a. Pretty a => Maybe [a] -> Doc
prettySortArgs SortArgs a
as Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Maybe (Type a) -> Doc
forall a. Pretty a => Maybe a -> Doc
prettyMaybeType Maybe (Type a)
t
    pretty (AbsVT0p a
_ String
i SortArgs a
as Maybe (Type a)
t)               = Doc
"absvt@ype" Doc -> Doc -> Doc
<+> String -> Doc
text String
i Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> SortArgs a -> Doc
forall a. Pretty a => Maybe [a] -> Doc
prettySortArgs SortArgs a
as Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Maybe (Type a) -> Doc
forall a. Pretty a => Maybe a -> Doc
prettyMaybeType Maybe (Type a)
t
    pretty (AbsT0p a
_ String
i SortArgs a
Nothing Maybe (Type a)
Nothing)     = Doc
"abst@ype" Doc -> Doc -> Doc
<+> String -> Doc
text String
i
    pretty (AbsT0p a
_ String
i SortArgs a
Nothing (Just Type a
t))    = Doc
"abst@ype" Doc -> Doc -> Doc
<+> String -> Doc
text String
i Doc -> Doc -> Doc
<+> Doc
"=" Doc -> Doc -> Doc
<+> Type a -> Doc
forall a. Pretty a => a -> Doc
pretty Type a
t
    pretty (AbsT0p a
_ String
i SortArgs a
as Maybe (Type a)
Nothing)          = Doc
"abst@ype" Doc -> Doc -> Doc
<+> String -> Doc
text String
i Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> SortArgs a -> Doc
forall a. Pretty a => Maybe [a] -> Doc
prettySortArgs SortArgs a
as
    pretty (AbsT0p a
_ String
i SortArgs a
as (Just Type a
t))         = Doc
"abst@ype" Doc -> Doc -> Doc
<+> String -> Doc
text String
i Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> SortArgs a -> Doc
forall a. Pretty a => Maybe [a] -> Doc
prettySortArgs SortArgs a
as Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"=" Doc -> Doc -> Doc
<+> Type a -> Doc
forall a. Pretty a => a -> Doc
pretty Type a
t
    pretty (ViewDef a
_ String
s SortArgs a
as Type a
t)               = Doc
"viewdef" Doc -> Doc -> Doc
<+> String -> Doc
text String
s Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> SortArgs a -> Doc
forall a. Pretty a => Maybe [a] -> Doc
prettySortArgs SortArgs a
as Doc -> Doc -> Doc
<+> Doc
"=" Doc -> Doc -> Doc
<#> Type a -> Doc
forall a. Pretty a => a -> Doc
pretty Type a
t
    pretty (TKind a
_ Name a
n String
s)                    = Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
n Doc -> Doc -> Doc
<+> Doc
"=" Doc -> Doc -> Doc
<+> String -> Doc
text String
s
    pretty (SortDef a
_ String
s Either (Sort a) (Universal a)
t)                  = Doc
"sortdef" Doc -> Doc -> Doc
<+> String -> Doc
text String
s Doc -> Doc -> Doc
<+> Doc
"=" Doc -> Doc -> Doc
<+> (Sort a -> Doc)
-> (Universal a -> Doc) -> Either (Sort a) (Universal a) -> Doc
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Sort a -> Doc
forall a. Pretty a => a -> Doc
pretty Universal a -> Doc
forall a. Pretty a => a -> Doc
pretty Either (Sort a) (Universal a)
t
    pretty (AndD Declaration a
d (SortDef a
_ String
i Either (Sort a) (Universal a)
t))         = Declaration a -> Doc
forall a. Pretty a => a -> Doc
pretty Declaration a
d Doc -> Doc -> Doc
<+> Doc
"and" Doc -> Doc -> Doc
<+> String -> Doc
text String
i Doc -> Doc -> Doc
<+> Doc
"=" Doc -> Doc -> Doc
<+> (Sort a -> Doc)
-> (Universal a -> Doc) -> Either (Sort a) (Universal a) -> Doc
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Sort a -> Doc
forall a. Pretty a => a -> Doc
pretty Universal a -> Doc
forall a. Pretty a => a -> Doc
pretty Either (Sort a) (Universal a)
t
    pretty (MacDecl a
_ String
n (Just [String]
is) Expression a
e)        = Doc
"macdef" Doc -> Doc -> Doc
<+> String -> Doc
text String
n Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"(" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat (Doc -> [Doc] -> [Doc]
punctuate Doc
", " ((String -> Doc) -> [String] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Doc
text [String]
is)) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
") =" Doc -> Doc -> Doc
<+> Expression a -> Doc
forall a. Pretty a => a -> Doc
pretty Expression a
e
    pretty (MacDecl a
_ String
n Maybe [String]
Nothing Expression a
e)          = Doc
"macdef" Doc -> Doc -> Doc
<+> String -> Doc
text String
n Doc -> Doc -> Doc
<+> Doc
"=" Doc -> Doc -> Doc
<+> Expression a -> Doc
forall a. Pretty a => a -> Doc
pretty Expression a
e
    pretty (ExtVar a
_ String
s Expression a
e)                   = Doc
"extvar" Doc -> Doc -> Doc
<+> String -> Doc
text String
s Doc -> Doc -> Doc
<+> Doc
"=" Doc -> Doc -> Doc
<+> Expression a -> Doc
forall a. Pretty a => a -> Doc
pretty Expression a
e
    pretty (AbsImpl a
_ Name a
n SortArgs a
as Type a
e)               = Doc
"absimpl" Doc -> Doc -> Doc
</> Name a -> Doc
forall a. Pretty a => a -> Doc
pretty Name a
n Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> SortArgs a -> Doc
forall a. Pretty a => Maybe [a] -> Doc
prettySortArgs SortArgs a
as Doc -> Doc -> Doc
<+> Doc
"=" Doc -> Doc -> Doc
</> Type a -> Doc
forall a. Pretty a => a -> Doc
pretty Type a
e
    pretty AndD{}                           = Doc
forall a. HasCallStack => a
undefined -- probably not valid syntax if we get to this point