{-# LANGUAGE DataKinds, FlexibleContexts, FlexibleInstances, GADTs, OverloadedStrings, ScopedTypeVariables,
             TypeApplications, TypeFamilies, UndecidableInstances #-}

-- | This module exports the instances of the 'Pretty' type class necessary for printing of an ISO Modula-2 abstract
-- syntax tree.

module Language.Modula2.ISO.Pretty () where

import Control.Applicative (ZipList(ZipList, getZipList))
import Data.Coerce (coerce)
import Data.Functor.Identity (Identity(..))
import Data.List (intersperse)
import Data.List.NonEmpty (NonEmpty((:|)), fromList, toList)
import qualified Data.Text as Text
import Data.Text.Prettyprint.Doc
import Data.Text.Prettyprint.Doc.Render.Text (renderStrict)

import qualified Language.Oberon.Abstract
import qualified Language.Oberon.AST
import qualified Language.Modula2.Abstract as Abstract
import qualified Language.Modula2.ISO.Abstract as ISO.Abstract
import Language.Modula2.ISO.AST
import Language.Oberon.Pretty (Precedence(Precedence))
import Language.Modula2.Pretty ()
import qualified Language.Modula2.AST as Report

instance (Abstract.Nameable l, Pretty (Abstract.IdentDef l),
          Pretty (Abstract.Export l), Pretty (Abstract.Import 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 False Language l Identity Identity) where
   pretty :: Declaration 'False Language l Identity Identity -> Doc ann
pretty (ProcedureDefinition Identity (ProcedureHeading l l Identity Identity)
heading) = Identity (ProcedureHeading l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Identity (ProcedureHeading l l Identity Identity)
heading Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
semi
   pretty (ConstantDeclaration IdentDef l
ident (Identity Expression l l Identity Identity
expr)) = Doc ann
"CONST" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> IdentDef l -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty IdentDef l
ident Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"=" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Expression l l Identity Identity -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Expression l l Identity Identity
expr Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
semi
   pretty (TypeDeclaration IdentDef l
ident Identity (Type l l Identity Identity)
typeDef) = Doc ann
"TYPE" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> IdentDef l -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty IdentDef l
ident Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"=" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Identity (Type l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Identity (Type l l Identity Identity)
typeDef Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
semi
   pretty (OpaqueTypeDeclaration IdentDef l
ident) = Doc ann
"TYPE" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> IdentDef l -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty IdentDef l
ident Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
semi
   pretty (VariableDeclaration IdentList l
idents Identity (Type l l Identity Identity)
varType) =
      Doc ann
"VAR" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ([Doc ann] -> [Doc ann]) -> [Doc ann] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ IdentDef l -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (IdentDef l -> Doc ann) -> [IdentDef l] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IdentList l -> [IdentDef l]
forall a. NonEmpty a -> [a]
toList IdentList l
idents) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
colon Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Identity (Type l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Identity (Type l l Identity Identity)
varType Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
semi

instance (Abstract.Nameable l, Pretty (Abstract.IdentDef l),
          Pretty (Abstract.Export l), Pretty (Abstract.Import l),
          Pretty (ISO.Abstract.AddressedIdent l l Identity Identity),
          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 True Language l Identity Identity) where
   pretty :: Declaration 'True Language l Identity Identity -> Doc ann
pretty (AddressedVariableDeclaration Identity (AddressedIdent l l Identity Identity)
var ZipList (Identity (AddressedIdent l l Identity Identity))
vars Identity (Type l l Identity Identity)
varType) =
      Doc ann
"VAR" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ([Doc ann] -> [Doc ann]) -> [Doc ann] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ Identity (AddressedIdent l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Identity (AddressedIdent l l Identity Identity) -> Doc ann)
-> [Identity (AddressedIdent l l Identity Identity)] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Identity (AddressedIdent l l Identity Identity)
var Identity (AddressedIdent l l Identity Identity)
-> [Identity (AddressedIdent l l Identity Identity)]
-> [Identity (AddressedIdent l l Identity Identity)]
forall a. a -> [a] -> [a]
: ZipList (Identity (AddressedIdent l l Identity Identity))
-> [Identity (AddressedIdent l l Identity Identity)]
forall a. ZipList a -> [a]
getZipList ZipList (Identity (AddressedIdent l l Identity Identity))
vars)) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
colon Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Identity (Type l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Identity (Type l l Identity Identity)
varType Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
semi
   pretty (ForwardProcedureDeclaration Identity (ProcedureHeading l l Identity Identity)
heading) = Identity (ProcedureHeading l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Identity (ProcedureHeading l l Identity Identity)
heading Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
semi Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"FORWARD" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
semi
   pretty (ModuleDeclaration Ident
name Maybe (Identity (Expression l l Identity Identity))
priority [Import l]
imports Maybe (Export l)
export Identity (Block l l Identity Identity)
body) =
      [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
intersperse Doc ann
forall a. Monoid a => a
mempty ([Doc ann] -> [Doc ann]) -> [Doc ann] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$
      [Doc ann
"MODULE" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Ident -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Ident
name Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
-> (Identity (Expression l l Identity Identity) -> Doc ann)
-> Maybe (Identity (Expression l l Identity Identity))
-> Doc ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc ann
forall a. Monoid a => a
mempty (Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets (Doc ann -> Doc ann)
-> (Identity (Expression l l Identity Identity) -> Doc ann)
-> Identity (Expression l l Identity Identity)
-> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity (Expression l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty) Maybe (Identity (Expression l l Identity Identity))
priority Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
semi,
       [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep (Import l -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Import l -> Doc ann) -> [Import l] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Import l]
imports),
       (Export l -> Doc ann) -> Maybe (Export l) -> Doc ann
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Export l -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Maybe (Export l)
export,
       Identity (Block l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Identity (Block l l Identity Identity)
body,
       Doc ann
"END" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Ident -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Ident
name Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
semi]
   pretty Declaration 'True Language l Identity Identity
dec = Doc ann
-> (Declaration 'True Language l Identity Identity -> Doc ann)
-> Maybe3 (Declaration 'True Language) l Identity Identity
-> Doc ann
forall k1 k2 k3 b1 (f :: k1 -> k2 -> k3 -> *) (a :: k1) (b2 :: k2)
       (c :: k3).
b1 -> (f a b2 c -> b1) -> Maybe3 f a b2 c -> b1
Abstract.maybe3 Doc ann
forall a. Monoid a => a
mempty Declaration 'True Language l Identity Identity -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Declaration Language l Identity Identity
-> Declaration (WirthySubsetOf Language) l Identity Identity
forall l l' l'' (f' :: * -> *) (f :: * -> *).
(CoWirthy l, TargetClass l l') =>
Declaration l l'' f' f -> Declaration l' l'' f' f
Abstract.coDeclaration @Language @(Abstract.WirthySubsetOf Report.Language) Declaration Language l Identity Identity
Declaration 'True Language l Identity Identity
dec)

instance Pretty (Abstract.ConstExpression l l Identity Identity) => Pretty (AddressedIdent l l Identity Identity) where
   pretty :: AddressedIdent l l Identity Identity -> Doc ann
pretty (AddressedIdent Ident
name Identity (ConstExpression l l Identity Identity)
address) = Ident -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Ident
name Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets (Identity (ConstExpression l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Identity (ConstExpression l l Identity Identity)
address)
   pretty (UnaddressedIdent Ident
name) = Ident -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Ident
name

instance (Pretty (Abstract.IdentDef l), 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 Language l Identity Identity) where
   pretty :: Type Language l Identity Identity -> Doc ann
pretty (ArrayType ZipList (Identity (Type l l Identity Identity))
dimensions Identity (Type l l Identity Identity)
itemType) =
      Doc ann
"ARRAY" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ([Doc ann] -> [Doc ann]) -> [Doc ann] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ Type l l Identity Identity -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Type l l Identity Identity -> Doc ann)
-> (Identity (Type l l Identity Identity)
    -> Type l l Identity Identity)
-> Identity (Type l l Identity Identity)
-> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity (Type l l Identity Identity) -> Type l l Identity Identity
forall a. Identity a -> a
runIdentity (Identity (Type l l Identity Identity) -> Doc ann)
-> [Identity (Type l l Identity Identity)] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZipList (Identity (Type l l Identity Identity))
-> [Identity (Type l l Identity Identity)]
forall a. ZipList a -> [a]
getZipList ZipList (Identity (Type l l Identity Identity))
dimensions) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"OF" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Identity (Type l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Identity (Type l l Identity Identity)
itemType
   pretty (EnumerationType IdentList l
values) = Doc ann
"(" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ([Doc ann] -> [Doc ann]) -> [Doc ann] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ NonEmpty (Doc ann) -> [Doc ann]
forall a. NonEmpty a -> [a]
toList (NonEmpty (Doc ann) -> [Doc ann])
-> NonEmpty (Doc ann) -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ IdentDef l -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (IdentDef l -> Doc ann) -> IdentList l -> NonEmpty (Doc ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IdentList l
values) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
")"
   pretty (SubrangeType Maybe (BaseType l)
enumType Identity (ConstExpression l l Identity Identity)
min Identity (ConstExpression l l Identity Identity)
max) = (BaseType l -> Doc ann) -> Maybe (BaseType l) -> Doc ann
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap BaseType l -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Maybe (BaseType l)
enumType Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"[" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Identity (ConstExpression l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Identity (ConstExpression l l Identity Identity)
min Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
".." Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Identity (ConstExpression l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Identity (ConstExpression l l Identity Identity)
max Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"]"
   pretty (SetType Identity (Type l l Identity Identity)
memberType) = Doc ann
"SET" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"OF" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Identity (Type l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Identity (Type l l Identity Identity)
memberType
   pretty (PackedSetType Identity (Type l l Identity Identity)
memberType) = Doc ann
"PACKED" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"SET" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"OF" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Identity (Type l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Identity (Type l l Identity Identity)
memberType
   pretty (RecordType ZipList (Identity (FieldList l l Identity Identity))
fields) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep [Doc ann
"RECORD",
                                       Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
3 ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
semi ([Doc ann] -> [Doc ann]) -> [Doc ann] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ Identity (FieldList l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Identity (FieldList l l Identity Identity) -> Doc ann)
-> [Identity (FieldList l l Identity Identity)] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZipList (Identity (FieldList l l Identity Identity))
-> [Identity (FieldList l l Identity Identity)]
forall a. ZipList a -> [a]
getZipList ZipList (Identity (FieldList l l Identity Identity))
fields),
                                       Doc ann
"END"]
   pretty (ProcedureType Maybe (Identity (FormalParameters l l Identity Identity))
parameters) = Doc ann
"PROCEDURE" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc Any -> Doc ann
forall ann ann. Doc ann -> Doc ann
adjust (Maybe (Identity (FormalParameters l l Identity Identity))
-> Doc Any
forall a ann. Pretty a => a -> Doc ann
pretty Maybe (Identity (FormalParameters l l Identity Identity))
parameters)
      where adjust :: Doc ann -> Doc ann
adjust = Ident -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Ident -> Doc ann) -> (Doc ann -> Ident) -> Doc ann -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> Ident -> Ident -> Ident
Text.replace Ident
" : " Ident
"" (Ident -> Ident) -> (Doc ann -> Ident) -> Doc ann -> Ident
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> Ident -> Ident -> Ident
Text.replace Ident
";" Ident
"," (Ident -> Ident) -> (Doc ann -> Ident) -> Doc ann -> Ident
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleDocStream ann -> Ident
forall ann. SimpleDocStream ann -> Ident
renderStrict (SimpleDocStream ann -> Ident)
-> (Doc ann -> SimpleDocStream ann) -> Doc ann -> Ident
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc ann -> SimpleDocStream ann
forall ann. Doc ann -> SimpleDocStream ann
layoutCompact
   pretty Type Language l Identity Identity
ty = Doc ann
-> (Type Language l Identity Identity -> Doc ann)
-> Maybe3 (Type Language) l Identity Identity
-> Doc ann
forall k1 k2 k3 b1 (f :: k1 -> k2 -> k3 -> *) (a :: k1) (b2 :: k2)
       (c :: k3).
b1 -> (f a b2 c -> b1) -> Maybe3 f a b2 c -> b1
Abstract.maybe3 Doc ann
forall a. Monoid a => a
mempty Type Language l Identity Identity -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Type Language l Identity Identity
-> Type (WirthySubsetOf Language) l Identity Identity
forall l l' l'' (f' :: * -> *) (f :: * -> *).
(CoWirthy l, TargetClass l l') =>
Type l l'' f' f -> Type l' l'' f' f
Abstract.coType @Language @(Abstract.WirthySubsetOf Report.Language) Type Language l Identity Identity
Type Language l Identity Identity
ty)

instance (Pretty (Abstract.IdentDef l), Pretty (Abstract.QualIdent l), Pretty (Abstract.Type l l Identity Identity),
          Pretty (Abstract.Value l l Identity Identity),
          Pretty (Abstract.FieldList l l Identity Identity), Pretty (Abstract.Variant l l Identity Identity)) =>
         Pretty (Report.FieldList Language l Identity Identity) where
   pretty :: FieldList Language l Identity Identity -> Doc ann
pretty FieldList Language l Identity Identity
fl = FieldList Language l Identity Identity -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (FieldList Language l Identity Identity
-> FieldList Language l Identity Identity
coerce FieldList Language l Identity Identity
fl :: Report.FieldList Report.Language l Identity Identity)

instance (Pretty (Abstract.CaseLabels l l Identity Identity), Pretty (Abstract.FieldList l l Identity Identity)) =>
         Pretty (Variant λ l Identity Identity) where
   pretty :: Variant λ l Identity Identity -> Doc ann
pretty Variant λ l Identity Identity
EmptyVariant = Doc ann
forall a. Monoid a => a
mempty
   pretty (Variant Identity (CaseLabels l l Identity Identity)
label ZipList (Identity (CaseLabels l l Identity Identity))
labels ZipList (Identity (FieldList l l Identity Identity))
fields) = Variant Any l Identity Identity -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Identity (CaseLabels l l Identity Identity)
-> ZipList (Identity (CaseLabels l l Identity Identity))
-> ZipList (Identity (FieldList l l Identity Identity))
-> Variant Any l Identity Identity
forall λ l (f' :: * -> *) (f :: * -> *).
f (CaseLabels l l f' f')
-> ZipList (f (CaseLabels l l f' f'))
-> ZipList (f (FieldList l l f' f'))
-> Variant λ l f' f
Report.Variant Identity (CaseLabels l l Identity Identity)
label ZipList (Identity (CaseLabels l l Identity Identity))
labels ZipList (Identity (FieldList l l Identity Identity))
fields)

instance (Pretty (Abstract.Declaration l l Identity Identity), Pretty (Abstract.StatementSequence l l Identity Identity)) =>
         Pretty (Block λ l Identity Identity) where
   pretty :: Block λ l Identity Identity -> Doc ann
pretty (Block ZipList (Identity (Declaration l l Identity Identity))
declarations Maybe (Identity (StatementSequence l l Identity Identity))
body) =
      [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ((Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
3 (Doc ann -> Doc ann)
-> (Identity (Declaration l l Identity Identity) -> Doc ann)
-> Identity (Declaration l l Identity Identity)
-> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity (Declaration l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Identity (Declaration l l Identity Identity) -> Doc ann)
-> [Identity (Declaration l l Identity Identity)] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZipList (Identity (Declaration l l Identity Identity))
-> [Identity (Declaration l l Identity Identity)]
forall a. ZipList a -> [a]
getZipList ZipList (Identity (Declaration l l Identity Identity))
declarations)
            [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. [a] -> [a] -> [a]
++ (Identity (StatementSequence l l Identity Identity) -> [Doc ann])
-> Maybe (Identity (StatementSequence l l Identity Identity))
-> [Doc ann]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Identity (StatementSequence l l Identity Identity)
statements-> [Doc ann
"BEGIN", Identity (StatementSequence l l Identity Identity) -> Doc ann
forall a ann. Pretty a => Identity a -> Doc ann
prettyBody Identity (StatementSequence l l Identity Identity)
statements]) Maybe (Identity (StatementSequence l l Identity Identity))
body)
   pretty (ExceptionHandlingBlock ZipList (Identity (Declaration l l Identity Identity))
declarations Maybe (Identity (StatementSequence l l Identity Identity))
body Maybe (Identity (StatementSequence l l Identity Identity))
except Maybe (Identity (StatementSequence l l Identity Identity))
finally) =
      [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ((Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
3 (Doc ann -> Doc ann)
-> (Identity (Declaration l l Identity Identity) -> Doc ann)
-> Identity (Declaration l l Identity Identity)
-> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity (Declaration l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Identity (Declaration l l Identity Identity) -> Doc ann)
-> [Identity (Declaration l l Identity Identity)] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZipList (Identity (Declaration l l Identity Identity))
-> [Identity (Declaration l l Identity Identity)]
forall a. ZipList a -> [a]
getZipList ZipList (Identity (Declaration l l Identity Identity))
declarations)
            [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. [a] -> [a] -> [a]
++ (Identity (StatementSequence l l Identity Identity) -> [Doc ann])
-> Maybe (Identity (StatementSequence l l Identity Identity))
-> [Doc ann]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Identity (StatementSequence l l Identity Identity)
statements-> [Doc ann
"BEGIN", Identity (StatementSequence l l Identity Identity) -> Doc ann
forall a ann. Pretty a => Identity a -> Doc ann
prettyBody Identity (StatementSequence l l Identity Identity)
statements]) Maybe (Identity (StatementSequence l l Identity Identity))
body
            [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. [a] -> [a] -> [a]
++ (Identity (StatementSequence l l Identity Identity) -> [Doc ann])
-> Maybe (Identity (StatementSequence l l Identity Identity))
-> [Doc ann]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Identity (StatementSequence l l Identity Identity)
statements-> [Doc ann
"EXCEPT", Identity (StatementSequence l l Identity Identity) -> Doc ann
forall a ann. Pretty a => Identity a -> Doc ann
prettyBody Identity (StatementSequence l l Identity Identity)
statements]) Maybe (Identity (StatementSequence l l Identity Identity))
except
            [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. [a] -> [a] -> [a]
++ (Identity (StatementSequence l l Identity Identity) -> [Doc ann])
-> Maybe (Identity (StatementSequence l l Identity Identity))
-> [Doc ann]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Identity (StatementSequence l l Identity Identity)
statements-> [Doc ann
"FINALLY", Identity (StatementSequence l l Identity Identity) -> Doc ann
forall a ann. Pretty a => Identity a -> Doc ann
prettyBody Identity (StatementSequence l l Identity Identity)
statements]) Maybe (Identity (StatementSequence l l Identity Identity))
finally)

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 (Language.Oberon.Abstract.WithAlternative l l Identity Identity),
          Pretty (Abstract.StatementSequence l l Identity Identity)) =>
         Pretty (Statement Language l Identity Identity) where
   prettyList :: [Statement Language l Identity Identity] -> Doc ann
prettyList [Statement Language l Identity Identity]
l = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ([Doc ann] -> [Doc ann]
dropEmptyTail ([Doc ann] -> [Doc ann]) -> [Doc ann] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
semi ([Doc ann] -> [Doc ann]) -> [Doc ann] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ Statement Language l Identity Identity -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Statement Language l Identity Identity -> Doc ann)
-> [Statement Language l Identity Identity] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Statement Language l Identity Identity]
l)
      where dropEmptyTail :: [Doc ann] -> [Doc ann]
dropEmptyTail
               | Bool -> Bool
not ([Statement Language l Identity Identity] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Statement Language l Identity Identity]
l), Statement Language l Identity Identity
EmptyStatement <- [Statement Language l Identity Identity]
-> Statement Language l Identity Identity
forall a. [a] -> a
last [Statement Language l Identity Identity]
l = [Doc ann] -> [Doc ann]
forall a. [a] -> [a]
init
               | Bool
otherwise = [Doc ann] -> [Doc ann]
forall a. a -> a
id
   pretty :: Statement Language l Identity Identity -> Doc ann
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) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep [Doc ann
"FOR" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Ident -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Ident
index Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
":=" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Identity (ConstExpression l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Identity (ConstExpression l l Identity Identity)
from Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"TO" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Identity (ConstExpression l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Identity (ConstExpression l l Identity Identity)
to
                                              Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> (Doc ann -> Doc ann) -> Maybe (Doc ann) -> Doc ann
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Doc ann
"BY" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+>) (Identity (ConstExpression l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Identity (ConstExpression l l Identity Identity) -> Doc ann)
-> Maybe (Identity (ConstExpression l l Identity Identity))
-> Maybe (Doc ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Identity (ConstExpression l l Identity Identity))
by) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"DO",
                                              Identity (StatementSequence l l Identity Identity) -> Doc ann
forall a ann. Pretty a => Identity a -> Doc ann
prettyBody Identity (StatementSequence l l Identity Identity)
body,
                                              Doc ann
"END"]
   pretty (With Identity (Designator l l Identity Identity)
designator Identity (StatementSequence l l Identity Identity)
body) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep [Doc ann
"WITH" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Identity (Designator l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Identity (Designator l l Identity Identity)
designator Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"DO",
                                         Identity (StatementSequence l l Identity Identity) -> Doc ann
forall a ann. Pretty a => Identity a -> Doc ann
prettyBody Identity (StatementSequence l l Identity Identity)
body,
                                         Doc ann
"END"]
   pretty Statement Language l Identity Identity
RetryStatement = Doc ann
"RETRY"
   pretty Statement Language l Identity Identity
stat = Doc ann
-> (Statement Language l Identity Identity -> Doc ann)
-> Maybe3 (Statement Language) l Identity Identity
-> Doc ann
forall k1 k2 k3 b1 (f :: k1 -> k2 -> k3 -> *) (a :: k1) (b2 :: k2)
       (c :: k3).
b1 -> (f a b2 c -> b1) -> Maybe3 f a b2 c -> b1
Abstract.maybe3 Doc ann
forall a. Monoid a => a
mempty Statement Language l Identity Identity -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Statement Language l Identity Identity
-> Statement (WirthySubsetOf Language) l Identity Identity
forall l l' l'' (f' :: * -> *) (f :: * -> *).
(CoWirthy l, TargetClass l l') =>
Statement l l'' f' f -> Statement l' l'' f' f
Abstract.coStatement @Language @(Abstract.WirthySubsetOf Report.Language) Statement Language l Identity Identity
Statement Language l Identity Identity
stat)

instance (Pretty (Precedence (Abstract.Expression l l Identity Identity)),
          Pretty (Abstract.Expression l l Identity Identity),
          Pretty (Abstract.Value l l Identity Identity),
          Pretty (Abstract.Element l l Identity Identity),
          Pretty (ISO.Abstract.Item l l Identity Identity),
          Pretty (Abstract.Designator l l Identity Identity),
          Pretty (Abstract.QualIdent l)) => Pretty (Expression Language l Identity Identity) where
   pretty :: Expression Language l Identity Identity -> Doc ann
pretty Expression Language l Identity Identity
e = Precedence (Expression Language l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Int
-> Expression Language l Identity Identity
-> Precedence (Expression Language l Identity Identity)
forall e. Int -> e -> Precedence e
Precedence Int
0 Expression Language l Identity Identity
e)

instance Pretty (Abstract.Value l l Identity Identity) => Pretty (Report.Value Language l Identity Identity) where
   pretty :: Value Language l Identity Identity -> Doc ann
pretty Value Language l Identity Identity
v = Doc ann
-> (Value Language l Identity Identity -> Doc ann)
-> Maybe3 (Value Language) l Identity Identity
-> Doc ann
forall k1 k2 k3 b1 (f :: k1 -> k2 -> k3 -> *) (a :: k1) (b2 :: k2)
       (c :: k3).
b1 -> (f a b2 c -> b1) -> Maybe3 f a b2 c -> b1
Abstract.maybe3 Doc ann
forall a. Monoid a => a
mempty Value Language l Identity Identity -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Value Language l Identity Identity
-> Value (WirthySubsetOf Language) l Identity Identity
forall l l' l'' (f' :: * -> *) (f :: * -> *).
(CoWirthy l, TargetClass l l') =>
Value l l'' f' f -> Value l' l'' f' f
Abstract.coValue @Language @(Abstract.WirthySubsetOf Report.Language) Value Language l Identity Identity
Value Language l Identity Identity
v)

instance (Pretty (Abstract.Expression l l Identity Identity)) => Pretty (Item Language l Identity Identity) where
   pretty :: Item Language l Identity Identity -> Doc ann
pretty (Single Identity (Expression l l Identity Identity)
e) = Identity (Expression l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Identity (Expression l l Identity Identity)
e
   pretty (Repeated Identity (Expression l l Identity Identity)
e Identity (Expression l l Identity Identity)
count) = Identity (Expression l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Identity (Expression l l Identity Identity)
e Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"BY" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Identity (Expression l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Identity (Expression l l Identity Identity)
count

instance (Pretty (Precedence (Abstract.Expression l l Identity Identity)),
          Pretty (Abstract.Expression l l Identity Identity),
          Pretty (Abstract.Value l l Identity Identity),
          Pretty (Abstract.Element l l Identity Identity),
          Pretty (ISO.Abstract.Item l l Identity Identity),
          Pretty (Abstract.Designator l l Identity Identity),
          Pretty (Abstract.QualIdent l)) =>
         Pretty (Precedence (Expression Language l Identity Identity)) where
   pretty :: Precedence (Expression Language l Identity Identity) -> Doc ann
pretty (Precedence Int
p e :: Expression Language l Identity Identity
e@(Remainder Identity (Expression l l Identity Identity)
left Identity (Expression l l Identity Identity)
right))
      | Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4 = Precedence (Expression l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Int
-> Expression l l Identity Identity
-> Precedence (Expression l l Identity Identity)
forall e. Int -> e -> Precedence e
Precedence Int
4 (Expression l l Identity Identity
 -> Precedence (Expression l l Identity Identity))
-> Expression l l Identity Identity
-> Precedence (Expression l l Identity Identity)
forall a b. (a -> b) -> a -> b
$ Identity (Expression l l Identity Identity)
-> Expression l l Identity Identity
forall a. Identity a -> a
runIdentity Identity (Expression l l Identity Identity)
left) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"REM" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Precedence (Expression l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Int
-> Expression l l Identity Identity
-> Precedence (Expression l l Identity Identity)
forall e. Int -> e -> Precedence e
Precedence Int
4 (Expression l l Identity Identity
 -> Precedence (Expression l l Identity Identity))
-> Expression l l Identity Identity
-> Precedence (Expression l l Identity Identity)
forall a b. (a -> b) -> a -> b
$ Identity (Expression l l Identity Identity)
-> Expression l l Identity Identity
forall a. Identity a -> a
runIdentity Identity (Expression l l Identity Identity)
right)
      | Bool
otherwise = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Expression Language l Identity Identity -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Expression Language l Identity Identity
e)
   pretty (Precedence Int
_ (Array Maybe (QualIdent l)
itemType [Identity (Item l l Identity Identity)]
items)) =
      (QualIdent l -> Doc ann) -> Maybe (QualIdent l) -> Doc ann
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap QualIdent l -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Maybe (QualIdent l)
itemType Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
braces ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ([Doc ann] -> [Doc ann]) -> [Doc ann] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ Identity (Item l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Identity (Item l l Identity Identity) -> Doc ann)
-> [Identity (Item l l Identity Identity)] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Identity (Item l l Identity Identity)]
items)
   pretty (Precedence Int
_ (Record Maybe (QualIdent l)
recordType [Identity (Expression l l Identity Identity)]
fields)) =
      (QualIdent l -> Doc ann) -> Maybe (QualIdent l) -> Doc ann
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap QualIdent l -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Maybe (QualIdent l)
recordType Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
braces ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ([Doc ann] -> [Doc ann]) -> [Doc ann] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ Identity (Expression l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Identity (Expression l l Identity Identity) -> Doc ann)
-> [Identity (Expression l l Identity Identity)] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Identity (Expression l l Identity Identity)]
fields)
   pretty (Precedence Int
_ (Set Maybe (QualIdent l)
setType ZipList (Identity (Element l l Identity Identity))
elements)) =
      (QualIdent l -> Doc ann) -> Maybe (QualIdent l) -> Doc ann
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap QualIdent l -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Maybe (QualIdent l)
setType Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
braces ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ([Doc ann] -> [Doc ann]) -> [Doc ann] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ Identity (Element l l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Identity (Element l l Identity Identity) -> Doc ann)
-> [Identity (Element l l Identity Identity)] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZipList (Identity (Element l l Identity Identity))
-> [Identity (Element l l Identity Identity)]
forall a. ZipList a -> [a]
getZipList ZipList (Identity (Element l l Identity Identity))
elements)
   pretty (Precedence Int
p Expression Language l Identity Identity
e) =
      Doc ann
-> (Expression Language l Identity Identity -> Doc ann)
-> Maybe3 (Expression Language) l Identity Identity
-> Doc ann
forall k1 k2 k3 b1 (f :: k1 -> k2 -> k3 -> *) (a :: k1) (b2 :: k2)
       (c :: k3).
b1 -> (f a b2 c -> b1) -> Maybe3 f a b2 c -> b1
Abstract.maybe3 Doc ann
forall a. Monoid a => a
mempty (Precedence (Expression Language l Identity Identity) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Precedence (Expression Language l Identity Identity) -> Doc ann)
-> (Expression Language l Identity Identity
    -> Precedence (Expression Language l Identity Identity))
-> Expression Language l Identity Identity
-> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> Expression Language l Identity Identity
-> Precedence (Expression Language l Identity Identity)
forall e. Int -> e -> Precedence e
Precedence Int
p) (Expression Language l Identity Identity
-> Expression (WirthySubsetOf Language) l Identity Identity
forall l l' l'' (f' :: * -> *) (f :: * -> *).
(CoWirthy l, TargetClass l l') =>
Expression l l'' f' f -> Expression l' l'' f' f
Abstract.coExpression @Language @(Abstract.WirthySubsetOf Report.Language) Expression Language l Identity Identity
Expression Language l Identity Identity
e)

instance (Pretty (Abstract.QualIdent l), Pretty (Abstract.Designator l l Identity Identity),
          Pretty (Abstract.Expression l l Identity Identity)) =>
         Pretty (Report.Designator Language l Identity Identity) where
   pretty :: Designator Language l Identity Identity -> Doc ann
pretty Designator Language l Identity Identity
d = Doc ann
-> (Designator Language l Identity Identity -> Doc ann)
-> Maybe3 (Designator Language) l Identity Identity
-> Doc ann
forall k1 k2 k3 b1 (f :: k1 -> k2 -> k3 -> *) (a :: k1) (b2 :: k2)
       (c :: k3).
b1 -> (f a b2 c -> b1) -> Maybe3 f a b2 c -> b1
Abstract.maybe3 Doc ann
forall a. Monoid a => a
mempty Designator Language l Identity Identity -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Designator Language l Identity Identity
-> Designator (WirthySubsetOf Language) l Identity Identity
forall l l' l'' (f' :: * -> *) (f :: * -> *).
(CoWirthy l, TargetClass l l') =>
Designator l l'' f' f -> Designator l' l'' f' f
Abstract.coDesignator @Language @(Abstract.WirthySubsetOf Report.Language) Designator Language l Identity Identity
Designator Language l Identity Identity
d)

-- not used at run-time
instance Language.Oberon.Abstract.Oberon Language where
   type WithAlternative Language = Language.Oberon.AST.WithAlternative Language

prettyBody :: Identity a -> Doc ann
prettyBody (Identity a
statements) = Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
3 (a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
statements)