{-# LANGUAGE FlexibleContexts, FlexibleInstances, OverloadedStrings, UndecidableInstances #-}
module Language.Oberon.Pretty (Precedence(Precedence)) where
import Control.Applicative (ZipList(ZipList, getZipList))
import Data.Char (toUpper)
import Data.Functor.Identity (Identity(..))
import Data.List (intersperse)
import Data.List.NonEmpty (NonEmpty((:|)), toList)
import qualified Data.Text as Text
import Data.Text.Prettyprint.Doc
import Numeric (showHex)
import qualified Language.Oberon.Abstract as Abstract
import Language.Oberon.AST
data Precedence e = Precedence Int e
instance (Pretty (Abstract.Import l), Pretty (Abstract.Block l l Identity Identity)) =>
Pretty (Module λ l Identity Identity) where
pretty :: forall ann. Module λ l Identity Identity -> Doc ann
pretty (Module Ident
name [Import l]
imports Identity (Block l l Identity Identity)
body) =
forall ann. [Doc ann] -> Doc ann
vsep forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$
[Doc ann
"MODULE" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Ident
name forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
semi,
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Import l]
imports then forall a. Monoid a => a
mempty
else Doc ann
"IMPORT" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall ann. [Doc ann] -> Doc ann
fillSep (forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate forall ann. Doc ann
comma forall a b. (a -> b) -> a -> b
$ forall {a} {a} {ann}.
(Pretty a, Pretty a) =>
(Maybe a, a) -> Doc ann
prettyImport forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Import l]
imports)) forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
semi,
forall a ann. Pretty a => a -> Doc ann
pretty Identity (Block l l Identity Identity)
body,
Doc ann
"END" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Ident
name forall a. Semigroup a => a -> a -> a
<> Doc ann
"." forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line]
where prettyImport :: (Maybe a, a) -> Doc ann
prettyImport (Maybe a
Nothing, a
mod) = forall a ann. Pretty a => a -> Doc ann
pretty a
mod
prettyImport (Just a
inner, a
mod) = forall a ann. Pretty a => a -> Doc ann
pretty a
inner forall a. Semigroup a => a -> a -> a
<> Doc ann
":=" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty a
mod
instance (Abstract.Nameable l, Pretty (Abstract.IdentDef l), Pretty (Abstract.Type l l Identity Identity),
Pretty (Abstract.Declaration l l Identity Identity),
Pretty (Abstract.Expression l l Identity Identity), Pretty (Abstract.FormalParameters l l Identity Identity),
Pretty (Abstract.ProcedureHeading l l Identity Identity),
Pretty (Abstract.Block l l Identity Identity)) =>
Pretty (Declaration λ l Identity Identity) where
pretty :: forall ann. Declaration λ l Identity Identity -> Doc ann
pretty (ConstantDeclaration IdentDef l
ident (Identity Expression l l Identity Identity
expr)) = Doc ann
"CONST" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty IdentDef l
ident forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"=" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Expression l l Identity Identity
expr forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
semi
pretty (TypeDeclaration IdentDef l
ident Identity (Type l l Identity Identity)
typeDef) = Doc ann
"TYPE" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty IdentDef l
ident forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"=" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Identity (Type l l Identity Identity)
typeDef forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
semi
pretty (VariableDeclaration IdentList l
idents Identity (Type l l Identity Identity)
varType) =
Doc ann
"VAR" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. [Doc ann] -> Doc ann
hsep (forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate forall ann. Doc ann
comma forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. NonEmpty a -> [a]
toList IdentList l
idents) forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
colon forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Identity (Type l l Identity Identity)
varType forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
semi
pretty (ProcedureDeclaration Identity (ProcedureHeading l l Identity Identity)
heading Identity (Block l l Identity Identity)
body) = forall ann. [Doc ann] -> Doc ann
vsep [forall a ann. Pretty a => a -> Doc ann
pretty Identity (ProcedureHeading l l Identity Identity)
heading forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
semi,
forall a ann. Pretty a => a -> Doc ann
pretty Identity (Block l l Identity Identity)
body,
Doc ann
"END" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty (forall l l' (f' :: * -> *) (f :: * -> *).
(Nameable l, Nameable l') =>
ProcedureHeading l l' f' f -> Ident
Abstract.getProcedureName forall a b. (a -> b) -> a -> b
$ forall a. Identity a -> a
runIdentity Identity (ProcedureHeading l l Identity Identity)
heading)
forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
semi]
pretty (ForwardDeclaration IdentDef l
ident Maybe (Identity (FormalParameters l l Identity Identity))
parameters) = Doc ann
"PROCEDURE" forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"^" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty IdentDef l
ident forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Maybe (Identity (FormalParameters l l Identity Identity))
parameters forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
semi
instance Pretty (IdentDef l) where
pretty :: forall ann. IdentDef l -> Doc ann
pretty (IdentDef Ident
name AccessMode
Exported) = forall a ann. Pretty a => a -> Doc ann
pretty Ident
name forall a. Semigroup a => a -> a -> a
<> Doc ann
"*"
pretty (IdentDef Ident
name AccessMode
ReadOnly) = forall a ann. Pretty a => a -> Doc ann
pretty Ident
name forall a. Semigroup a => a -> a -> a
<> Doc ann
"-"
pretty (IdentDef Ident
name AccessMode
PrivateOnly) = forall a ann. Pretty a => a -> Doc ann
pretty Ident
name
instance (Pretty (Precedence (Abstract.Expression l l Identity Identity)),
Pretty (Abstract.Expression l l Identity Identity),
Pretty (Abstract.Element l l Identity Identity),
Pretty (Abstract.Designator l l Identity Identity),
Pretty (Abstract.Value l l Identity Identity),
Pretty (Abstract.QualIdent l)) => Pretty (Expression λ l Identity Identity) where
pretty :: forall ann. Expression λ l Identity Identity -> Doc ann
pretty Expression λ l Identity Identity
e = forall a ann. Pretty a => a -> Doc ann
pretty (forall e. Int -> e -> Precedence e
Precedence Int
0 Expression λ l Identity Identity
e)
instance (Pretty (Precedence (Abstract.Expression l l Identity Identity)),
Pretty (Abstract.Expression l l Identity Identity),
Pretty (Abstract.Element l l Identity Identity),
Pretty (Abstract.Designator l l Identity Identity),
Pretty (Abstract.QualIdent l),
Pretty (Abstract.Value l l Identity Identity)) =>
Pretty (Precedence (Expression λ l Identity Identity)) where
pretty :: forall ann.
Precedence (Expression λ l Identity Identity) -> Doc ann
pretty (Precedence Int
0 (Relation RelOp
op Identity (Expression l l Identity Identity)
left Identity (Expression l l Identity Identity)
right)) = forall {e} {ann}.
Pretty (Precedence e) =>
Int -> Identity e -> Doc ann
prettyPrec' Int
1 Identity (Expression l l Identity Identity)
left forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty RelOp
op forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall {e} {ann}.
Pretty (Precedence e) =>
Int -> Identity e -> Doc ann
prettyPrec' Int
1 Identity (Expression l l Identity Identity)
right
pretty (Precedence Int
0 (IsA Identity (Expression l l Identity Identity)
left QualIdent l
right)) = forall {e} {ann}.
Pretty (Precedence e) =>
Int -> Identity e -> Doc ann
prettyPrec' Int
1 Identity (Expression l l Identity Identity)
left forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"IS" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty QualIdent l
right
pretty (Precedence Int
p (Add Identity (Expression l l Identity Identity)
left Identity (Expression l l Identity Identity)
right)) | Int
p forall a. Ord a => a -> a -> Bool
< Int
2 = forall {e} {ann}.
Pretty (Precedence e) =>
Int -> Identity e -> Doc ann
prettyPrec' Int
2 Identity (Expression l l Identity Identity)
left forall a. Semigroup a => a -> a -> a
<> Doc ann
"+" forall a. Semigroup a => a -> a -> a
<> forall {e} {ann}.
Pretty (Precedence e) =>
Int -> Identity e -> Doc ann
prettyPrec' Int
2 Identity (Expression l l Identity Identity)
right
pretty (Precedence Int
p (Subtract Identity (Expression l l Identity Identity)
left Identity (Expression l l Identity Identity)
right)) | Int
p forall a. Ord a => a -> a -> Bool
< Int
2 = forall {e} {ann}.
Pretty (Precedence e) =>
Int -> Identity e -> Doc ann
prettyPrec' Int
2 Identity (Expression l l Identity Identity)
left forall a. Semigroup a => a -> a -> a
<> Doc ann
"-" forall a. Semigroup a => a -> a -> a
<> forall {e} {ann}.
Pretty (Precedence e) =>
Int -> Identity e -> Doc ann
prettyPrec' Int
2 Identity (Expression l l Identity Identity)
right
pretty (Precedence Int
p (Or Identity (Expression l l Identity Identity)
left Identity (Expression l l Identity Identity)
right)) | Int
p forall a. Ord a => a -> a -> Bool
< Int
2 = forall {e} {ann}.
Pretty (Precedence e) =>
Int -> Identity e -> Doc ann
prettyPrec' Int
2 Identity (Expression l l Identity Identity)
left forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"OR" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall {e} {ann}.
Pretty (Precedence e) =>
Int -> Identity e -> Doc ann
prettyPrec' Int
2 Identity (Expression l l Identity Identity)
right
pretty (Precedence Int
p (Positive Identity (Expression l l Identity Identity)
e)) | Int
p forall a. Ord a => a -> a -> Bool
< Int
3 = Doc ann
"+" forall a. Semigroup a => a -> a -> a
<> forall {e} {ann}.
Pretty (Precedence e) =>
Int -> Identity e -> Doc ann
prettyPrec' Int
3 Identity (Expression l l Identity Identity)
e
pretty (Precedence Int
p (Negative Identity (Expression l l Identity Identity)
e)) | Int
p forall a. Ord a => a -> a -> Bool
< Int
3 = Doc ann
"-" forall a. Semigroup a => a -> a -> a
<> forall {e} {ann}.
Pretty (Precedence e) =>
Int -> Identity e -> Doc ann
prettyPrec' Int
3 Identity (Expression l l Identity Identity)
e
pretty (Precedence Int
p (Multiply Identity (Expression l l Identity Identity)
left Identity (Expression l l Identity Identity)
right)) | Int
p forall a. Ord a => a -> a -> Bool
< Int
4 = forall {e} {ann}.
Pretty (Precedence e) =>
Int -> Identity e -> Doc ann
prettyPrec' Int
4 Identity (Expression l l Identity Identity)
left forall a. Semigroup a => a -> a -> a
<> Doc ann
"*" forall a. Semigroup a => a -> a -> a
<> forall {e} {ann}.
Pretty (Precedence e) =>
Int -> Identity e -> Doc ann
prettyPrec' Int
4 Identity (Expression l l Identity Identity)
right
pretty (Precedence Int
p (Divide Identity (Expression l l Identity Identity)
left Identity (Expression l l Identity Identity)
right)) | Int
p forall a. Ord a => a -> a -> Bool
< Int
4 = forall {e} {ann}.
Pretty (Precedence e) =>
Int -> Identity e -> Doc ann
prettyPrec' Int
4 Identity (Expression l l Identity Identity)
left forall a. Semigroup a => a -> a -> a
<> Doc ann
"/" forall a. Semigroup a => a -> a -> a
<> forall {e} {ann}.
Pretty (Precedence e) =>
Int -> Identity e -> Doc ann
prettyPrec' Int
4 Identity (Expression l l Identity Identity)
right
pretty (Precedence Int
p (IntegerDivide Identity (Expression l l Identity Identity)
left Identity (Expression l l Identity Identity)
right)) | Int
p forall a. Ord a => a -> a -> Bool
< Int
4 = forall {e} {ann}.
Pretty (Precedence e) =>
Int -> Identity e -> Doc ann
prettyPrec' Int
4 Identity (Expression l l Identity Identity)
left forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"DIV" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall {e} {ann}.
Pretty (Precedence e) =>
Int -> Identity e -> Doc ann
prettyPrec' Int
4 Identity (Expression l l Identity Identity)
right
pretty (Precedence Int
p (Modulo Identity (Expression l l Identity Identity)
left Identity (Expression l l Identity Identity)
right)) | Int
p forall a. Ord a => a -> a -> Bool
< Int
4 = forall {e} {ann}.
Pretty (Precedence e) =>
Int -> Identity e -> Doc ann
prettyPrec' Int
4 Identity (Expression l l Identity Identity)
left forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"MOD" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall {e} {ann}.
Pretty (Precedence e) =>
Int -> Identity e -> Doc ann
prettyPrec' Int
4 Identity (Expression l l Identity Identity)
right
pretty (Precedence Int
p (And Identity (Expression l l Identity Identity)
left Identity (Expression l l Identity Identity)
right)) | Int
p forall a. Ord a => a -> a -> Bool
< Int
4 = forall {e} {ann}.
Pretty (Precedence e) =>
Int -> Identity e -> Doc ann
prettyPrec' Int
4 Identity (Expression l l Identity Identity)
left forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"&" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall {e} {ann}.
Pretty (Precedence e) =>
Int -> Identity e -> Doc ann
prettyPrec' Int
4 Identity (Expression l l Identity Identity)
right
pretty (Precedence Int
_ (Set ZipList (Identity (Element l l Identity Identity))
elements)) = forall ann. Doc ann -> Doc ann
braces (forall ann. [Doc ann] -> Doc ann
hsep forall a b. (a -> b) -> a -> b
$ forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate forall ann. Doc ann
comma forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Identity a -> a
runIdentity forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ZipList a -> [a]
getZipList ZipList (Identity (Element l l Identity Identity))
elements)
pretty (Precedence Int
_ (Read (Identity Designator l l Identity Identity
var))) = forall a ann. Pretty a => a -> Doc ann
pretty Designator l l Identity Identity
var
pretty (Precedence Int
_ (FunctionCall (Identity Designator l l Identity Identity
fun) ZipList (Identity (Expression l l Identity Identity))
parameters)) =
forall a ann. Pretty a => a -> Doc ann
pretty Designator l l Identity Identity
fun forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann -> Doc ann
parens (forall ann. [Doc ann] -> Doc ann
hsep forall a b. (a -> b) -> a -> b
$ forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate forall ann. Doc ann
comma forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Identity a -> a
runIdentity forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ZipList a -> [a]
getZipList ZipList (Identity (Expression l l Identity Identity))
parameters)
pretty (Precedence Int
_ (Literal (Identity Value l l Identity Identity
val))) = forall a ann. Pretty a => a -> Doc ann
pretty Value l l Identity Identity
val
pretty (Precedence Int
p (Not Identity (Expression l l Identity Identity)
e)) | Int
p forall a. Ord a => a -> a -> Bool
< Int
5 = Doc ann
"~" forall a. Semigroup a => a -> a -> a
<> forall {e} {ann}.
Pretty (Precedence e) =>
Int -> Identity e -> Doc ann
prettyPrec' Int
5 Identity (Expression l l Identity Identity)
e
pretty (Precedence Int
_ Expression λ l Identity Identity
e) = forall ann. Doc ann -> Doc ann
parens (forall a ann. Pretty a => a -> Doc ann
pretty Expression λ l Identity Identity
e)
prettyPrec' :: Int -> Identity e -> Doc ann
prettyPrec' Int
p (Identity e
e) = forall a ann. Pretty a => a -> Doc ann
pretty (forall e. Int -> e -> Precedence e
Precedence Int
p e
e)
instance Pretty RelOp where
pretty :: forall ann. RelOp -> Doc ann
pretty RelOp
Equal = Doc ann
"="
pretty RelOp
Unequal = Doc ann
"#"
pretty RelOp
Less = Doc ann
"<"
pretty RelOp
LessOrEqual = Doc ann
"<="
pretty RelOp
Greater = Doc ann
">"
pretty RelOp
GreaterOrEqual = Doc ann
">="
pretty RelOp
In = Doc ann
"IN"
instance Pretty (Abstract.Expression l l Identity Identity) => Pretty (Element λ l Identity Identity) where
pretty :: forall ann. Element λ l Identity Identity -> Doc ann
pretty (Element Identity (Expression l l Identity Identity)
e) = forall a ann. Pretty a => a -> Doc ann
pretty Identity (Expression l l Identity Identity)
e
pretty (Range Identity (Expression l l Identity Identity)
from Identity (Expression l l Identity Identity)
to) = forall a ann. Pretty a => a -> Doc ann
pretty Identity (Expression l l Identity Identity)
from forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
".." forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Identity (Expression l l Identity Identity)
to
instance Pretty (Value Language l Identity Identity) where
pretty :: forall ann. Value Language l Identity Identity -> Doc ann
pretty (Boolean Bool
False) = Doc ann
"FALSE"
pretty (Boolean Bool
True) = Doc ann
"TRUE"
pretty (Integer Integer
n) = forall a ann. Pretty a => a -> Doc ann
pretty Integer
n
pretty (Real Double
r) = forall a ann. Pretty a => a -> Doc ann
pretty (forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show Double
r)
pretty (CharCode Int
c) = Doc ann
"0" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty (forall a. (Integral a, Show a) => a -> ShowS
showHex Int
c [Char]
"") forall a. Semigroup a => a -> a -> a
<> Doc ann
"X"
pretty (String Ident
s)
| (Char -> Bool) -> Ident -> Bool
Text.any (forall a. Eq a => a -> a -> Bool
== Char
'"') Ident
s = forall ann. Doc ann -> Doc ann
squotes (forall a ann. Pretty a => a -> Doc ann
pretty Ident
s)
| Bool
otherwise = forall ann. Doc ann -> Doc ann
dquotes (forall a ann. Pretty a => a -> Doc ann
pretty Ident
s)
pretty Value Language l Identity Identity
Nil = Doc ann
"NIL"
pretty (Builtin Ident
name) = forall a ann. Pretty a => a -> Doc ann
pretty Ident
name
instance (Pretty (Abstract.QualIdent l), Pretty (Abstract.Designator l l Identity Identity),
Pretty (Abstract.Expression l l Identity Identity)) => Pretty (Designator λ l Identity Identity) where
pretty :: forall ann. Designator λ l Identity Identity -> Doc ann
pretty (Variable QualIdent l
q) = forall a ann. Pretty a => a -> Doc ann
pretty QualIdent l
q
pretty (Field Identity (Designator l l Identity Identity)
record Ident
name) = forall a ann. Pretty a => a -> Doc ann
pretty Identity (Designator l l Identity Identity)
record forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
dot forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Ident
name
pretty (Index Identity (Designator l l Identity Identity)
array Identity (Expression l l Identity Identity)
index ZipList (Identity (Expression l l Identity Identity))
indexes) = forall a ann. Pretty a => a -> Doc ann
pretty Identity (Designator l l Identity Identity)
array forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann -> Doc ann
brackets (forall ann. [Doc ann] -> Doc ann
hsep forall a b. (a -> b) -> a -> b
$ forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate forall ann. Doc ann
comma
forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Identity (Expression l l Identity Identity)
index forall a. a -> [a] -> [a]
: forall a. ZipList a -> [a]
getZipList ZipList (Identity (Expression l l Identity Identity))
indexes)
pretty (TypeGuard Identity (Designator l l Identity Identity)
scrutinee QualIdent l
typeName) = forall a ann. Pretty a => a -> Doc ann
pretty Identity (Designator l l Identity Identity)
scrutinee forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann -> Doc ann
parens (forall a ann. Pretty a => a -> Doc ann
pretty QualIdent l
typeName)
pretty (Dereference Identity (Designator l l Identity Identity)
pointer) = forall a ann. Pretty a => a -> Doc ann
pretty Identity (Designator l l Identity Identity)
pointer forall a. Semigroup a => a -> a -> a
<> Doc ann
"^"
instance (Pretty (Abstract.FormalParameters l l Identity Identity), Pretty (Abstract.FieldList l l Identity Identity),
Pretty (Abstract.ConstExpression l l Identity Identity), Pretty (Abstract.Type l l Identity Identity),
Pretty (Abstract.BaseType l)) => Pretty (Type λ l Identity Identity) where
pretty :: forall ann. Type λ l Identity Identity -> Doc ann
pretty (TypeReference BaseType l
q) = forall a ann. Pretty a => a -> Doc ann
pretty BaseType l
q
pretty (ArrayType ZipList (Identity (ConstExpression l l Identity Identity))
dimensions Identity (Type l l Identity Identity)
itemType) =
forall ann. [Doc ann] -> Doc ann
hsep (Doc ann
"ARRAY" forall a. a -> [a] -> [a]
: forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate forall ann. Doc ann
comma (forall a ann. Pretty a => a -> Doc ann
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Identity a -> a
runIdentity forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ZipList a -> [a]
getZipList ZipList (Identity (ConstExpression l l Identity Identity))
dimensions)) forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"OF" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Identity (Type l l Identity Identity)
itemType
pretty (RecordType Maybe (BaseType l)
baseType ZipList (Identity (FieldList l l Identity Identity))
fields) = forall ann. [Doc ann] -> Doc ann
vsep [Doc ann
"RECORD" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall ann. Doc ann -> Doc ann
parens forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty) Maybe (BaseType l)
baseType,
forall ann. Int -> Doc ann -> Doc ann
indent Int
3 (forall ann. [Doc ann] -> Doc ann
vsep forall a b. (a -> b) -> a -> b
$ forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate forall ann. Doc ann
semi forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ZipList a -> [a]
getZipList ZipList (Identity (FieldList l l Identity Identity))
fields),
Doc ann
"END"]
pretty (PointerType Identity (Type l l Identity Identity)
pointed) = Doc ann
"POINTER" forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"TO" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Identity (Type l l Identity Identity)
pointed
pretty (ProcedureType Maybe (Identity (FormalParameters l l Identity Identity))
parameters) = Doc ann
"PROCEDURE" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Maybe (Identity (FormalParameters l l Identity Identity))
parameters
instance Pretty (QualIdent l) where
pretty :: forall ann. QualIdent l -> Doc ann
pretty (QualIdent Ident
moduleName Ident
memberName) = forall a ann. Pretty a => a -> Doc ann
pretty Ident
moduleName forall a. Semigroup a => a -> a -> a
<> Doc ann
"." forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Ident
memberName
pretty (NonQualIdent Ident
localName) = forall a ann. Pretty a => a -> Doc ann
pretty Ident
localName
instance (Pretty (Abstract.IdentDef l), Pretty (Abstract.Type l l Identity Identity)) =>
Pretty (FieldList λ l Identity Identity) where
pretty :: forall ann. FieldList λ l Identity Identity -> Doc ann
pretty (FieldList IdentList l
names Identity (Type l l Identity Identity)
t) = forall ann. [Doc ann] -> Doc ann
hsep (forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate forall ann. Doc ann
comma forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. NonEmpty a -> [a]
toList IdentList l
names) forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
colon forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Identity (Type l l Identity Identity)
t
instance (Pretty (Abstract.IdentDef l), Pretty (Abstract.FormalParameters l l Identity Identity),
Pretty (Abstract.Type l l Identity Identity)) =>
Pretty (ProcedureHeading λ l Identity Identity) where
pretty :: forall ann. ProcedureHeading λ l Identity Identity -> Doc ann
pretty (ProcedureHeading Bool
indirect IdentDef l
ident Maybe (Identity (FormalParameters l l Identity Identity))
parameters) =
Doc ann
"PROCEDURE" forall a. Semigroup a => a -> a -> a
<> (if Bool
indirect then Doc ann
"* " else forall ann. Doc ann
space) forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty IdentDef l
ident forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Maybe (Identity (FormalParameters l l Identity Identity))
parameters
pretty (TypeBoundHeading Bool
var Ident
receiverName Ident
receiverType Bool
indirect IdentDef l
ident Maybe (Identity (FormalParameters l l Identity Identity))
parameters) =
Doc ann
"PROCEDURE" forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
space
forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann -> Doc ann
parens ((if Bool
var then Doc ann
"VAR " else forall a. Monoid a => a
mempty) forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Ident
receiverName forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
colon forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Ident
receiverType)
forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
space forall a. Semigroup a => a -> a -> a
<> (if Bool
indirect then Doc ann
"* " else forall ann. Doc ann
space) forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty IdentDef l
ident forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Maybe (Identity (FormalParameters l l Identity Identity))
parameters
instance (Pretty (Abstract.FPSection l l Identity Identity),
Pretty (Abstract.ReturnType l)) => Pretty (FormalParameters λ l Identity Identity) where
pretty :: forall ann. FormalParameters λ l Identity Identity -> Doc ann
pretty (FormalParameters ZipList (Identity (FPSection l l Identity Identity))
sections Maybe (ReturnType l)
result) =
forall ann. Doc ann
lparen forall a. Semigroup a => a -> a -> a
<> forall ann. [Doc ann] -> Doc ann
hsep (forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate forall ann. Doc ann
semi forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ZipList a -> [a]
getZipList ZipList (Identity (FPSection l l Identity Identity))
sections) forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
rparen forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall ann. Doc ann
colon forall ann. Doc ann -> Doc ann -> Doc ann
<+>) (forall a ann. Pretty a => a -> Doc ann
pretty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (ReturnType l)
result)
instance Pretty (Abstract.Type l l Identity Identity) => Pretty (FPSection λ l Identity Identity) where
pretty :: forall ann. FPSection λ l Identity Identity -> Doc ann
pretty (FPSection Bool
var [Ident]
names Identity (Type l l Identity Identity)
t) =
(if Bool
var then (Doc ann
"VAR" forall ann. Doc ann -> Doc ann -> Doc ann
<+>) else forall a. a -> a
id) forall a b. (a -> b) -> a -> b
$ forall ann. [Doc ann] -> Doc ann
hsep (forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate forall ann. Doc ann
comma forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Ident]
names) forall ann. Doc ann -> Doc ann -> Doc ann
<+> (forall ann. Doc ann
colon forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Identity (Type l l Identity Identity)
t)
instance (Pretty (Abstract.Declaration l l Identity Identity), Pretty (Abstract.StatementSequence l l Identity Identity)) =>
Pretty (Block λ l Identity Identity) where
pretty :: forall ann. Block λ l Identity Identity -> Doc ann
pretty (Block ZipList (Identity (Declaration l l Identity Identity))
declarations Maybe (Identity (StatementSequence l l Identity Identity))
body) =
forall ann. [Doc ann] -> Doc ann
vsep ((forall ann. Int -> Doc ann -> Doc ann
indent Int
3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ZipList a -> [a]
getZipList ZipList (Identity (Declaration l l Identity Identity))
declarations)
forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Identity (StatementSequence l l Identity Identity)
statements-> [Doc ann
"BEGIN", forall l ann.
Pretty (StatementSequence l l Identity Identity) =>
Identity (StatementSequence l l Identity Identity) -> Doc ann
prettyBlock Identity (StatementSequence l l Identity Identity)
statements]) Maybe (Identity (StatementSequence l l Identity Identity))
body)
instance Pretty (Abstract.Statement l l Identity Identity) => Pretty (StatementSequence λ l Identity Identity) where
pretty :: forall ann. StatementSequence λ l Identity Identity -> Doc ann
pretty (StatementSequence ZipList (Identity (Statement l l Identity Identity))
statements) = forall a ann. Pretty a => a -> Doc ann
pretty (forall a. Identity a -> a
runIdentity forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ZipList a -> [a]
getZipList ZipList (Identity (Statement l l Identity Identity))
statements)
instance (Pretty (Abstract.ConstExpression l l Identity Identity),
Pretty (Abstract.Designator l l Identity Identity),
Pretty (Abstract.Case l l Identity Identity),
Pretty (Abstract.ConditionalBranch l l Identity Identity),
Pretty (Abstract.WithAlternative l l Identity Identity),
Pretty (Abstract.StatementSequence l l Identity Identity)) => Pretty (Statement λ l Identity Identity) where
prettyList :: forall ann. [Statement λ l Identity Identity] -> Doc ann
prettyList [Statement λ l Identity Identity]
l = forall ann. [Doc ann] -> Doc ann
vsep (forall {a}. [a] -> [a]
dropEmptyTail forall a b. (a -> b) -> a -> b
$ forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate forall ann. Doc ann
semi forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Statement λ l Identity Identity]
l)
where dropEmptyTail :: [a] -> [a]
dropEmptyTail
| Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Statement λ l Identity Identity]
l), Statement λ l Identity Identity
EmptyStatement <- forall a. [a] -> a
last [Statement λ l Identity Identity]
l = forall {a}. [a] -> [a]
init
| Bool
otherwise = forall a. a -> a
id
pretty :: forall ann. Statement λ l Identity Identity -> Doc ann
pretty Statement λ l Identity Identity
EmptyStatement = forall a. Monoid a => a
mempty
pretty (Assignment (Identity Designator l l Identity Identity
destination) Identity (ConstExpression l l Identity Identity)
expression) = forall a ann. Pretty a => a -> Doc ann
pretty Designator l l Identity Identity
destination forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
":=" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Identity (ConstExpression l l Identity Identity)
expression
pretty (ProcedureCall (Identity Designator l l Identity Identity
procedure) Maybe (ZipList (Identity (ConstExpression l l Identity Identity)))
parameters) =
forall a ann. Pretty a => a -> Doc ann
pretty Designator l l Identity Identity
procedure forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall ann. Doc ann -> Doc ann
parens forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. [Doc ann] -> Doc ann
hsep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate forall ann. Doc ann
comma forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a ann. Pretty a => a -> Doc ann
pretty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)) (forall a. ZipList a -> [a]
getZipList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (ZipList (Identity (ConstExpression l l Identity Identity)))
parameters)
pretty (If Identity (ConditionalBranch l l Identity Identity)
ifThen (ZipList [Identity (ConditionalBranch l l Identity Identity)]
elsifs) Maybe (Identity (StatementSequence l l Identity Identity))
fallback) = forall ann. [Doc ann] -> Doc ann
vsep (Doc ann
"IF" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Identity (ConditionalBranch l l Identity Identity)
ifThen
forall a. a -> [a] -> [a]
: (((Doc ann
"ELSIF" forall ann. Doc ann -> Doc ann -> Doc ann
<+>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Identity (ConditionalBranch l l Identity Identity)]
elsifs)
forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Identity (StatementSequence l l Identity Identity)
x-> [Doc ann
"ELSE", forall l ann.
Pretty (StatementSequence l l Identity Identity) =>
Identity (StatementSequence l l Identity Identity) -> Doc ann
prettyBlock Identity (StatementSequence l l Identity Identity)
x]) Maybe (Identity (StatementSequence l l Identity Identity))
fallback
forall a. [a] -> [a] -> [a]
++ [Doc ann
"END"])
pretty (CaseStatement Identity (ConstExpression l l Identity Identity)
scrutinee ZipList (Identity (Case l l Identity Identity))
cases Maybe (Identity (StatementSequence l l Identity Identity))
fallback) = forall ann. [Doc ann] -> Doc ann
vsep [Doc ann
"CASE" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Identity (ConstExpression l l Identity Identity)
scrutinee forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"OF",
forall ann. Doc ann -> Doc ann
align (forall ann. Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
encloseSep forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty Doc ann
"| "
forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ZipList a -> [a]
getZipList ZipList (Identity (Case l l Identity Identity))
cases),
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Doc ann
"ELSE" forall ann. Doc ann -> Doc ann -> Doc ann
<#>) (forall l ann.
Pretty (StatementSequence l l Identity Identity) =>
Identity (StatementSequence l l Identity Identity) -> Doc ann
prettyBlock forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Identity (StatementSequence l l Identity Identity))
fallback),
Doc ann
"END"]
pretty (While Identity (ConstExpression l l Identity Identity)
condition Identity (StatementSequence l l Identity Identity)
body) = forall ann. [Doc ann] -> Doc ann
vsep [Doc ann
"WHILE" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Identity (ConstExpression l l Identity Identity)
condition forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"DO",
forall l ann.
Pretty (StatementSequence l l Identity Identity) =>
Identity (StatementSequence l l Identity Identity) -> Doc ann
prettyBlock Identity (StatementSequence l l Identity Identity)
body,
Doc ann
"END"]
pretty (Repeat Identity (StatementSequence l l Identity Identity)
body Identity (ConstExpression l l Identity Identity)
condition) = forall ann. [Doc ann] -> Doc ann
vsep [Doc ann
"REPEAT",
forall l ann.
Pretty (StatementSequence l l Identity Identity) =>
Identity (StatementSequence l l Identity Identity) -> Doc ann
prettyBlock Identity (StatementSequence l l Identity Identity)
body,
Doc ann
"UNTIL" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Identity (ConstExpression l l Identity Identity)
condition]
pretty (For Ident
index Identity (ConstExpression l l Identity Identity)
from Identity (ConstExpression l l Identity Identity)
to Maybe (Identity (ConstExpression l l Identity Identity))
by Identity (StatementSequence l l Identity Identity)
body) = forall ann. [Doc ann] -> Doc ann
vsep [Doc ann
"FOR" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Ident
index forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
":=" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Identity (ConstExpression l l Identity Identity)
from forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"TO" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Identity (ConstExpression l l Identity Identity)
to
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Doc ann
"BY" forall ann. Doc ann -> Doc ann -> Doc ann
<+>) (forall a ann. Pretty a => a -> Doc ann
pretty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Identity (ConstExpression l l Identity Identity))
by) forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"DO",
forall l ann.
Pretty (StatementSequence l l Identity Identity) =>
Identity (StatementSequence l l Identity Identity) -> Doc ann
prettyBlock Identity (StatementSequence l l Identity Identity)
body,
Doc ann
"END"]
pretty (Loop Identity (StatementSequence l l Identity Identity)
body) = forall ann. [Doc ann] -> Doc ann
vsep [Doc ann
"LOOP",
forall l ann.
Pretty (StatementSequence l l Identity Identity) =>
Identity (StatementSequence l l Identity Identity) -> Doc ann
prettyBlock Identity (StatementSequence l l Identity Identity)
body,
Doc ann
"END"]
pretty (With Identity (WithAlternative l l Identity Identity)
alternative (ZipList [Identity (WithAlternative l l Identity Identity)]
alternatives) Maybe (Identity (StatementSequence l l Identity Identity))
fallback) =
Doc ann
"WITH" forall ann. Doc ann -> Doc ann -> Doc ann
<+>
forall ann. [Doc ann] -> Doc ann
vsep (forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate forall ann. Doc ann
pipe (forall a ann. Pretty a => a -> Doc ann
pretty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Identity (WithAlternative l l Identity Identity)
alternative forall a. a -> [a] -> [a]
: [Identity (WithAlternative l l Identity Identity)]
alternatives) forall a. [a] -> [a] -> [a]
++
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Identity (StatementSequence l l Identity Identity)
x-> [Doc ann
"ELSE", forall l ann.
Pretty (StatementSequence l l Identity Identity) =>
Identity (StatementSequence l l Identity Identity) -> Doc ann
prettyBlock Identity (StatementSequence l l Identity Identity)
x]) Maybe (Identity (StatementSequence l l Identity Identity))
fallback forall a. [a] -> [a] -> [a]
++
[Doc ann
"END"])
pretty Statement λ l Identity Identity
Exit = Doc ann
"EXIT"
pretty (Return Maybe (Identity (ConstExpression l l Identity Identity))
result) = Doc ann
"RETURN" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall a ann. Pretty a => a -> Doc ann
pretty Maybe (Identity (ConstExpression l l Identity Identity))
result
instance (Pretty (Abstract.Expression l l Identity Identity),
Pretty (Abstract.StatementSequence l l Identity Identity)) =>
Pretty (ConditionalBranch λ l Identity Identity) where
pretty :: forall ann. ConditionalBranch λ l Identity Identity -> Doc ann
pretty (ConditionalBranch Identity (Expression l l Identity Identity)
condition Identity (StatementSequence l l Identity Identity)
body) = forall ann. [Doc ann] -> Doc ann
vsep [forall a ann. Pretty a => a -> Doc ann
pretty Identity (Expression l l Identity Identity)
condition forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"THEN",
forall l ann.
Pretty (StatementSequence l l Identity Identity) =>
Identity (StatementSequence l l Identity Identity) -> Doc ann
prettyBlock Identity (StatementSequence l l Identity Identity)
body]
instance (Pretty (Abstract.CaseLabels l l Identity Identity),
Pretty (Abstract.ConstExpression l l Identity Identity),
Pretty (Abstract.StatementSequence l l Identity Identity)) => Pretty (Case λ l Identity Identity) where
pretty :: forall ann. Case λ l Identity Identity -> Doc ann
pretty (Case Identity (CaseLabels l l Identity Identity)
label ZipList (Identity (CaseLabels l l Identity Identity))
labels Identity (StatementSequence l l Identity Identity)
body) = forall ann. [Doc ann] -> Doc ann
vsep [forall ann. [Doc ann] -> Doc ann
hsep (forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate forall ann. Doc ann
comma (forall a ann. Pretty a => a -> Doc ann
pretty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Identity (CaseLabels l l Identity Identity)
label forall a. a -> [a] -> [a]
: forall a. ZipList a -> [a]
getZipList ZipList (Identity (CaseLabels l l Identity Identity))
labels)) forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
colon,
forall l ann.
Pretty (StatementSequence l l Identity Identity) =>
Identity (StatementSequence l l Identity Identity) -> Doc ann
prettyBlock Identity (StatementSequence l l Identity Identity)
body]
instance (Pretty (Abstract.QualIdent l), Pretty (Abstract.StatementSequence l l Identity Identity)) =>
Pretty (WithAlternative λ l Identity Identity) where
pretty :: forall ann. WithAlternative λ l Identity Identity -> Doc ann
pretty (WithAlternative QualIdent l
name QualIdent l
t Identity (StatementSequence l l Identity Identity)
body) = forall ann. [Doc ann] -> Doc ann
vsep [forall a ann. Pretty a => a -> Doc ann
pretty QualIdent l
name forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
colon forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty QualIdent l
t forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"DO",
forall l ann.
Pretty (StatementSequence l l Identity Identity) =>
Identity (StatementSequence l l Identity Identity) -> Doc ann
prettyBlock Identity (StatementSequence l l Identity Identity)
body]
instance Pretty (Abstract.ConstExpression l l Identity Identity) => Pretty (CaseLabels λ l Identity Identity) where
pretty :: forall ann. CaseLabels λ l Identity Identity -> Doc ann
pretty (SingleLabel Identity (ConstExpression l l Identity Identity)
expression) = forall a ann. Pretty a => a -> Doc ann
pretty Identity (ConstExpression l l Identity Identity)
expression
pretty (LabelRange Identity (ConstExpression l l Identity Identity)
from Identity (ConstExpression l l Identity Identity)
to) = forall a ann. Pretty a => a -> Doc ann
pretty Identity (ConstExpression l l Identity Identity)
from forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
".." forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Identity (ConstExpression l l Identity Identity)
to
prettyBlock :: Pretty (Abstract.StatementSequence l l Identity Identity) =>
Identity (Abstract.StatementSequence l l Identity Identity) -> Doc ann
prettyBlock :: forall l ann.
Pretty (StatementSequence l l Identity Identity) =>
Identity (StatementSequence l l Identity Identity) -> Doc ann
prettyBlock (Identity StatementSequence l l Identity Identity
statements) = forall ann. Int -> Doc ann -> Doc ann
indent Int
3 (forall a ann. Pretty a => a -> Doc ann
pretty StatementSequence l l Identity Identity
statements)
Doc ann
a <#> :: Doc ann -> Doc ann -> Doc ann
<#> Doc ann
b = forall ann. [Doc ann] -> Doc ann
vsep [Doc ann
a, Doc ann
b]