{-# OPTIONS_GHC -Wunused-imports #-}
{-# OPTIONS_GHC -Wunused-matches #-}
{-# OPTIONS_GHC -Wunused-binds #-}

{-# OPTIONS_GHC -Wno-orphans #-}

{-| Pretty printer for the concrete syntax.
-}
module Agda.Syntax.Concrete.Pretty
  ( module Agda.Syntax.Concrete.Pretty
  , module Agda.Syntax.Concrete.Glyph
  ) where

import Prelude hiding ( null )

import Data.Maybe
import qualified Data.Foldable  as Fold
import qualified Data.Strict.Maybe as Strict

import Agda.Syntax.Common
import Agda.Syntax.Concrete
import Agda.Syntax.Concrete.Glyph

import Agda.Utils.Function
import Agda.Utils.Functor
import Agda.Utils.List1 ( List1, (<|) )
import qualified Agda.Utils.List1 as List1
import qualified Agda.Utils.List2 as List2
import Agda.Utils.Maybe
import Agda.Utils.Null
import qualified Agda.Syntax.Common.Aspect as Asp
import Agda.Syntax.Common.Pretty
import Agda.Interaction.Options ( HasOptions(pragmaOptions), optPolarity )

import Agda.Utils.Impossible

deriving instance Show Expr
deriving instance (Show a) => Show (OpApp a)
deriving instance Show Declaration
deriving instance Show Pattern
deriving instance Show a => Show (Binder' a)
deriving instance Show TypedBinding
deriving instance Show LamBinding
deriving instance Show BoundName
deriving instance Show ModuleAssignment
deriving instance Show Pragma
deriving instance Show RHS
deriving instance Show LHS
deriving instance Show LHSCore
deriving instance Show LamClause
deriving instance Show WhereClause
deriving instance Show ModuleApplication
deriving instance Show DoStmt
deriving instance Show Module

-- Lays out a list of documents [d₁, d₂, …] in the following way:
-- @
--   { d₁
--   ; d₂
--   ⋮
--   }
-- @
-- If the list is empty, then the notation @{}@ is used.

bracesAndSemicolons :: Foldable t => t Doc -> Doc
bracesAndSemicolons :: forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
bracesAndSemicolons t (Doc Aspects)
ts = case t (Doc Aspects) -> [Doc Aspects]
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Fold.toList t (Doc Aspects)
ts of
  []       -> Doc Aspects
"{}"
  (Doc Aspects
d : [Doc Aspects]
ds) -> [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep ([Doc Aspects
"{" Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Doc Aspects
d] [Doc Aspects] -> [Doc Aspects] -> [Doc Aspects]
forall a. [a] -> [a] -> [a]
++ (Doc Aspects -> Doc Aspects) -> [Doc Aspects] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map (Doc Aspects
";" Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+>) [Doc Aspects]
ds [Doc Aspects] -> [Doc Aspects] -> [Doc Aspects]
forall a. [a] -> [a] -> [a]
++ [Doc Aspects
"}"])

prettyTactic :: BoundName -> Doc -> Doc
prettyTactic :: BoundName -> Doc Aspects -> Doc Aspects
prettyTactic = TacticAttribute' Expr -> Doc Aspects -> Doc Aspects
prettyTactic' (TacticAttribute' Expr -> Doc Aspects -> Doc Aspects)
-> (BoundName -> TacticAttribute' Expr)
-> BoundName
-> Doc Aspects
-> Doc Aspects
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoundName -> TacticAttribute' Expr
bnameTactic

prettyFiniteness :: BoundName -> Doc -> Doc
prettyFiniteness :: BoundName -> Doc Aspects -> Doc Aspects
prettyFiniteness BoundName
name
  | BoundName -> Bool
bnameIsFinite BoundName
name = (Doc Aspects
"@finite" Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+>)
  | Bool
otherwise = Doc Aspects -> Doc Aspects
forall a. a -> a
id

prettyTactic' :: TacticAttribute -> Doc -> Doc
prettyTactic' :: TacticAttribute' Expr -> Doc Aspects -> Doc Aspects
prettyTactic' TacticAttribute' Expr
t = (TacticAttribute' Expr -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty TacticAttribute' Expr
t Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+>)

qualifier :: Pretty a => Maybe a -> Doc -> Doc
qualifier :: forall a. Pretty a => Maybe a -> Doc Aspects -> Doc Aspects
qualifier (Just a
x) Doc Aspects
k = a -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty a
x Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Semigroup a => a -> a -> a
<> Doc Aspects
dot Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Semigroup a => a -> a -> a
<> Doc Aspects
k
qualifier Maybe a
Nothing  Doc Aspects
k = Doc Aspects
k

instance Pretty a => Pretty (TacticAttribute' a) where
  pretty :: TacticAttribute' a -> Doc Aspects
pretty (TacticAttribute Maybe (Ranged a)
t) =
    Doc Aspects
-> Doc Aspects -> (Doc Aspects -> Doc Aspects) -> Doc Aspects
forall a b. Null a => a -> b -> (a -> b) -> b
ifNull (Maybe (Ranged a) -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Maybe (Ranged a)
t) Doc Aspects
forall a. Null a => a
empty \ Doc Aspects
d -> Doc Aspects
"@" Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Semigroup a => a -> a -> a
<> Doc Aspects -> Doc Aspects
parens (Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"tactic" Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Doc Aspects
d)

instance Pretty (ThingWithFixity Name) where
    pretty :: ThingWithFixity Name -> Doc Aspects
pretty (ThingWithFixity Name
n Fixity'
_) = Name -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Name
n

-- | Show the attributes necessary to recover a modality, in long-form
-- (e.g. using at-syntax rather than dots). For the default modality,
-- the result is at-ω (rather than the empty document). Suitable for
-- showing modalities outside of binders.
attributesForModality :: HasOptions m => Modality -> m Doc
attributesForModality :: forall (m :: * -> *). HasOptions m => Modality -> m (Doc Aspects)
attributesForModality mod :: Modality
mod@(Modality Relevance
r Quantity
q Cohesion
c PolarityModality
p)
  | Modality
mod Modality -> [Modality] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Modality
defaultCheckModality, Modality
defaultModality] = do
      showPolarity <- PragmaOptions -> Bool
optPolarity (PragmaOptions -> Bool) -> m PragmaOptions -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m PragmaOptions
forall (m :: * -> *). HasOptions m => m PragmaOptions
pragmaOptions
      pure $ text "@ω" <+> if showPolarity then polarity else empty
  | Bool
otherwise = Doc Aspects -> m (Doc Aspects)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Aspects -> m (Doc Aspects)) -> Doc Aspects -> m (Doc Aspects)
forall a b. (a -> b) -> a -> b
$ [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
fsep ([Doc Aspects] -> Doc Aspects) -> [Doc Aspects] -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ [Maybe (Doc Aspects)] -> [Doc Aspects]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (Doc Aspects)
relevance, Maybe (Doc Aspects)
quantity, Maybe (Doc Aspects)
cohesion, Doc Aspects -> Maybe (Doc Aspects)
forall a. a -> Maybe a
Just Doc Aspects
polarity]
  where
    relevance :: Maybe (Doc Aspects)
relevance = case Relevance
r of
      Relevant        {} -> Maybe (Doc Aspects)
forall a. Maybe a
Nothing
      Irrelevant      {} -> Doc Aspects -> Maybe (Doc Aspects)
forall a. a -> Maybe a
Just Doc Aspects
"@irrelevant"
      ShapeIrrelevant {} -> Doc Aspects -> Maybe (Doc Aspects)
forall a. a -> Maybe a
Just Doc Aspects
"@shape-irrelevant"
    quantity :: Maybe (Doc Aspects)
quantity = case Quantity
q of
      Quantity0{} -> Doc Aspects -> Maybe (Doc Aspects)
forall a. a -> Maybe a
Just Doc Aspects
"@0"
      Quantity1{} -> Doc Aspects -> Maybe (Doc Aspects)
forall a. a -> Maybe a
Just Doc Aspects
"@1"
      Quantityω{} -> Maybe (Doc Aspects)
forall a. Maybe a
Nothing
    cohesion :: Maybe (Doc Aspects)
cohesion = case Cohesion
c of
      Flat{}       -> Doc Aspects -> Maybe (Doc Aspects)
forall a. a -> Maybe a
Just Doc Aspects
"@♭"
      Continuous{} -> Maybe (Doc Aspects)
forall a. Maybe a
Nothing
      Sharp{}      -> Doc Aspects -> Maybe (Doc Aspects)
forall a. a -> Maybe a
Just Doc Aspects
"@♯"
      Squash{}     -> Doc Aspects -> Maybe (Doc Aspects)
forall a. a -> Maybe a
Just Doc Aspects
"@⊤"
    polarity :: Doc Aspects
polarity = case PolarityModality -> ModalPolarity
modPolarityAnn PolarityModality
p of
      ModalPolarity
MixedPolarity    -> Doc Aspects
"@mixed"
      ModalPolarity
Positive         -> Doc Aspects
"@+"
      ModalPolarity
Negative         -> Doc Aspects
"@-"
      ModalPolarity
StrictlyPositive -> Doc Aspects
"@++"
      ModalPolarity
UnusedPolarity   -> Doc Aspects
"@unused"

instance Pretty (OpApp Expr) where
  pretty :: OpApp Expr -> Doc Aspects
pretty (Ordinary Expr
e) = Expr -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Expr
e
  pretty (SyntaxBindingLambda Range' SrcFile
r NonEmpty LamBinding
bs Expr
e) = Expr -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty (Range' SrcFile -> NonEmpty LamBinding -> Expr -> Expr
Lam Range' SrcFile
r NonEmpty LamBinding
bs Expr
e)

instance Pretty a => Pretty (MaybePlaceholder a) where
  pretty :: MaybePlaceholder a -> Doc Aspects
pretty Placeholder{}       = Doc Aspects
"_"
  pretty (NoPlaceholder Maybe PositionInName
_ a
e) = a -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty a
e

instance Pretty Expr where
    pretty :: Expr -> Doc Aspects
pretty = \case
            Ident QName
x          -> QName -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty QName
x
            KnownIdent Aspects
nk QName
x  -> Aspects -> Doc Aspects -> Doc Aspects
annotate Aspects
nk (QName -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty QName
x)
            Lit Range' SrcFile
_ Literal
l          -> Literal -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Literal
l
            QuestionMark Range' SrcFile
_ Maybe Int
n -> Doc Aspects -> Doc Aspects
hlSymbol Doc Aspects
"?" Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Semigroup a => a -> a -> a
<> Doc Aspects -> (Int -> Doc Aspects) -> Maybe Int -> Doc Aspects
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc Aspects
forall a. Null a => a
empty ([Char] -> Doc Aspects
forall a. [Char] -> Doc a
text ([Char] -> Doc Aspects) -> (Int -> [Char]) -> Int -> Doc Aspects
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char]
forall a. Show a => a -> [Char]
show) Maybe Int
n
            Underscore Range' SrcFile
_ Maybe [Char]
n   -> Doc Aspects
-> ([Char] -> Doc Aspects) -> Maybe [Char] -> Doc Aspects
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc Aspects
forall a. Underscore a => a
underscore [Char] -> Doc Aspects
forall a. [Char] -> Doc a
text Maybe [Char]
n
            e :: Expr
e@(App Range' SrcFile
_ Expr
_ Arg (Named_ Expr)
_)    ->
                case Expr -> AppView
appView Expr
e of
                    AppView Expr
e1 [Arg (Named_ Expr)]
args     ->
                        [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
fsep ([Doc Aspects] -> Doc Aspects) -> [Doc Aspects] -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ Expr -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Expr
e1 Doc Aspects -> [Doc Aspects] -> [Doc Aspects]
forall a. a -> [a] -> [a]
: (Arg (Named_ Expr) -> Doc Aspects)
-> [Arg (Named_ Expr)] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map Arg (Named_ Expr) -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [Arg (Named_ Expr)]
args
--                      sep [ pretty e1
--                          , nest 2 $ fsep $ map pretty args
--                          ]
            RawApp Range' SrcFile
_ List2 Expr
es    -> [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
fsep ([Doc Aspects] -> Doc Aspects) -> [Doc Aspects] -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ (Expr -> Doc Aspects) -> [Expr] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty ([Expr] -> [Doc Aspects]) -> [Expr] -> [Doc Aspects]
forall a b. (a -> b) -> a -> b
$ List2 Expr -> [Item (List2 Expr)]
forall l. IsList l => l -> [Item l]
List2.toList List2 Expr
es
            OpApp Range' SrcFile
_ QName
q NESet Name
_ NonEmpty (NamedArg (MaybePlaceholder (OpApp Expr)))
es         -> [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
fsep ([Doc Aspects] -> Doc Aspects) -> [Doc Aspects] -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ Aspects
-> QName
-> NonEmpty (NamedArg (MaybePlaceholder (OpApp Expr)))
-> [Doc Aspects]
forall a.
Pretty a =>
Aspects
-> QName -> List1 (NamedArg (MaybePlaceholder a)) -> [Doc Aspects]
prettyOpApp Aspects
forall a. Null a => a
empty QName
q NonEmpty (NamedArg (MaybePlaceholder (OpApp Expr)))
es
            KnownOpApp Aspects
nk Range' SrcFile
_ QName
q NESet Name
_ NonEmpty (NamedArg (MaybePlaceholder (OpApp Expr)))
es -> [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
fsep ([Doc Aspects] -> Doc Aspects) -> [Doc Aspects] -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ Aspects
-> QName
-> NonEmpty (NamedArg (MaybePlaceholder (OpApp Expr)))
-> [Doc Aspects]
forall a.
Pretty a =>
Aspects
-> QName -> List1 (NamedArg (MaybePlaceholder a)) -> [Doc Aspects]
prettyOpApp Aspects
nk QName
q NonEmpty (NamedArg (MaybePlaceholder (OpApp Expr)))
es

            WithApp Range' SrcFile
_ Expr
e NonEmpty Expr
es -> NonEmpty (Doc Aspects) -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
fsep (NonEmpty (Doc Aspects) -> Doc Aspects)
-> NonEmpty (Doc Aspects) -> Doc Aspects
forall a b. (a -> b) -> a -> b
$
              Expr -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Expr
e Doc Aspects -> NonEmpty (Doc Aspects) -> NonEmpty (Doc Aspects)
forall a. a -> NonEmpty a -> NonEmpty a
<| (Expr -> Doc Aspects) -> NonEmpty Expr -> NonEmpty (Doc Aspects)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Doc Aspects -> Doc Aspects
hlSymbol Doc Aspects
"|" Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+>) (Doc Aspects -> Doc Aspects)
-> (Expr -> Doc Aspects) -> Expr -> Doc Aspects
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty) NonEmpty Expr
es

            HiddenArg Range' SrcFile
_ Named_ Expr
e -> Doc Aspects -> Doc Aspects
braces' (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ Named_ Expr -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Named_ Expr
e
            InstanceArg Range' SrcFile
_ Named_ Expr
e -> Doc Aspects -> Doc Aspects
dbraces (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ Named_ Expr -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Named_ Expr
e
            Lam Range' SrcFile
_ NonEmpty LamBinding
bs (AbsurdLam Range' SrcFile
_ Hiding
h) -> Doc Aspects
lambda Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> NonEmpty (Doc Aspects) -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
fsep ((LamBinding -> Doc Aspects)
-> NonEmpty LamBinding -> NonEmpty (Doc Aspects)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LamBinding -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty NonEmpty LamBinding
bs) Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Hiding -> Doc Aspects
absurd Hiding
h
            Lam Range' SrcFile
_ NonEmpty LamBinding
bs Expr
e ->
                [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep [ Doc Aspects
lambda Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> NonEmpty (Doc Aspects) -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
fsep ((LamBinding -> Doc Aspects)
-> NonEmpty LamBinding -> NonEmpty (Doc Aspects)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LamBinding -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty NonEmpty LamBinding
bs) Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Doc Aspects
arrow
                    , Int -> Doc Aspects -> Doc Aspects
forall a. Int -> Doc a -> Doc a
nest Int
2 (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ Expr -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Expr
e
                    ]
            AbsurdLam Range' SrcFile
_ Hiding
h -> Doc Aspects
lambda Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Hiding -> Doc Aspects
absurd Hiding
h
            ExtendedLam Range' SrcFile
_ Erased
e NonEmpty LamClause
pes ->
              Doc Aspects
lambda Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+>
              Erased -> Doc Aspects -> Doc Aspects
prettyErased Erased
e (NonEmpty (Doc Aspects) -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
bracesAndSemicolons ((LamClause -> Doc Aspects)
-> NonEmpty LamClause -> NonEmpty (Doc Aspects)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LamClause -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty NonEmpty LamClause
pes))
            Fun Range' SrcFile
_ Arg Expr
e1 Expr
e2 ->
                [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep [ Modality -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty (Arg Expr -> Modality
forall a. LensModality a => a -> Modality
getModality Arg Expr
e1) Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Arg Expr -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Arg Expr
e1 Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Doc Aspects
arrow
                    , Expr -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Expr
e2
                    ]
            Pi NonEmpty TypedBinding
tel Expr
e ->
                [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep [ Tel -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty ([TypedBinding] -> Tel
Tel ([TypedBinding] -> Tel) -> [TypedBinding] -> Tel
forall a b. (a -> b) -> a -> b
$ [TypedBinding] -> [TypedBinding]
smashTel ([TypedBinding] -> [TypedBinding])
-> [TypedBinding] -> [TypedBinding]
forall a b. (a -> b) -> a -> b
$ NonEmpty TypedBinding -> [Item (NonEmpty TypedBinding)]
forall l. IsList l => l -> [Item l]
List1.toList NonEmpty TypedBinding
tel) Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Doc Aspects
arrow
                    , Expr -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Expr
e
                    ]
            Let Range' SrcFile
_ NonEmpty Declaration
ds Maybe Expr
me  ->
                [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep [ Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"let" Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> NonEmpty (Doc Aspects) -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
vcat ((Declaration -> Doc Aspects)
-> NonEmpty Declaration -> NonEmpty (Doc Aspects)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Declaration -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty NonEmpty Declaration
ds)
                    , Doc Aspects -> (Expr -> Doc Aspects) -> Maybe Expr -> Doc Aspects
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc Aspects
forall a. Null a => a
empty (\ Expr
e -> Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"in" Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Expr -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Expr
e) Maybe Expr
me
                    ]
            Paren Range' SrcFile
_ Expr
e -> Doc Aspects -> Doc Aspects
parens (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ Expr -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Expr
e
            IdiomBrackets Range' SrcFile
_ Maybe QName
q [Expr]
es -> Maybe QName -> Doc Aspects -> Doc Aspects
forall a. Pretty a => Maybe a -> Doc Aspects -> Doc Aspects
qualifier Maybe QName
q case [Expr]
es of
                []   -> Doc Aspects
emptyIdiomBrkt
                [Expr
e]  -> Doc Aspects
leftIdiomBrkt Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Expr -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Expr
e Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Doc Aspects
rightIdiomBrkt
                Expr
e:[Expr]
es -> Doc Aspects
leftIdiomBrkt Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Expr -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Expr
e Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
fsep ((Expr -> Doc Aspects) -> [Expr] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map ((Doc Aspects
"|" Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+>) (Doc Aspects -> Doc Aspects)
-> (Expr -> Doc Aspects) -> Expr -> Doc Aspects
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty) [Expr]
es) Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Doc Aspects
rightIdiomBrkt
            DoBlock KwRange
_ Maybe QName
q NonEmpty DoStmt
ss -> Maybe QName -> Doc Aspects -> Doc Aspects
forall a. Pretty a => Maybe a -> Doc Aspects -> Doc Aspects
qualifier Maybe QName
q (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"do" Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> NonEmpty (Doc Aspects) -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
vcat ((DoStmt -> Doc Aspects)
-> NonEmpty DoStmt -> NonEmpty (Doc Aspects)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DoStmt -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty NonEmpty DoStmt
ss)
            As Range' SrcFile
_ Name
x Expr
e  -> Name -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Name
x Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Semigroup a => a -> a -> a
<> Doc Aspects -> Doc Aspects
hlSymbol Doc Aspects
"@" Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Semigroup a => a -> a -> a
<> Expr -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Expr
e
            Dot KwRange
_ Expr
e   -> Doc Aspects -> Doc Aspects
hlSymbol Doc Aspects
"." Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Semigroup a => a -> a -> a
<> Expr -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Expr
e
            DoubleDot KwRange
_ Expr
e  -> Doc Aspects -> Doc Aspects
hlSymbol Doc Aspects
".." Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Semigroup a => a -> a -> a
<> Expr -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Expr
e
            Absurd Range' SrcFile
_  -> Doc Aspects -> Doc Aspects
hlSymbol Doc Aspects
"()"
            Rec KwRange
_ Range' SrcFile
_ [RecordAssignment]
xs ->
              [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep [Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"record", [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
bracesAndSemicolons ((RecordAssignment -> Doc Aspects)
-> [RecordAssignment] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map RecordAssignment -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [RecordAssignment]
xs)]
            RecUpdate KwRange
_ Range' SrcFile
_ Expr
e [FieldAssignment]
xs ->
              [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep [Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"record" Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Expr -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Expr
e, [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
bracesAndSemicolons ((FieldAssignment -> Doc Aspects)
-> [FieldAssignment] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map FieldAssignment -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [FieldAssignment]
xs)]
            RecWhere KwRange
_ Range' SrcFile
_ [Declaration]
xs -> [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep [Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"record" Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"where", Int -> Doc Aspects -> Doc Aspects
forall a. Int -> Doc a -> Doc a
nest Int
2 ([Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
vcat ([Doc Aspects] -> Doc Aspects) -> [Doc Aspects] -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ (Declaration -> Doc Aspects) -> [Declaration] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map Declaration -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [Declaration]
xs)]
            RecUpdateWhere KwRange
_ Range' SrcFile
_ Expr
e [Declaration]
xs -> [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep [Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"record" Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Expr -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Expr
e Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"where", Int -> Doc Aspects -> Doc Aspects
forall a. Int -> Doc a -> Doc a
nest Int
2 ([Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
vcat ([Doc Aspects] -> Doc Aspects) -> [Doc Aspects] -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ (Declaration -> Doc Aspects) -> [Declaration] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map Declaration -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [Declaration]
xs)]
            Quote Range' SrcFile
_     -> Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"quote"
            QuoteTerm Range' SrcFile
_ -> Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"quoteTerm"
            Unquote Range' SrcFile
_   -> Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"unquote"
            Tactic Range' SrcFile
_ Expr
t -> Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"tactic" Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Expr -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Expr
t
            -- Andreas, 2011-10-03 print irrelevant things as .(e)
            DontCare Expr
e -> Doc Aspects -> Doc Aspects
hlSymbol Doc Aspects
"." Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Semigroup a => a -> a -> a
<> Doc Aspects -> Doc Aspects
parens (Expr -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Expr
e)
            Equal Range' SrcFile
_ Expr
a Expr
b -> Expr -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Expr
a Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Doc Aspects
equals Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Expr -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Expr
b
            Ellipsis Range' SrcFile
_  -> Doc Aspects -> Doc Aspects
hlSymbol Doc Aspects
"..."
            Generalized Expr
e -> Expr -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Expr
e
            Highlighted Aspects
a Expr
e -> Aspects -> Doc Aspects -> Doc Aspects
annotate Aspects
a (Expr -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Expr
e)
        where
          absurd :: Hiding -> Doc Aspects
absurd Hiding
NotHidden  = Doc Aspects -> Doc Aspects
parens Doc Aspects
forall a. Monoid a => a
mempty
          absurd Instance{} = Doc Aspects -> Doc Aspects
dbraces Doc Aspects
forall a. Monoid a => a
mempty
          absurd Hiding
Hidden     = Doc Aspects -> Doc Aspects
braces Doc Aspects
forall a. Monoid a => a
mempty

instance (Pretty a, Pretty b) => Pretty (Either a b) where
  pretty :: Either a b -> Doc Aspects
pretty = (a -> Doc Aspects)
-> (b -> Doc Aspects) -> Either a b -> Doc Aspects
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty b -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty

instance Pretty a => Pretty (FieldAssignment' a) where
  pretty :: FieldAssignment' a -> Doc Aspects
pretty (FieldAssignment Name
x a
e) = [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep [ Name -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Name
x Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Doc Aspects
equals, Int -> Doc Aspects -> Doc Aspects
forall a. Int -> Doc a -> Doc a
nest Int
2 (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ a -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty a
e ]

instance Pretty ModuleAssignment where
  pretty :: ModuleAssignment -> Doc Aspects
pretty (ModuleAssignment QName
m [Expr]
es ImportDirective' Name Name
i) = [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
fsep (QName -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty QName
m Doc Aspects -> [Doc Aspects] -> [Doc Aspects]
forall a. a -> [a] -> [a]
: (Expr -> Doc Aspects) -> [Expr] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [Expr]
es) Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> ImportDirective' Name Name -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty ImportDirective' Name Name
i

instance Pretty LamClause where
  pretty :: LamClause -> Doc Aspects
pretty (LamClause [Pattern]
ps RHS' Expr
rhs Catchall
_) =
    [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep [ [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
fsep ((Pattern -> Doc Aspects) -> [Pattern] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map Pattern -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [Pattern]
ps)
        , Int -> Doc Aspects -> Doc Aspects
forall a. Int -> Doc a -> Doc a
nest Int
2 (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ RHS' Expr -> Doc Aspects
forall {a}. Pretty a => RHS' a -> Doc Aspects
pretty' RHS' Expr
rhs
        ]
    where
      pretty' :: RHS' a -> Doc Aspects
pretty' (RHS a
e)   = Doc Aspects
arrow Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> a -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty a
e
      pretty' RHS' a
AbsurdRHS = Doc Aspects
forall a. Null a => a
empty

-- Andreas, 2024-02-25
-- Q: Can we always ignore the tactic and the finiteness here?
instance Pretty BoundName where
  pretty :: BoundName -> Doc Aspects
pretty (BName Name
x Fixity'
_fix TacticAttribute' Expr
_tac Bool
_fin) = Name -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Name
x

data NamedBinding = NamedBinding
  { NamedBinding -> Bool
withHiding   :: Bool
  , NamedBinding -> NamedArg Binder
namedBinding :: NamedArg Binder
  }

isLabeled :: NamedArg Binder -> Maybe ArgName
isLabeled :: NamedArg Binder -> Maybe [Char]
isLabeled NamedArg Binder
x
  | NamedArg Binder -> Bool
forall a. LensHiding a => a -> Bool
visible NamedArg Binder
x              = Maybe [Char]
forall a. Maybe a
Nothing  -- Ignore labels on visible arguments
  | Just [Char]
l <- NamedArg Binder -> Maybe [Char]
forall a. (LensNamed a, NameOf a ~ NamedName) => a -> Maybe [Char]
bareNameOf NamedArg Binder
x = Bool -> [Char] -> Maybe [Char]
forall a. Bool -> a -> Maybe a
boolToMaybe ([Char]
l [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= Name -> [Char]
nameToRawName (BoundName -> Name
boundName (BoundName -> Name) -> BoundName -> Name
forall a b. (a -> b) -> a -> b
$ Binder -> BoundName
forall a. Binder' a -> a
binderName (Binder -> BoundName) -> Binder -> BoundName
forall a b. (a -> b) -> a -> b
$ NamedArg Binder -> Binder
forall a. NamedArg a -> a
namedArg NamedArg Binder
x)) [Char]
l
  | Bool
otherwise              = Maybe [Char]
forall a. Maybe a
Nothing

instance Pretty a => Pretty (Binder' a) where
  pretty :: Binder' a -> Doc Aspects
pretty (Binder Maybe Pattern
mpat BinderNameOrigin
UserBinderName a
n) =
    Maybe Pattern
-> (Pattern -> Doc Aspects -> Doc Aspects)
-> Doc Aspects
-> Doc Aspects
forall b a. Maybe b -> (b -> a -> a) -> a -> a
applyWhenJust Maybe Pattern
mpat (\ Pattern
pat -> (Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> (Doc Aspects
"@" Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Doc Aspects -> Doc Aspects
parens (Pattern -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Pattern
pat)))) (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ a -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty a
n

  pretty (Binder Maybe Pattern
pat BinderNameOrigin
InsertedBinderName a
n) = case Maybe Pattern
pat of
    Just Pattern
pat -> Doc Aspects -> Doc Aspects
parens (Pattern -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Pattern
pat)
    Maybe Pattern
Nothing  -> a -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty a
n

instance Pretty NamedBinding where
  pretty :: NamedBinding -> Doc Aspects
pretty (NamedBinding Bool
withH
           x :: NamedArg Binder
x@(Arg (ArgInfo Hiding
h (Modality Relevance
r Quantity
q Cohesion
c PolarityModality
p) Origin
_o FreeVariables
_fv (Annotation Lock
lock RewriteAnn
rew))
               (Named Maybe NamedName
_mn xb :: Binder
xb@(Binder Maybe Pattern
_mp BinderNameOrigin
_ (BName Name
_y Fixity'
_fix TacticAttribute' Expr
t Bool
_fin))))) =
    Bool -> (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall b a. IsBool b => b -> (a -> a) -> a -> a
applyWhen Bool
withH Doc Aspects -> Doc Aspects
prH (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$
    Maybe [Char]
-> ([Char] -> Doc Aspects -> Doc Aspects)
-> Doc Aspects
-> Doc Aspects
forall b a. Maybe b -> (b -> a -> a) -> a -> a
applyWhenJust (NamedArg Binder -> Maybe [Char]
isLabeled NamedArg Binder
x) (\ [Char]
l -> ([Char] -> Doc Aspects
forall a. [Char] -> Doc a
text [Char]
l Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+>) (Doc Aspects -> Doc Aspects)
-> (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc Aspects
equals Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+>)) (Binder -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Binder
xb)
      -- isLabeled looks at _mn and _y
      -- pretty xb prints also the pattern _mp
    where
    prH :: Doc Aspects -> Doc Aspects
prH = Relevance -> Doc Aspects -> Doc Aspects
forall a. LensRelevance a => a -> Doc Aspects -> Doc Aspects
prettyRelevance Relevance
r
        (Doc Aspects -> Doc Aspects)
-> (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hiding
-> (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a.
LensHiding a =>
a -> (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
prettyHiding Hiding
h Doc Aspects -> Doc Aspects
mparens
        (Doc Aspects -> Doc Aspects)
-> (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc Aspects
coh Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+>)
        (Doc Aspects -> Doc Aspects)
-> (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc Aspects
qnt Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+>)
        (Doc Aspects -> Doc Aspects)
-> (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc Aspects
pol Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+>)
        (Doc Aspects -> Doc Aspects)
-> (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc Aspects
lck Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+>)
        (Doc Aspects -> Doc Aspects)
-> (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc Aspects
tac Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+>)
        (Doc Aspects -> Doc Aspects)
-> (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc Aspects
rw  Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+>)
    coh :: Doc Aspects
coh = Cohesion -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Cohesion
c
    qnt :: Doc Aspects
qnt = Quantity -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Quantity
q
    pol :: Doc Aspects
pol = PolarityModality -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty PolarityModality
p
    tac :: Doc Aspects
tac = TacticAttribute' Expr -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty TacticAttribute' Expr
t
    lck :: Doc Aspects
lck = Lock -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Lock
lock
    rw :: Doc Aspects
rw  = RewriteAnn -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty RewriteAnn
rew
    -- Parentheses are needed when an attribute @... is printed
    mparens :: Doc Aspects -> Doc Aspects
mparens = Bool -> (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall b a. IsBool b => b -> (a -> a) -> a -> a
applyUnless (Doc Aspects -> Bool
forall a. Null a => a -> Bool
null Doc Aspects
coh Bool -> Bool -> Bool
&& Doc Aspects -> Bool
forall a. Null a => a -> Bool
null Doc Aspects
qnt Bool -> Bool -> Bool
&& Doc Aspects -> Bool
forall a. Null a => a -> Bool
null Doc Aspects
lck Bool -> Bool -> Bool
&& Doc Aspects -> Bool
forall a. Null a => a -> Bool
null Doc Aspects
tac Bool -> Bool -> Bool
&& Doc Aspects -> Bool
forall a. Null a => a -> Bool
null Doc Aspects
pol) Doc Aspects -> Doc Aspects
parens

instance Pretty LamBinding where
    pretty :: LamBinding -> Doc Aspects
pretty (DomainFree NamedArg Binder
x) = NamedBinding -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty (Bool -> NamedArg Binder -> NamedBinding
NamedBinding Bool
True NamedArg Binder
x)
    pretty (DomainFull TypedBinding
b) = TypedBinding -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty TypedBinding
b

instance Pretty TypedBinding where
    pretty :: TypedBinding -> Doc Aspects
pretty (TLet Range' SrcFile
_ NonEmpty Declaration
ds) = Doc Aspects -> Doc Aspects
parens (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"let" Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> NonEmpty (Doc Aspects) -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
vcat ((Declaration -> Doc Aspects)
-> NonEmpty Declaration -> NonEmpty (Doc Aspects)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Declaration -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty NonEmpty Declaration
ds)
    pretty (TBind Range' SrcFile
_ NonEmpty (NamedArg Binder)
xs (Underscore Range' SrcFile
_ Maybe [Char]
Nothing)) =
      NonEmpty (Doc Aspects) -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
fsep ((NamedArg Binder -> Doc Aspects)
-> NonEmpty (NamedArg Binder) -> NonEmpty (Doc Aspects)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NamedBinding -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty (NamedBinding -> Doc Aspects)
-> (NamedArg Binder -> NamedBinding)
-> NamedArg Binder
-> Doc Aspects
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> NamedArg Binder -> NamedBinding
NamedBinding Bool
True) NonEmpty (NamedArg Binder)
xs)
    pretty (TBind Range' SrcFile
_ NonEmpty (NamedArg Binder)
xs Expr
e) = [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
fsep
      [ NamedArg Binder -> Doc Aspects -> Doc Aspects
forall a. LensRelevance a => a -> Doc Aspects -> Doc Aspects
prettyRelevance NamedArg Binder
y
        (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ NamedArg Binder
-> (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a.
LensHiding a =>
a -> (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
prettyHiding NamedArg Binder
y Doc Aspects -> Doc Aspects
parens
        (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ BoundName -> Doc Aspects -> Doc Aspects
prettyFiniteness (Binder -> BoundName
forall a. Binder' a -> a
binderName (Binder -> BoundName) -> Binder -> BoundName
forall a b. (a -> b) -> a -> b
$ NamedArg Binder -> Binder
forall a. NamedArg a -> a
namedArg NamedArg Binder
y)
        (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ NamedArg Binder -> Doc Aspects -> Doc Aspects
forall a. LensCohesion a => a -> Doc Aspects -> Doc Aspects
prettyCohesion NamedArg Binder
y
        (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ NamedArg Binder -> Doc Aspects -> Doc Aspects
forall a. LensQuantity a => a -> Doc Aspects -> Doc Aspects
prettyQuantity NamedArg Binder
y
        (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ NamedArg Binder -> Doc Aspects -> Doc Aspects
forall a. LensLock a => a -> Doc Aspects -> Doc Aspects
prettyLock NamedArg Binder
y
        (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ NamedArg Binder -> Doc Aspects -> Doc Aspects
forall a. LensModalPolarity a => a -> Doc Aspects -> Doc Aspects
prettyPolarity NamedArg Binder
y
        (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ BoundName -> Doc Aspects -> Doc Aspects
prettyTactic (Binder -> BoundName
forall a. Binder' a -> a
binderName (Binder -> BoundName) -> Binder -> BoundName
forall a b. (a -> b) -> a -> b
$ NamedArg Binder -> Binder
forall a. NamedArg a -> a
namedArg NamedArg Binder
y)
        (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ NamedArg Binder -> Doc Aspects -> Doc Aspects
forall a. LensRewriteAnn a => a -> Doc Aspects -> Doc Aspects
prettyRewriteAnn NamedArg Binder
y (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$
        [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep [ [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
fsep ((NamedArg Binder -> Doc Aspects)
-> [NamedArg Binder] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map (NamedBinding -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty (NamedBinding -> Doc Aspects)
-> (NamedArg Binder -> NamedBinding)
-> NamedArg Binder
-> Doc Aspects
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> NamedArg Binder -> NamedBinding
NamedBinding Bool
False) [NamedArg Binder]
ys)
            , Doc Aspects
colon Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Expr -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Expr
e ]
      | ys :: [NamedArg Binder]
ys@(NamedArg Binder
y : [NamedArg Binder]
_) <- [NamedArg Binder] -> [[NamedArg Binder]]
groupBinds ([NamedArg Binder] -> [[NamedArg Binder]])
-> [NamedArg Binder] -> [[NamedArg Binder]]
forall a b. (a -> b) -> a -> b
$ NonEmpty (NamedArg Binder) -> [Item (NonEmpty (NamedArg Binder))]
forall l. IsList l => l -> [Item l]
List1.toList NonEmpty (NamedArg Binder)
xs ]
      where
        groupBinds :: [NamedArg Binder] -> [[NamedArg Binder]]
groupBinds [] = []
        groupBinds (NamedArg Binder
x : [NamedArg Binder]
xs)
          | Just{} <- NamedArg Binder -> Maybe [Char]
isLabeled NamedArg Binder
x = [NamedArg Binder
x] [NamedArg Binder] -> [[NamedArg Binder]] -> [[NamedArg Binder]]
forall a. a -> [a] -> [a]
: [NamedArg Binder] -> [[NamedArg Binder]]
groupBinds [NamedArg Binder]
xs
          | Bool
otherwise   = (NamedArg Binder
x NamedArg Binder -> [NamedArg Binder] -> [NamedArg Binder]
forall a. a -> [a] -> [a]
: [NamedArg Binder]
ys) [NamedArg Binder] -> [[NamedArg Binder]] -> [[NamedArg Binder]]
forall a. a -> [a] -> [a]
: [NamedArg Binder] -> [[NamedArg Binder]]
groupBinds [NamedArg Binder]
zs
          where ([NamedArg Binder]
ys, [NamedArg Binder]
zs) = (NamedArg Binder -> Bool)
-> [NamedArg Binder] -> ([NamedArg Binder], [NamedArg Binder])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (NamedArg Binder -> NamedArg Binder -> Bool
forall {a}. LensArgInfo a => a -> NamedArg Binder -> Bool
same NamedArg Binder
x) [NamedArg Binder]
xs
                same :: a -> NamedArg Binder -> Bool
same a
x NamedArg Binder
y = a -> ArgInfo
forall a. LensArgInfo a => a -> ArgInfo
getArgInfo a
x ArgInfo -> ArgInfo -> Bool
forall a. Eq a => a -> a -> Bool
== NamedArg Binder -> ArgInfo
forall a. LensArgInfo a => a -> ArgInfo
getArgInfo NamedArg Binder
y Bool -> Bool -> Bool
&& Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isNothing (NamedArg Binder -> Maybe [Char]
isLabeled NamedArg Binder
y)

newtype Tel = Tel Telescope

instance Pretty Tel where
    pretty :: Tel -> Doc Aspects
pretty (Tel [TypedBinding]
tel)
      | (TypedBinding -> Bool) -> [TypedBinding] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any TypedBinding -> Bool
isMeta [TypedBinding]
tel = Doc Aspects
forallQ Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
fsep ((TypedBinding -> Doc Aspects) -> [TypedBinding] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map TypedBinding -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [TypedBinding]
tel)
      | Bool
otherwise      = [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
fsep ((TypedBinding -> Doc Aspects) -> [TypedBinding] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map TypedBinding -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [TypedBinding]
tel)
      where
        isMeta :: TypedBinding -> Bool
isMeta (TBind Range' SrcFile
_ NonEmpty (NamedArg Binder)
_ (Underscore Range' SrcFile
_ Maybe [Char]
Nothing)) = Bool
True
        isMeta TypedBinding
_ = Bool
False

smashTel :: Telescope -> Telescope
smashTel :: [TypedBinding] -> [TypedBinding]
smashTel (TBind Range' SrcFile
r NonEmpty (NamedArg Binder)
xs Expr
e  :
          TBind Range' SrcFile
_ NonEmpty (NamedArg Binder)
ys Expr
e' : [TypedBinding]
tel)
  | Expr -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow Expr
e [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== Expr -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow Expr
e' = [TypedBinding] -> [TypedBinding]
smashTel (Range' SrcFile
-> NonEmpty (NamedArg Binder) -> Expr -> TypedBinding
forall e.
Range' SrcFile
-> NonEmpty (NamedArg Binder) -> e -> TypedBinding' e
TBind Range' SrcFile
r (NonEmpty (NamedArg Binder)
xs NonEmpty (NamedArg Binder)
-> NonEmpty (NamedArg Binder) -> NonEmpty (NamedArg Binder)
forall a. Semigroup a => a -> a -> a
<> NonEmpty (NamedArg Binder)
ys) Expr
e TypedBinding -> [TypedBinding] -> [TypedBinding]
forall a. a -> [a] -> [a]
: [TypedBinding]
tel)
smashTel (TypedBinding
b : [TypedBinding]
tel) = TypedBinding
b TypedBinding -> [TypedBinding] -> [TypedBinding]
forall a. a -> [a] -> [a]
: [TypedBinding] -> [TypedBinding]
smashTel [TypedBinding]
tel
smashTel [] = []


instance Pretty RHS where
    pretty :: RHS' Expr -> Doc Aspects
pretty (RHS Expr
e)   = Doc Aspects
equals Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Expr -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Expr
e
    pretty RHS' Expr
AbsurdRHS = Doc Aspects
forall a. Null a => a
empty

instance Pretty WhereClause where
  pretty :: WhereClause' [Declaration] -> Doc Aspects
pretty  WhereClause' [Declaration]
NoWhere = Doc Aspects
forall a. Null a => a
empty
  pretty (AnyWhere Range' SrcFile
_ [Module Range' SrcFile
_ NotErased{} QName
x [] [Declaration]
ds])
    | Name -> Bool
forall a. IsNoName a => a -> Bool
isNoName (QName -> Name
unqualify QName
x)
                       = [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
vcat [ Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"where", Int -> Doc Aspects -> Doc Aspects
forall a. Int -> Doc a -> Doc a
nest Int
2 ([Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
vcat ([Doc Aspects] -> Doc Aspects) -> [Doc Aspects] -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ (Declaration -> Doc Aspects) -> [Declaration] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map Declaration -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [Declaration]
ds) ]
  pretty (AnyWhere Range' SrcFile
_ [Declaration]
ds) = [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
vcat [ Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"where", Int -> Doc Aspects -> Doc Aspects
forall a. Int -> Doc a -> Doc a
nest Int
2 ([Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
vcat ([Doc Aspects] -> Doc Aspects) -> [Doc Aspects] -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ (Declaration -> Doc Aspects) -> [Declaration] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map Declaration -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [Declaration]
ds) ]
  pretty (SomeWhere Range' SrcFile
_ Erased
erased Name
m Access
a [Declaration]
ds) =
    [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
vcat [ [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
hsep ([Doc Aspects] -> Doc Aspects) -> [Doc Aspects] -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ Access -> [Doc Aspects] -> [Doc Aspects]
privateWhenUserWritten Access
a
             [ Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"module", Erased -> Doc Aspects -> Doc Aspects
prettyErased Erased
erased (Name -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Name
m), Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"where" ]
         , Int -> Doc Aspects -> Doc Aspects
forall a. Int -> Doc a -> Doc a
nest Int
2 ([Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
vcat ([Doc Aspects] -> Doc Aspects) -> [Doc Aspects] -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ (Declaration -> Doc Aspects) -> [Declaration] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map Declaration -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [Declaration]
ds)
         ]
    where
      privateWhenUserWritten :: Access -> [Doc Aspects] -> [Doc Aspects]
privateWhenUserWritten = \case
        PrivateAccess KwRange
_ Origin
UserWritten -> (Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"private" Doc Aspects -> [Doc Aspects] -> [Doc Aspects]
forall a. a -> [a] -> [a]
:)
        Access
_ -> [Doc Aspects] -> [Doc Aspects]
forall a. a -> a
id

instance Pretty LHS where
  pretty :: LHS -> Doc Aspects
pretty (LHS Pattern
p [RewriteEqn]
eqs [WithExpr]
es) = [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep
    [ Pattern -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Pattern
p
    , Int -> Doc Aspects -> Doc Aspects
forall a. Int -> Doc a -> Doc a
nest Int
2 (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ if [RewriteEqn] -> Bool
forall a. Null a => a -> Bool
null [RewriteEqn]
eqs then Doc Aspects
forall a. Null a => a
empty else [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
fsep ([Doc Aspects] -> Doc Aspects) -> [Doc Aspects] -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ (RewriteEqn -> Doc Aspects) -> [RewriteEqn] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map RewriteEqn -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [RewriteEqn]
eqs
    , Int -> Doc Aspects -> Doc Aspects
forall a. Int -> Doc a -> Doc a
nest Int
2 (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ Doc Aspects -> [Doc Aspects] -> Doc Aspects
prefixedThings (Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"with") ((WithExpr -> Doc Aspects) -> [WithExpr] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map WithExpr -> Doc Aspects
prettyWithd [WithExpr]
es)
    ] where

    prettyWithd :: WithExpr -> Doc
    prettyWithd :: WithExpr -> Doc Aspects
prettyWithd (Named Maybe Name
nm Arg Expr
wh) =
      let e :: Doc Aspects
e = Arg Expr -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Arg Expr
wh in
      case Maybe Name
nm of
        Maybe Name
Nothing -> Doc Aspects
e
        Just Name
n  -> Name -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Name
n Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Doc Aspects
colon Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Doc Aspects
e

instance Pretty LHSCore where
  pretty :: LHSCore -> Doc Aspects
pretty (LHSHead QName
f [Arg (Named_ Pattern)]
ps) = [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep ([Doc Aspects] -> Doc Aspects) -> [Doc Aspects] -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ QName -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty QName
f Doc Aspects -> [Doc Aspects] -> [Doc Aspects]
forall a. a -> [a] -> [a]
: (Arg (Named_ Pattern) -> Doc Aspects)
-> [Arg (Named_ Pattern)] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map (Doc Aspects -> Doc Aspects
parens (Doc Aspects -> Doc Aspects)
-> (Arg (Named_ Pattern) -> Doc Aspects)
-> Arg (Named_ Pattern)
-> Doc Aspects
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg (Named_ Pattern) -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty) [Arg (Named_ Pattern)]
ps
  pretty (LHSProj QName
d [Arg (Named_ Pattern)]
ps Arg (Named_ LHSCore)
lhscore [Arg (Named_ Pattern)]
ps') = [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep ([Doc Aspects] -> Doc Aspects) -> [Doc Aspects] -> Doc Aspects
forall a b. (a -> b) -> a -> b
$
    QName -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty QName
d Doc Aspects -> [Doc Aspects] -> [Doc Aspects]
forall a. a -> [a] -> [a]
: (Arg (Named_ Pattern) -> Doc Aspects)
-> [Arg (Named_ Pattern)] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map (Doc Aspects -> Doc Aspects
parens (Doc Aspects -> Doc Aspects)
-> (Arg (Named_ Pattern) -> Doc Aspects)
-> Arg (Named_ Pattern)
-> Doc Aspects
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg (Named_ Pattern) -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty) [Arg (Named_ Pattern)]
ps [Doc Aspects] -> [Doc Aspects] -> [Doc Aspects]
forall a. [a] -> [a] -> [a]
++
    Doc Aspects -> Doc Aspects
parens (Arg (Named_ LHSCore) -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Arg (Named_ LHSCore)
lhscore) Doc Aspects -> [Doc Aspects] -> [Doc Aspects]
forall a. a -> [a] -> [a]
: (Arg (Named_ Pattern) -> Doc Aspects)
-> [Arg (Named_ Pattern)] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map (Doc Aspects -> Doc Aspects
parens (Doc Aspects -> Doc Aspects)
-> (Arg (Named_ Pattern) -> Doc Aspects)
-> Arg (Named_ Pattern)
-> Doc Aspects
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg (Named_ Pattern) -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty) [Arg (Named_ Pattern)]
ps'
  pretty (LHSWith LHSCore
h NonEmpty Pattern
wps [Arg (Named_ Pattern)]
ps) = if [Arg (Named_ Pattern)] -> Bool
forall a. Null a => a -> Bool
null [Arg (Named_ Pattern)]
ps then Doc Aspects
doc else
      [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep ([Doc Aspects] -> Doc Aspects) -> [Doc Aspects] -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ Doc Aspects -> Doc Aspects
parens Doc Aspects
doc Doc Aspects -> [Doc Aspects] -> [Doc Aspects]
forall a. a -> [a] -> [a]
: (Arg (Named_ Pattern) -> Doc Aspects)
-> [Arg (Named_ Pattern)] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map (Doc Aspects -> Doc Aspects
parens (Doc Aspects -> Doc Aspects)
-> (Arg (Named_ Pattern) -> Doc Aspects)
-> Arg (Named_ Pattern)
-> Doc Aspects
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg (Named_ Pattern) -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty) [Arg (Named_ Pattern)]
ps
    where
    doc :: Doc Aspects
doc = NonEmpty (Doc Aspects) -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep (NonEmpty (Doc Aspects) -> Doc Aspects)
-> NonEmpty (Doc Aspects) -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ LHSCore -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty LHSCore
h Doc Aspects -> NonEmpty (Doc Aspects) -> NonEmpty (Doc Aspects)
forall a b. a -> NonEmpty b -> NonEmpty a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Pattern -> Doc Aspects)
-> NonEmpty Pattern -> NonEmpty (Doc Aspects)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Doc Aspects
pipe Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+>) (Doc Aspects -> Doc Aspects)
-> (Pattern -> Doc Aspects) -> Pattern -> Doc Aspects
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty) NonEmpty Pattern
wps
  pretty (LHSEllipsis Range' SrcFile
_ LHSCore
_) = Doc Aspects
"..."

instance Pretty ModuleApplication where
  pretty :: ModuleApplication -> Doc Aspects
pretty (SectionApp Range' SrcFile
_ [TypedBinding]
bs QName
x [Expr]
es) = [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
fsep ([Doc Aspects] -> Doc Aspects) -> [Doc Aspects] -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ [[Doc Aspects]] -> [Doc Aspects]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ (TypedBinding -> Doc Aspects) -> [TypedBinding] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map TypedBinding -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [TypedBinding]
bs
    , [ Doc Aspects
equals, QName -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty QName
x ]
    , (Expr -> Doc Aspects) -> [Expr] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [Expr]
es
    ]
  pretty (RecordModuleInstance Range' SrcFile
_ QName
x) = Doc Aspects
equals Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> QName -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty QName
x Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Doc Aspects
"{{...}}"

instance Pretty DoStmt where
  pretty :: DoStmt -> Doc Aspects
pretty (DoBind Range' SrcFile
_ Pattern
p Expr
e [LamClause]
cs) =
    ((Pattern -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Pattern
p Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Doc Aspects
fromArrow) Doc Aspects -> Doc Aspects -> Doc Aspects
<?> Expr -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Expr
e) Doc Aspects -> Doc Aspects -> Doc Aspects
<?> [LamClause] -> Doc Aspects
forall {a}. Pretty a => [a] -> Doc Aspects
prCs [LamClause]
cs
    where
      prCs :: [a] -> Doc Aspects
prCs [] = Doc Aspects
forall a. Null a => a
empty
      prCs [a]
cs = Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"where" Doc Aspects -> Doc Aspects -> Doc Aspects
<?> [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
vcat ((a -> Doc Aspects) -> [a] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [a]
cs)
  pretty (DoThen Expr
e)   = Expr -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Expr
e
  pretty (DoLet Range' SrcFile
_ NonEmpty Declaration
ds) = Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"let" Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> NonEmpty (Doc Aspects) -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
vcat ((Declaration -> Doc Aspects)
-> NonEmpty Declaration -> NonEmpty (Doc Aspects)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Declaration -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty NonEmpty Declaration
ds)

instance Pretty Declaration where
  prettyList :: [Declaration] -> Doc Aspects
prettyList = [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
vcat ([Doc Aspects] -> Doc Aspects)
-> ([Declaration] -> [Doc Aspects]) -> [Declaration] -> Doc Aspects
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Declaration -> Doc Aspects) -> [Declaration] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map Declaration -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty
  pretty :: Declaration -> Doc Aspects
pretty = \case
    TypeSig ArgInfo
i TacticAttribute' Expr
tac Name
x Expr
e ->
      [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep [ TacticAttribute' Expr -> Doc Aspects -> Doc Aspects
prettyTactic' TacticAttribute' Expr
tac (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ ArgInfo -> Doc Aspects -> Doc Aspects
forall a. LensRelevance a => a -> Doc Aspects -> Doc Aspects
prettyRelevance ArgInfo
i (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ ArgInfo -> Doc Aspects -> Doc Aspects
forall a. LensCohesion a => a -> Doc Aspects -> Doc Aspects
prettyCohesion ArgInfo
i (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$
              ArgInfo -> Doc Aspects -> Doc Aspects
forall a. LensQuantity a => a -> Doc Aspects -> Doc Aspects
prettyQuantity ArgInfo
i (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ ArgInfo -> Doc Aspects -> Doc Aspects
forall a. LensModalPolarity a => a -> Doc Aspects -> Doc Aspects
prettyPolarity ArgInfo
i (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ Name -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Name
x Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Doc Aspects
colon
          , Int -> Doc Aspects -> Doc Aspects
forall a. Int -> Doc a -> Doc a
nest Int
2 (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ Expr -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Expr
e
          ]
    FieldSig IsInstance
inst TacticAttribute' Expr
tac Name
x (Arg ArgInfo
i Expr
e) ->
      IsInstance -> Doc Aspects -> Doc Aspects
mkInst IsInstance
inst (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ ArgInfo -> Doc Aspects -> Doc Aspects
forall {a}. LensHiding a => a -> Doc Aspects -> Doc Aspects
mkOverlap ArgInfo
i (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$
      -- We print relevance before hiding, need to clear it before printing the rest of the attributes with TypeSig.
      ArgInfo -> Doc Aspects -> Doc Aspects
forall a. LensRelevance a => a -> Doc Aspects -> Doc Aspects
prettyRelevance ArgInfo
i (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ ArgInfo
-> (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a.
LensHiding a =>
a -> (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
prettyHiding ArgInfo
i Doc Aspects -> Doc Aspects
forall a. a -> a
id (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$
      Declaration -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty (Declaration -> Doc Aspects) -> Declaration -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ ArgInfo -> TacticAttribute' Expr -> Name -> Expr -> Declaration
TypeSig (Relevance -> ArgInfo -> ArgInfo
forall a. LensRelevance a => Relevance -> a -> a
setRelevance Relevance
relevant ArgInfo
i) TacticAttribute' Expr
tac Name
x Expr
e
      where
        mkInst :: IsInstance -> Doc Aspects -> Doc Aspects
mkInst (InstanceDef KwRange
_) Doc Aspects
d = [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep [ Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"instance", Int -> Doc Aspects -> Doc Aspects
forall a. Int -> Doc a -> Doc a
nest Int
2 Doc Aspects
d ]
        mkInst IsInstance
NotInstanceDef  Doc Aspects
d = Doc Aspects
d

        mkOverlap :: a -> Doc Aspects -> Doc Aspects
mkOverlap a
i Doc Aspects
d | a -> Bool
forall a. LensHiding a => a -> Bool
isYesOverlap a
i = Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"overlap" Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Doc Aspects
d
                      | Bool
otherwise      = Doc Aspects
d
    Field KwRange
_ [Declaration]
fs ->
      [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep [ Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"field"
          , Int -> Doc Aspects -> Doc Aspects
forall a. Int -> Doc a -> Doc a
nest Int
2 (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
vcat ((Declaration -> Doc Aspects) -> [Declaration] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map Declaration -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [Declaration]
fs)
          ]
    FunClause ArgInfo
ai LHS
lhs RHS' Expr
rhs WhereClause' [Declaration]
wh Catchall
_ ->
      [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep [ Modality -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty (ArgInfo -> Modality
forall a. LensModality a => a -> Modality
getModality ArgInfo
ai)
          , LHS -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty LHS
lhs
          , Int -> Doc Aspects -> Doc Aspects
forall a. Int -> Doc a -> Doc a
nest Int
2 (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ RHS' Expr -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty RHS' Expr
rhs
          ] Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
$$ Int -> Doc Aspects -> Doc Aspects
forall a. Int -> Doc a -> Doc a
nest Int
2 (WhereClause' [Declaration] -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty WhereClause' [Declaration]
wh)
    DataSig Range' SrcFile
_ Erased
erased Name
x [LamBinding]
tel Expr
e ->
      [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep [ [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
hsep  [ Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"data"
                  , Erased -> Doc Aspects -> Doc Aspects
prettyErased Erased
erased (Name -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Name
x)
                  , [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
fsep ((LamBinding -> Doc Aspects) -> [LamBinding] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map LamBinding -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [LamBinding]
tel)
                  ]
          , Int -> Doc Aspects -> Doc Aspects
forall a. Int -> Doc a -> Doc a
nest Int
2 (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
hsep
                  [ Doc Aspects
colon
                  , Expr -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Expr
e
                  ]
          ]
    Data Range' SrcFile
_ Erased
erased Name
x [LamBinding]
tel Expr
e [Declaration]
cs ->
      [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep [ [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
hsep  [ Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"data"
                  , Erased -> Doc Aspects -> Doc Aspects
prettyErased Erased
erased (Name -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Name
x)
                  , [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
fsep ((LamBinding -> Doc Aspects) -> [LamBinding] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map LamBinding -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [LamBinding]
tel)
                  ]
          , Int -> Doc Aspects -> Doc Aspects
forall a. Int -> Doc a -> Doc a
nest Int
2 (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
hsep
                  [ Doc Aspects
colon
                  , Expr -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Expr
e
                  , Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"where"
                  ]
          ] Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
$$ Int -> Doc Aspects -> Doc Aspects
forall a. Int -> Doc a -> Doc a
nest Int
2 ([Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
vcat ([Doc Aspects] -> Doc Aspects) -> [Doc Aspects] -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ (Declaration -> Doc Aspects) -> [Declaration] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map Declaration -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [Declaration]
cs)
    DataDef Range' SrcFile
_ Name
x [LamBinding]
tel [Declaration]
cs ->
      [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep [ [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
hsep  [ Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"data"
                  , Name -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Name
x
                  , [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
fsep ((LamBinding -> Doc Aspects) -> [LamBinding] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map LamBinding -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [LamBinding]
tel)
                  ]
          , Int -> Doc Aspects -> Doc Aspects
forall a. Int -> Doc a -> Doc a
nest Int
2 (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"where"
          ] Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
$$ Int -> Doc Aspects -> Doc Aspects
forall a. Int -> Doc a -> Doc a
nest Int
2 ([Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
vcat ([Doc Aspects] -> Doc Aspects) -> [Doc Aspects] -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ (Declaration -> Doc Aspects) -> [Declaration] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map Declaration -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [Declaration]
cs)
    RecordSig Range' SrcFile
_ Erased
erased Name
x [LamBinding]
tel Expr
e ->
      [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep [ [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
hsep  [ Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"record"
                  , Erased -> Doc Aspects -> Doc Aspects
prettyErased Erased
erased (Name -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Name
x)
                  , [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
fsep ((LamBinding -> Doc Aspects) -> [LamBinding] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map LamBinding -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [LamBinding]
tel)
                  ]
          , Int -> Doc Aspects -> Doc Aspects
forall a. Int -> Doc a -> Doc a
nest Int
2 (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
hsep
                  [ Doc Aspects
colon
                  , Expr -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Expr
e
                  ]
          ]
    Record Range' SrcFile
_ Erased
erased Name
x [RecordDirective]
dir [LamBinding]
tel Expr
e [Declaration]
cs ->
      Erased
-> Name
-> [RecordDirective]
-> [LamBinding]
-> Maybe Expr
-> [Declaration]
-> Doc Aspects
pRecord Erased
erased Name
x [RecordDirective]
dir [LamBinding]
tel (Expr -> Maybe Expr
forall a. a -> Maybe a
Just Expr
e) [Declaration]
cs
    RecordDef Range' SrcFile
_ Name
x [RecordDirective]
dir [LamBinding]
tel [Declaration]
cs ->
      Erased
-> Name
-> [RecordDirective]
-> [LamBinding]
-> Maybe Expr
-> [Declaration]
-> Doc Aspects
pRecord Erased
defaultErased Name
x [RecordDirective]
dir [LamBinding]
tel Maybe Expr
forall a. Maybe a
Nothing [Declaration]
cs
    Infix Fixity
f NonEmpty Name
xs  ->
      Fixity -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Fixity
f Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
fsep (Doc Aspects -> NonEmpty (Doc Aspects) -> [Doc Aspects]
forall (t :: * -> *).
Foldable t =>
Doc Aspects -> t (Doc Aspects) -> [Doc Aspects]
punctuate Doc Aspects
comma (NonEmpty (Doc Aspects) -> [Doc Aspects])
-> NonEmpty (Doc Aspects) -> [Doc Aspects]
forall a b. (a -> b) -> a -> b
$ (Name -> Doc Aspects) -> NonEmpty Name -> NonEmpty (Doc Aspects)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Name -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty NonEmpty Name
xs)
    Syntax Name
n [NotationPart]
_xs -> Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"syntax" Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Name -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Name
n Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Doc Aspects
"..."
    PatternSyn Range' SrcFile
_ Name
n [WithHiding Name]
as Pattern
p -> Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"pattern" Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Name -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Name
n Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
fsep ((WithHiding Name -> Doc Aspects)
-> [WithHiding Name] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map WithHiding Name -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [WithHiding Name]
as)
                             Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Doc Aspects
equals Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Pattern -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Pattern
p
    Mutual KwRange
_ [Declaration]
ds     -> [Char] -> [Declaration] -> Doc Aspects
forall {a}. Pretty a => [Char] -> [a] -> Doc Aspects
namedBlock [Char]
"mutual" [Declaration]
ds
    InterleavedMutual KwRange
_ [Declaration]
ds  -> [Char] -> [Declaration] -> Doc Aspects
forall {a}. Pretty a => [Char] -> [a] -> Doc Aspects
namedBlock [Char]
"interleaved mutual" [Declaration]
ds
    LoneConstructor KwRange
_ [Declaration]
ds -> [Char] -> [Declaration] -> Doc Aspects
forall {a}. Pretty a => [Char] -> [a] -> Doc Aspects
namedBlock [Char]
"data _ where" [Declaration]
ds
    Abstract KwRange
_ [Declaration]
ds   -> [Char] -> [Declaration] -> Doc Aspects
forall {a}. Pretty a => [Char] -> [a] -> Doc Aspects
namedBlock [Char]
"abstract" [Declaration]
ds
    Private KwRange
_ Origin
_ [Declaration]
ds  -> [Char] -> [Declaration] -> Doc Aspects
forall {a}. Pretty a => [Char] -> [a] -> Doc Aspects
namedBlock [Char]
"private" [Declaration]
ds
    InstanceB KwRange
_ [Declaration]
ds  -> [Char] -> [Declaration] -> Doc Aspects
forall {a}. Pretty a => [Char] -> [a] -> Doc Aspects
namedBlock [Char]
"instance" [Declaration]
ds
    Macro KwRange
_ [Declaration]
ds      -> [Char] -> [Declaration] -> Doc Aspects
forall {a}. Pretty a => [Char] -> [a] -> Doc Aspects
namedBlock [Char]
"macro" [Declaration]
ds
    Postulate KwRange
_ [Declaration]
ds  -> [Char] -> [Declaration] -> Doc Aspects
forall {a}. Pretty a => [Char] -> [a] -> Doc Aspects
namedBlock [Char]
"postulate" [Declaration]
ds
    Primitive KwRange
_ [Declaration]
ds  -> [Char] -> [Declaration] -> Doc Aspects
forall {a}. Pretty a => [Char] -> [a] -> Doc Aspects
namedBlock [Char]
"primitive" [Declaration]
ds
    Generalize KwRange
_ [Declaration]
ds -> [Char] -> [Declaration] -> Doc Aspects
forall {a}. Pretty a => [Char] -> [a] -> Doc Aspects
namedBlock [Char]
"variable" [Declaration]
ds
    Opaque KwRange
_ [Declaration]
ds     -> [Char] -> [Declaration] -> Doc Aspects
forall {a}. Pretty a => [Char] -> [a] -> Doc Aspects
namedBlock [Char]
"opaque" [Declaration]
ds
    Unfolding KwRange
_ [QName]
rs  -> Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"unfolding" Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Doc Aspects -> Doc Aspects
braces ([Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
fsep (Doc Aspects -> [Doc Aspects] -> [Doc Aspects]
forall (t :: * -> *).
Foldable t =>
Doc Aspects -> t (Doc Aspects) -> [Doc Aspects]
punctuate Doc Aspects
semi (QName -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty (QName -> Doc Aspects) -> [QName] -> [Doc Aspects]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [QName]
rs)))
    Module Range' SrcFile
_ Erased
erased QName
x [TypedBinding]
tel [Declaration]
ds ->
      [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
hsep [ Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"module"
           , Erased -> Doc Aspects -> Doc Aspects
prettyErased Erased
erased (QName -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty QName
x)
           , [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
fsep ((TypedBinding -> Doc Aspects) -> [TypedBinding] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map TypedBinding -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [TypedBinding]
tel)
           , Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"where"
           ] Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
$$ Int -> Doc Aspects -> Doc Aspects
forall a. Int -> Doc a -> Doc a
nest Int
2 ([Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
vcat ([Doc Aspects] -> Doc Aspects) -> [Doc Aspects] -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ (Declaration -> Doc Aspects) -> [Declaration] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map Declaration -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [Declaration]
ds)
    ModuleMacro Range' SrcFile
_ NotErased{} Name
x (SectionApp Range' SrcFile
_ [] QName
y [Expr]
es) doOpen :: OpenShortHand
doOpen@(DoOpen KwRange
_kwr) ImportDirective' Name Name
i
      | Name -> Bool
forall a. IsNoName a => a -> Bool
isNoName Name
x ->
      [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep [ OpenShortHand -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty OpenShortHand
doOpen
          , Int -> Doc Aspects -> Doc Aspects
forall a. Int -> Doc a -> Doc a
nest Int
2 (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
fsep ([Doc Aspects] -> Doc Aspects) -> [Doc Aspects] -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ QName -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty QName
y Doc Aspects -> [Doc Aspects] -> [Doc Aspects]
forall a. a -> [a] -> [a]
: (Expr -> Doc Aspects) -> [Expr] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [Expr]
es
          , Int -> Doc Aspects -> Doc Aspects
forall a. Int -> Doc a -> Doc a
nest Int
4 (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ ImportDirective' Name Name -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty ImportDirective' Name Name
i
          ]
    ModuleMacro Range' SrcFile
_ Erased
erased Name
x (SectionApp Range' SrcFile
_ [TypedBinding]
tel QName
y [Expr]
es) OpenShortHand
open ImportDirective' Name Name
i ->
      [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep [ OpenShortHand -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty OpenShortHand
open Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"module" Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+>
            Erased -> Doc Aspects -> Doc Aspects
prettyErased Erased
erased (Name -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Name
x) Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
fsep ((TypedBinding -> Doc Aspects) -> [TypedBinding] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map TypedBinding -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [TypedBinding]
tel)
          , Int -> Doc Aspects -> Doc Aspects
forall a. Int -> Doc a -> Doc a
nest Int
2 (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
fsep ([Doc Aspects] -> Doc Aspects) -> [Doc Aspects] -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ [[Doc Aspects]] -> [Doc Aspects]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [ Doc Aspects
equals, QName -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty QName
y ], (Expr -> Doc Aspects) -> [Expr] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [Expr]
es, [ ImportDirective' Name Name -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty ImportDirective' Name Name
i ] ]
          ]
    ModuleMacro Range' SrcFile
_ Erased
erased Name
x (RecordModuleInstance Range' SrcFile
_ QName
rec) OpenShortHand
open ImportDirective' Name Name
_i ->
      [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep [ OpenShortHand -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty OpenShortHand
open Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"module" Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Erased -> Doc Aspects -> Doc Aspects
prettyErased Erased
erased (Name -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Name
x)
          , Int -> Doc Aspects -> Doc Aspects
forall a. Int -> Doc a -> Doc a
nest Int
2 (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ Doc Aspects
equals Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> QName -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty QName
rec Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Doc Aspects
"{{...}}"
          ]
    Open KwRange
_ QName
x ImportDirective' Name Name
i  -> [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
hsep [ Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"open", QName -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty QName
x, ImportDirective' Name Name -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty ImportDirective' Name Name
i ]
    Import OpenShortHand
open KwRange
_ QName
x Either AsName [Expr]
rn ImportDirective' Name Name
i   ->
      [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
hsep [ OpenShortHand -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty OpenShortHand
open, Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"import", QName -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty QName
x, Either AsName [Expr] -> Doc Aspects
forall {a} {a}.
(Pretty a, Pretty a) =>
Either (AsName' a) [a] -> Doc Aspects
as Either AsName [Expr]
rn, ImportDirective' Name Name -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty ImportDirective' Name Name
i ]
      where
        as :: Either (AsName' a) [a] -> Doc Aspects
as (Left AsName' a
x) = Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"as" Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> a -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty (AsName' a -> a
forall a. AsName' a -> a
asName AsName' a
x)
        as (Right [a]
args) = [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
fsep ((a -> Doc Aspects) -> [a] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [a]
args)
    UnquoteDecl Range' SrcFile
_ [Name]
xs Expr
t ->
      [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep [ Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"unquoteDecl" Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
fsep ((Name -> Doc Aspects) -> [Name] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [Name]
xs) Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Doc Aspects
equals, Int -> Doc Aspects -> Doc Aspects
forall a. Int -> Doc a -> Doc a
nest Int
2 (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ Expr -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Expr
t ]
    UnquoteDef Range' SrcFile
_ [Name]
xs Expr
t ->
      [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep [ Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"unquoteDef" Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
fsep ((Name -> Doc Aspects) -> [Name] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [Name]
xs) Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Doc Aspects
equals, Int -> Doc Aspects -> Doc Aspects
forall a. Int -> Doc a -> Doc a
nest Int
2 (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ Expr -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Expr
t ]
    UnquoteData Range' SrcFile
_ Name
x [Name]
xs Expr
t ->
      [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep [ Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"unquoteData" Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Name -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Name
x Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
fsep ((Name -> Doc Aspects) -> [Name] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [Name]
xs) Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Doc Aspects
equals, Int -> Doc Aspects -> Doc Aspects
forall a. Int -> Doc a -> Doc a
nest Int
2 (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ Expr -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Expr
t ]
    Pragma Pragma
pr   -> [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep [ Doc Aspects
"{-#" Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Pragma -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Pragma
pr, Doc Aspects
"#-}" ]
    where
      namedBlock :: [Char] -> [a] -> Doc Aspects
namedBlock [Char]
s [a]
ds =
          [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep [ Doc Aspects -> Doc Aspects
hlKeyword ([Char] -> Doc Aspects
forall a. [Char] -> Doc a
text [Char]
s)
              , Int -> Doc Aspects -> Doc Aspects
forall a. Int -> Doc a -> Doc a
nest Int
2 (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
vcat ([Doc Aspects] -> Doc Aspects) -> [Doc Aspects] -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ (a -> Doc Aspects) -> [a] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [a]
ds
              ]

pHasEta0 :: HasEta0 -> Doc
pHasEta0 :: HasEta0 -> Doc Aspects
pHasEta0 = \case
  HasEta0
YesEta   -> Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"eta-equality"
  NoEta () -> Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"no-eta-equality"

instance Pretty RecordDirective where
  pretty :: RecordDirective -> Doc Aspects
pretty = RecordDirective -> Doc Aspects
pRecordDirective

pRecordDirective :: RecordDirective -> Doc
pRecordDirective :: RecordDirective -> Doc Aspects
pRecordDirective = \case
  Induction Ranged Induction
ind -> Induction -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty (Ranged Induction -> Induction
forall a. Ranged a -> a
rangedThing Ranged Induction
ind)
  Constructor Name
n IsInstance
inst -> [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
hsep [ Doc Aspects
pInst, Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"constructor", Name -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Name
n ] where
    pInst :: Doc Aspects
pInst = case IsInstance
inst of
      InstanceDef{} -> Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"instance"
      NotInstanceDef{} -> Doc Aspects
forall a. Null a => a
empty
  Eta Ranged HasEta0
eta -> HasEta0 -> Doc Aspects
pHasEta0 (Ranged HasEta0 -> HasEta0
forall a. Ranged a -> a
rangedThing Ranged HasEta0
eta)
  PatternOrCopattern{} -> Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"pattern"

pRecord
  :: Erased
  -> Name
  -> [RecordDirective]
  -> Parameters
  -> Maybe Expr
  -> [Declaration]
  -> Doc
pRecord :: Erased
-> Name
-> [RecordDirective]
-> [LamBinding]
-> Maybe Expr
-> [Declaration]
-> Doc Aspects
pRecord Erased
erased Name
x [RecordDirective]
directives [LamBinding]
tel Maybe Expr
me [Declaration]
ds = [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
vcat
    [ [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep
      [ [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
hsep  [ Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"record"
              , Erased -> Doc Aspects -> Doc Aspects
prettyErased Erased
erased (Name -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Name
x)
              , [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
fsep ((LamBinding -> Doc Aspects) -> [LamBinding] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map LamBinding -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [LamBinding]
tel)
              ]
      , Int -> Doc Aspects -> Doc Aspects
forall a. Int -> Doc a -> Doc a
nest Int
2 (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ Maybe Expr -> Doc Aspects
forall {a}. Pretty a => Maybe a -> Doc Aspects
pType Maybe Expr
me
      ]
    , Int -> Doc Aspects -> Doc Aspects
forall a. Int -> Doc a -> Doc a
nest Int
2 (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
vcat ([Doc Aspects] -> Doc Aspects) -> [Doc Aspects] -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ [[Doc Aspects]] -> [Doc Aspects]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [ (RecordDirective -> Doc Aspects)
-> [RecordDirective] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map RecordDirective -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [RecordDirective]
directives
      , (Declaration -> Doc Aspects) -> [Declaration] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map Declaration -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [Declaration]
ds
      ]
    ]
  where
    pType :: Maybe a -> Doc Aspects
pType (Just a
e) = [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
hsep [ Doc Aspects
colon, a -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty a
e, Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"where" ]
    pType Maybe a
Nothing  = Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"where"

instance Pretty OpenShortHand where
    pretty :: OpenShortHand -> Doc Aspects
pretty = \case
      DoOpen KwRange
_ -> Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"open"
      OpenShortHand
DontOpen -> Doc Aspects
forall a. Null a => a
empty

instance Pretty Pragma where
    pretty :: Pragma -> Doc Aspects
pretty (OptionsPragma Range' SrcFile
_ [[Char]]
opts)  = [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
fsep ([Doc Aspects] -> Doc Aspects) -> [Doc Aspects] -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"OPTIONS" Doc Aspects -> [Doc Aspects] -> [Doc Aspects]
forall a. a -> [a] -> [a]
: ([Char] -> Doc Aspects) -> [[Char]] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map (Doc Aspects -> Doc Aspects
hlPragma (Doc Aspects -> Doc Aspects)
-> ([Char] -> Doc Aspects) -> [Char] -> Doc Aspects
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Doc Aspects
forall a. [Char] -> Doc a
text) [[Char]]
opts
    pretty (BuiltinPragma Range' SrcFile
_ Ranged [Char]
b QName
x)   = [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
hsep [ Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"BUILTIN", Doc Aspects -> Doc Aspects
hlPragma ([Char] -> Doc Aspects
forall a. [Char] -> Doc a
text (Ranged [Char] -> [Char]
forall a. Ranged a -> a
rangedThing Ranged [Char]
b)), QName -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty QName
x ]
    pretty (RewritePragma Range' SrcFile
_ Range' SrcFile
_ [QName]
xs)    =
      [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
hsep [ Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"REWRITE", [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
hsep ([Doc Aspects] -> Doc Aspects) -> [Doc Aspects] -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ (QName -> Doc Aspects) -> [QName] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map QName -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [QName]
xs ]
    pretty (CompilePragma Range' SrcFile
_ Ranged BackendName
b QName
x [Char]
e) =
      [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
hsep [ Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"COMPILE", BackendName -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty (Ranged BackendName -> BackendName
forall a. Ranged a -> a
rangedThing Ranged BackendName
b), QName -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty QName
x, [Char] -> Doc Aspects
textNonEmpty [Char]
e ]
    pretty (ForeignPragma Range' SrcFile
_ Ranged BackendName
b [Char]
s) =
      [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
vcat ([Doc Aspects] -> Doc Aspects) -> [Doc Aspects] -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
hsep [ Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"FOREIGN", BackendName -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty (Ranged BackendName -> BackendName
forall a. Ranged a -> a
rangedThing Ranged BackendName
b) ] Doc Aspects -> [Doc Aspects] -> [Doc Aspects]
forall a. a -> [a] -> [a]
: ([Char] -> Doc Aspects) -> [[Char]] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Doc Aspects
forall a. [Char] -> Doc a
text ([Char] -> [[Char]]
lines [Char]
s)
    pretty (StaticPragma Range' SrcFile
_ QName
i) =
      [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
hsep ([Doc Aspects] -> Doc Aspects) -> [Doc Aspects] -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ [Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"STATIC", QName -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty QName
i]
    pretty (InjectivePragma Range' SrcFile
_ QName
i) =
      [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
hsep ([Doc Aspects] -> Doc Aspects) -> [Doc Aspects] -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ [Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"INJECTIVE", QName -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty QName
i]
    pretty (InjectiveForInferencePragma Range' SrcFile
_ QName
i) =
      [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
hsep ([Doc Aspects] -> Doc Aspects) -> [Doc Aspects] -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ [Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"INJECTIVE_FOR_INFERENCE", QName -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty QName
i]
    pretty (InlinePragma Range' SrcFile
_ Bool
True QName
i) =
      [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
hsep ([Doc Aspects] -> Doc Aspects) -> [Doc Aspects] -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ [Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"INLINE", QName -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty QName
i]
    pretty (NotProjectionLikePragma Range' SrcFile
_ QName
i) =
      [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
hsep ([Doc Aspects] -> Doc Aspects) -> [Doc Aspects] -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ [Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"NOT_PROJECTION_LIKE", QName -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty QName
i]
    pretty (InlinePragma Range' SrcFile
_ Bool
False QName
i) =
      [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
hsep ([Doc Aspects] -> Doc Aspects) -> [Doc Aspects] -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ [Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"NOINLINE", QName -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty QName
i]
    pretty (ImpossiblePragma Range' SrcFile
_ [[Char]]
strs) =
      [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
hsep ([Doc Aspects] -> Doc Aspects) -> [Doc Aspects] -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ [Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"IMPOSSIBLE"] [Doc Aspects] -> [Doc Aspects] -> [Doc Aspects]
forall a. [a] -> [a] -> [a]
++ ([Char] -> Doc Aspects) -> [[Char]] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Doc Aspects
forall a. [Char] -> Doc a
text [[Char]]
strs
    pretty (EtaPragma Range' SrcFile
_ QName
x) =
      [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
hsep ([Doc Aspects] -> Doc Aspects) -> [Doc Aspects] -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ [Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"ETA", QName -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty QName
x]
    pretty (EtaEqualityPragma Range' SrcFile
_) =
      [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
hsep ([Doc Aspects] -> Doc Aspects) -> [Doc Aspects] -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ [Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"ETA_EQUALITY"]
    pretty (TerminationCheckPragma Range' SrcFile
_ TerminationCheck Name
tc) =
      case TerminationCheck Name
tc of
        TerminationCheck Name
TerminationCheck       -> Doc Aspects
forall a. HasCallStack => a
__IMPOSSIBLE__
        TerminationCheck Name
NoTerminationCheck     -> Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"NO_TERMINATION_CHECK"
        TerminationCheck Name
NonTerminating         -> Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"NON_TERMINATING"
        TerminationCheck Name
Terminating            -> Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"TERMINATING"
        TerminationMeasure Range' SrcFile
_ Name
x -> [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
hsep ([Doc Aspects] -> Doc Aspects) -> [Doc Aspects] -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ [Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"MEASURE", Name -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Name
x]
    pretty (NoCoverageCheckPragma Range' SrcFile
_) = Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"NON_COVERING"
    pretty (WarningOnUsage Range' SrcFile
_ QName
nm BackendName
str) = [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
hsep [ Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"WARNING_ON_USAGE", QName -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty QName
nm, Doc Aspects -> Doc Aspects
hlPragma ([Char] -> Doc Aspects
forall a. [Char] -> Doc a
text (BackendName -> [Char]
forall a. Show a => a -> [Char]
show BackendName
str)) ]
    pretty (WarningOnImport Range' SrcFile
_ BackendName
str)   = [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
hsep [ Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"WARNING_ON_IMPORT", Doc Aspects -> Doc Aspects
hlPragma ([Char] -> Doc Aspects
forall a. [Char] -> Doc a
text (BackendName -> [Char]
forall a. Show a => a -> [Char]
show BackendName
str)) ]
    pretty (CatchallPragma Range' SrcFile
_) = Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"CATCHALL"
    pretty (DisplayPragma Range' SrcFile
_ Pattern
lhs Expr
rhs) = Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"DISPLAY" Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep [ Pattern -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Pattern
lhs Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Doc Aspects
equals, Int -> Doc Aspects -> Doc Aspects
forall a. Int -> Doc a -> Doc a
nest Int
2 (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ Expr -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Expr
rhs ]
    pretty (NoPositivityCheckPragma Range' SrcFile
_) = Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"NO_POSITIVITY_CHECK"
    pretty (PolarityPragma Range' SrcFile
_ Name
q [Ranged Occurrence]
occs) =
      [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
hsep (Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"POLARITY" Doc Aspects -> [Doc Aspects] -> [Doc Aspects]
forall a. a -> [a] -> [a]
: Name -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Name
q Doc Aspects -> [Doc Aspects] -> [Doc Aspects]
forall a. a -> [a] -> [a]
: (Ranged Occurrence -> Doc Aspects)
-> [Ranged Occurrence] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map Ranged Occurrence -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [Ranged Occurrence]
occs)
    pretty (NoUniverseCheckPragma Range' SrcFile
_) = Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"NO_UNIVERSE_CHECK"
    pretty (OverlapPragma Range' SrcFile
_ [QName]
x OverlapMode
m) = [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
hsep [OverlapMode -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty OverlapMode
m, [QName] -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [QName]
x]

instance Pretty Pattern where
    prettyList :: [Pattern] -> Doc Aspects
prettyList = [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
fsep ([Doc Aspects] -> Doc Aspects)
-> ([Pattern] -> [Doc Aspects]) -> [Pattern] -> Doc Aspects
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pattern -> Doc Aspects) -> [Pattern] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map Pattern -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty
    pretty :: Pattern -> Doc Aspects
pretty = \case
            IdentP Bool
_ QName
x      -> QName -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty QName
x
            AppP Pattern
p1 Arg (Named_ Pattern)
p2      -> [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep [ Pattern -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Pattern
p1, Int -> Doc Aspects -> Doc Aspects
forall a. Int -> Doc a -> Doc a
nest Int
2 (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ Arg (Named_ Pattern) -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Arg (Named_ Pattern)
p2 ]
            RawAppP Range' SrcFile
_ List2 Pattern
ps    -> [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
fsep ([Doc Aspects] -> Doc Aspects) -> [Doc Aspects] -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ (Pattern -> Doc Aspects) -> [Pattern] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map Pattern -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty ([Pattern] -> [Doc Aspects]) -> [Pattern] -> [Doc Aspects]
forall a b. (a -> b) -> a -> b
$ List2 Pattern -> [Item (List2 Pattern)]
forall l. IsList l => l -> [Item l]
List2.toList List2 Pattern
ps
            OpAppP Range' SrcFile
_ QName
q NESet Name
_ NonEmpty (Arg (Named_ Pattern))
ps -> [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
fsep ([Doc Aspects] -> Doc Aspects) -> [Doc Aspects] -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ Aspects
-> QName
-> List1 (NamedArg (MaybePlaceholder Pattern))
-> [Doc Aspects]
forall a.
Pretty a =>
Aspects
-> QName -> List1 (NamedArg (MaybePlaceholder a)) -> [Doc Aspects]
prettyOpApp Aspects
forall a. Null a => a
empty QName
q (List1 (NamedArg (MaybePlaceholder Pattern)) -> [Doc Aspects])
-> List1 (NamedArg (MaybePlaceholder Pattern)) -> [Doc Aspects]
forall a b. (a -> b) -> a -> b
$ (Arg (Named_ Pattern) -> NamedArg (MaybePlaceholder Pattern))
-> NonEmpty (Arg (Named_ Pattern))
-> List1 (NamedArg (MaybePlaceholder Pattern))
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Named_ Pattern -> Named_ (MaybePlaceholder Pattern))
-> Arg (Named_ Pattern) -> NamedArg (MaybePlaceholder Pattern)
forall a b. (a -> b) -> Arg a -> Arg b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Pattern -> MaybePlaceholder Pattern)
-> Named_ Pattern -> Named_ (MaybePlaceholder Pattern)
forall a b. (a -> b) -> Named NamedName a -> Named NamedName b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe PositionInName -> Pattern -> MaybePlaceholder Pattern
forall e. Maybe PositionInName -> e -> MaybePlaceholder e
NoPlaceholder Maybe PositionInName
forall a. Maybe a
Strict.Nothing))) NonEmpty (Arg (Named_ Pattern))
ps
            HiddenP Range' SrcFile
_ Named_ Pattern
p     -> Doc Aspects -> Doc Aspects
braces' (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ Named_ Pattern -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Named_ Pattern
p
            InstanceP Range' SrcFile
_ Named_ Pattern
p   -> Doc Aspects -> Doc Aspects
dbraces (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ Named_ Pattern -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Named_ Pattern
p
            ParenP Range' SrcFile
_ Pattern
p      -> Doc Aspects -> Doc Aspects
parens (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ Pattern -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Pattern
p
            WildP Range' SrcFile
_         -> Doc Aspects
forall a. Underscore a => a
underscore
            AsP Range' SrcFile
_ Name
x Pattern
p       -> Name -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Name
x Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Semigroup a => a -> a -> a
<> Doc Aspects -> Doc Aspects
hlSymbol Doc Aspects
"@" Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Semigroup a => a -> a -> a
<> Pattern -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Pattern
p
            DotP KwRange
_ Range' SrcFile
_ PossiblyProjectionPattern
_ Expr
p    -> Doc Aspects
"." Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Semigroup a => a -> a -> a
<> Expr -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Expr
p
            AbsurdP Range' SrcFile
_       -> Doc Aspects
"()"
            LitP Range' SrcFile
_ Literal
l        -> Literal -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Literal
l
            QuoteP Range' SrcFile
_        -> Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"quote"
            RecP KwRange
_ Range' SrcFile
_ [FieldAssignment' Pattern]
fs     -> [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep [ Doc Aspects -> Doc Aspects
hlKeyword Doc Aspects
"record", [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
bracesAndSemicolons ((FieldAssignment' Pattern -> Doc Aspects)
-> [FieldAssignment' Pattern] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map FieldAssignment' Pattern -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [FieldAssignment' Pattern]
fs) ]
            EqualP Range' SrcFile
_ NonEmpty (Expr, Expr)
es     -> NonEmpty (Doc Aspects) -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep (NonEmpty (Doc Aspects) -> Doc Aspects)
-> NonEmpty (Doc Aspects) -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ NonEmpty (Expr, Expr)
-> ((Expr, Expr) -> Doc Aspects) -> NonEmpty (Doc Aspects)
forall (m :: * -> *) a b. Functor m => m a -> (a -> b) -> m b
for NonEmpty (Expr, Expr)
es \ (Expr
e1, Expr
e2) -> Doc Aspects -> Doc Aspects
parens (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
sep [Expr -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Expr
e1, Doc Aspects
equals, Expr -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Expr
e2]
            EllipsisP Range' SrcFile
_ Maybe Pattern
_   -> Doc Aspects
"..."
            WithP Range' SrcFile
_ Pattern
p       -> Doc Aspects
"|" Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Doc a -> Doc a -> Doc a
<+> Pattern -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Pattern
p

prettyOpApp :: forall a .
  Pretty a => Asp.Aspects -> QName -> List1 (NamedArg (MaybePlaceholder a)) -> [Doc]
prettyOpApp :: forall a.
Pretty a =>
Aspects
-> QName -> List1 (NamedArg (MaybePlaceholder a)) -> [Doc Aspects]
prettyOpApp Aspects
asp QName
q NonEmpty (Arg (Named_ (MaybePlaceholder a)))
es = [Doc Aspects]
-> [(Doc Aspects, Maybe PositionInName)] -> [Doc Aspects]
merge [] ([(Doc Aspects, Maybe PositionInName)] -> [Doc Aspects])
-> [(Doc Aspects, Maybe PositionInName)] -> [Doc Aspects]
forall a b. (a -> b) -> a -> b
$ [Name]
-> [NamePart]
-> [Arg (Named_ (MaybePlaceholder a))]
-> [(Doc Aspects, Maybe PositionInName)]
prOp [Name]
ms [Item (NonEmpty NamePart)]
[NamePart]
xs ([Arg (Named_ (MaybePlaceholder a))]
 -> [(Doc Aspects, Maybe PositionInName)])
-> [Arg (Named_ (MaybePlaceholder a))]
-> [(Doc Aspects, Maybe PositionInName)]
forall a b. (a -> b) -> a -> b
$ NonEmpty (Arg (Named_ (MaybePlaceholder a)))
-> [Item (NonEmpty (Arg (Named_ (MaybePlaceholder a))))]
forall l. IsList l => l -> [Item l]
List1.toList NonEmpty (Arg (Named_ (MaybePlaceholder a)))
es
  where
    -- ms: the module part of the name.
    ms :: [Name]
ms = NonEmpty Name -> [Name]
forall a. NonEmpty a -> [a]
List1.init (QName -> NonEmpty Name
qnameParts QName
q)
    -- xs: the concrete name (alternation of @Id@ and @Hole@)
    xs :: [Item (NonEmpty NamePart)]
xs = case QName -> Name
unqualify QName
q of
           Name Range' SrcFile
_ NameInScope
_ NonEmpty NamePart
xs    -> NonEmpty NamePart -> [Item (NonEmpty NamePart)]
forall l. IsList l => l -> [Item l]
List1.toList NonEmpty NamePart
xs
           NoName{}       -> [Item (NonEmpty NamePart)]
[NamePart]
forall a. HasCallStack => a
__IMPOSSIBLE__

    prOp :: [Name] -> [NamePart] -> [NamedArg (MaybePlaceholder a)] -> [(Doc, Maybe PositionInName)]
    prOp :: [Name]
-> [NamePart]
-> [Arg (Named_ (MaybePlaceholder a))]
-> [(Doc Aspects, Maybe PositionInName)]
prOp [Name]
ms (NamePart
Hole : [NamePart]
xs) (Arg (Named_ (MaybePlaceholder a))
e : [Arg (Named_ (MaybePlaceholder a))]
es) =
      case Arg (Named_ (MaybePlaceholder a)) -> MaybePlaceholder a
forall a. NamedArg a -> a
namedArg Arg (Named_ (MaybePlaceholder a))
e of
        Placeholder PositionInName
p   -> ([Name] -> Doc Aspects -> Doc Aspects
forall {a}. Pretty a => [a] -> Doc Aspects -> Doc Aspects
qual [Name]
ms (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ Arg (Named_ (MaybePlaceholder a)) -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Arg (Named_ (MaybePlaceholder a))
e, PositionInName -> Maybe PositionInName
forall a. a -> Maybe a
Just PositionInName
p) (Doc Aspects, Maybe PositionInName)
-> [(Doc Aspects, Maybe PositionInName)]
-> [(Doc Aspects, Maybe PositionInName)]
forall a. a -> [a] -> [a]
: [Name]
-> [NamePart]
-> [Arg (Named_ (MaybePlaceholder a))]
-> [(Doc Aspects, Maybe PositionInName)]
prOp [] [NamePart]
xs [Arg (Named_ (MaybePlaceholder a))]
es
        NoPlaceholder{} -> (Arg (Named_ (MaybePlaceholder a)) -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Arg (Named_ (MaybePlaceholder a))
e, Maybe PositionInName
forall a. Maybe a
Nothing) (Doc Aspects, Maybe PositionInName)
-> [(Doc Aspects, Maybe PositionInName)]
-> [(Doc Aspects, Maybe PositionInName)]
forall a. a -> [a] -> [a]
: [Name]
-> [NamePart]
-> [Arg (Named_ (MaybePlaceholder a))]
-> [(Doc Aspects, Maybe PositionInName)]
prOp [Name]
ms [NamePart]
xs [Arg (Named_ (MaybePlaceholder a))]
es
          -- Module qualifier needs to go on section holes (#3072)
    prOp [Name]
_  (NamePart
Hole : [NamePart]
_)  []       = [(Doc Aspects, Maybe PositionInName)]
forall a. HasCallStack => a
__IMPOSSIBLE__
    prOp [Name]
ms (Id [Char]
x : [NamePart]
xs) [Arg (Named_ (MaybePlaceholder a))]
es       = ( [Name] -> Doc Aspects -> Doc Aspects
forall {a}. Pretty a => [a] -> Doc Aspects -> Doc Aspects
qual [Name]
ms (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ Aspects -> Doc Aspects -> Doc Aspects
annotate Aspects
asp (Doc Aspects -> Doc Aspects) -> Doc Aspects -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ Name -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty (Name -> Doc Aspects) -> Name -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ [Char] -> Name
simpleName [Char]
x
                                   , Maybe PositionInName
forall a. Maybe a
Nothing
                                   ) (Doc Aspects, Maybe PositionInName)
-> [(Doc Aspects, Maybe PositionInName)]
-> [(Doc Aspects, Maybe PositionInName)]
forall a. a -> [a] -> [a]
: [Name]
-> [NamePart]
-> [Arg (Named_ (MaybePlaceholder a))]
-> [(Doc Aspects, Maybe PositionInName)]
prOp [] [NamePart]
xs [Arg (Named_ (MaybePlaceholder a))]
es
      -- Qualify the name part with the module.
      -- We then clear @ms@ such that the following name parts will not be qualified.

    prOp [Name]
_  []       [Arg (Named_ (MaybePlaceholder a))]
es          = (Arg (Named_ (MaybePlaceholder a))
 -> (Doc Aspects, Maybe PositionInName))
-> [Arg (Named_ (MaybePlaceholder a))]
-> [(Doc Aspects, Maybe PositionInName)]
forall a b. (a -> b) -> [a] -> [b]
map (\Arg (Named_ (MaybePlaceholder a))
e -> (Arg (Named_ (MaybePlaceholder a)) -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty Arg (Named_ (MaybePlaceholder a))
e, Maybe PositionInName
forall a. Maybe a
Nothing)) [Arg (Named_ (MaybePlaceholder a))]
es

    qual :: [a] -> Doc Aspects -> Doc Aspects
qual [a]
ms Doc Aspects
doc = [Doc Aspects] -> Doc Aspects
forall (t :: * -> *). Foldable t => t (Doc Aspects) -> Doc Aspects
hcat ([Doc Aspects] -> Doc Aspects) -> [Doc Aspects] -> Doc Aspects
forall a b. (a -> b) -> a -> b
$ Doc Aspects -> [Doc Aspects] -> [Doc Aspects]
forall (t :: * -> *).
Foldable t =>
Doc Aspects -> t (Doc Aspects) -> [Doc Aspects]
punctuate Doc Aspects
"." ([Doc Aspects] -> [Doc Aspects]) -> [Doc Aspects] -> [Doc Aspects]
forall a b. (a -> b) -> a -> b
$ (a -> Doc Aspects) -> [a] -> [Doc Aspects]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc Aspects
forall a. Pretty a => a -> Doc Aspects
pretty [a]
ms [Doc Aspects] -> [Doc Aspects] -> [Doc Aspects]
forall a. [a] -> [a] -> [a]
++ [Doc Aspects
doc]

    -- Section underscores should be printed without surrounding
    -- whitespace. This function takes care of that.
    merge :: [Doc] -> [(Doc, Maybe PositionInName)] -> [Doc]
    merge :: [Doc Aspects]
-> [(Doc Aspects, Maybe PositionInName)] -> [Doc Aspects]
merge [Doc Aspects]
before []                            = [Doc Aspects] -> [Doc Aspects]
forall a. [a] -> [a]
reverse [Doc Aspects]
before
    merge [Doc Aspects]
before ((Doc Aspects
d, Maybe PositionInName
Nothing) : [(Doc Aspects, Maybe PositionInName)]
after)        = [Doc Aspects]
-> [(Doc Aspects, Maybe PositionInName)] -> [Doc Aspects]
merge (Doc Aspects
d Doc Aspects -> [Doc Aspects] -> [Doc Aspects]
forall a. a -> [a] -> [a]
: [Doc Aspects]
before) [(Doc Aspects, Maybe PositionInName)]
after
    merge [Doc Aspects]
before ((Doc Aspects
d, Just PositionInName
Beginning) : [(Doc Aspects, Maybe PositionInName)]
after) = [Doc Aspects]
-> Doc Aspects
-> [(Doc Aspects, Maybe PositionInName)]
-> [Doc Aspects]
mergeRight [Doc Aspects]
before Doc Aspects
d [(Doc Aspects, Maybe PositionInName)]
after
    merge [Doc Aspects]
before ((Doc Aspects
d, Just PositionInName
End)       : [(Doc Aspects, Maybe PositionInName)]
after) = case Doc Aspects -> [Doc Aspects] -> (Doc Aspects, [Doc Aspects])
forall {a}. Semigroup a => a -> [a] -> (a, [a])
mergeLeft Doc Aspects
d [Doc Aspects]
before of
                                                   (Doc Aspects
d, [Doc Aspects]
bs) -> [Doc Aspects]
-> [(Doc Aspects, Maybe PositionInName)] -> [Doc Aspects]
merge (Doc Aspects
d Doc Aspects -> [Doc Aspects] -> [Doc Aspects]
forall a. a -> [a] -> [a]
: [Doc Aspects]
bs) [(Doc Aspects, Maybe PositionInName)]
after
    merge [Doc Aspects]
before ((Doc Aspects
d, Just PositionInName
Middle)    : [(Doc Aspects, Maybe PositionInName)]
after) = case Doc Aspects -> [Doc Aspects] -> (Doc Aspects, [Doc Aspects])
forall {a}. Semigroup a => a -> [a] -> (a, [a])
mergeLeft Doc Aspects
d [Doc Aspects]
before of
                                                   (Doc Aspects
d, [Doc Aspects]
bs) -> [Doc Aspects]
-> Doc Aspects
-> [(Doc Aspects, Maybe PositionInName)]
-> [Doc Aspects]
mergeRight [Doc Aspects]
bs Doc Aspects
d [(Doc Aspects, Maybe PositionInName)]
after

    mergeRight :: [Doc Aspects]
-> Doc Aspects
-> [(Doc Aspects, Maybe PositionInName)]
-> [Doc Aspects]
mergeRight [Doc Aspects]
before Doc Aspects
d [(Doc Aspects, Maybe PositionInName)]
after =
      [Doc Aspects] -> [Doc Aspects]
forall a. [a] -> [a]
reverse [Doc Aspects]
before [Doc Aspects] -> [Doc Aspects] -> [Doc Aspects]
forall a. [a] -> [a] -> [a]
++
      case [Doc Aspects]
-> [(Doc Aspects, Maybe PositionInName)] -> [Doc Aspects]
merge [] [(Doc Aspects, Maybe PositionInName)]
after of
        []     -> [Doc Aspects
d]
        Doc Aspects
a : [Doc Aspects]
as -> (Doc Aspects
d Doc Aspects -> Doc Aspects -> Doc Aspects
forall a. Semigroup a => a -> a -> a
<> Doc Aspects
a) Doc Aspects -> [Doc Aspects] -> [Doc Aspects]
forall a. a -> [a] -> [a]
: [Doc Aspects]
as

    mergeLeft :: a -> [a] -> (a, [a])
mergeLeft a
d [a]
before = case [a]
before of
      []     -> (a
d,      [])
      a
b : [a]
bs -> (a
b a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
d, [a]
bs)