module Unison.Syntax.DeclPrinter
  ( prettyDecl,
    prettyDeclW,
    prettyDeclHeader,
    prettyDeclOrBuiltinHeader,
    getFieldAndAccessorNames,
    AccessorName,
  )
where

import Control.Monad.Writer (Writer, runWriter, tell)
import Data.List.NonEmpty (pattern (:|))
import Data.Map qualified as Map
import Data.Set qualified as Set
import Data.Text qualified as Text
import Unison.ConstructorReference (ConstructorReference, GConstructorReference (..))
import Unison.ConstructorType qualified as CT
import Unison.DataDeclaration (DataDeclaration, EffectDeclaration, toDataDecl)
import Unison.DataDeclaration qualified as DD
import Unison.DataDeclaration.Dependencies qualified as DD
import Unison.HashQualified qualified as HQ
import Unison.Name (Name)
import Unison.Name qualified as Name
import Unison.NameSegment qualified as NameSegment
import Unison.Prelude
import Unison.PrettyPrintEnv (PrettyPrintEnv)
import Unison.PrettyPrintEnv qualified as PPE
import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl (..))
import Unison.PrettyPrintEnvDecl qualified as PPED
import Unison.Reference (Reference, TypeReference)
import Unison.Referent qualified as Referent
import Unison.Syntax.HashQualified qualified as HQ (toText)
import Unison.Syntax.Name qualified as Name
import Unison.Syntax.NamePrinter (prettyName, styleHashQualified'')
import Unison.Syntax.TypePrinter (runPretty)
import Unison.Syntax.TypePrinter qualified as TypePrinter
import Unison.Syntax.Var qualified as Var (namespaced)
import Unison.Type qualified as Type
import Unison.Util.Pretty (Pretty)
import Unison.Util.Pretty qualified as P
import Unison.Util.SyntaxText qualified as S
import Unison.Var (Var)
import Unison.Var qualified as Var (freshenId, name, named)

type SyntaxText = S.SyntaxText' Reference

type AccessorName = Name

prettyDeclW ::
  (Var v) =>
  PrettyPrintEnvDecl ->
  TypeReference ->
  HQ.HashQualified Name ->
  DD.Decl v a ->
  Writer (Set AccessorName) (Pretty SyntaxText)
prettyDeclW :: forall v a.
Var v =>
PrettyPrintEnvDecl
-> Reference
-> HashQualified Name
-> Decl v a
-> Writer (Set Name) (Pretty (SyntaxText' Reference))
prettyDeclW PrettyPrintEnvDecl
ppe Reference
r HashQualified Name
hq = \case
  Left EffectDeclaration v a
e -> Pretty (SyntaxText' Reference)
-> Writer (Set Name) (Pretty (SyntaxText' Reference))
forall a. a -> WriterT (Set Name) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty (SyntaxText' Reference)
 -> Writer (Set Name) (Pretty (SyntaxText' Reference)))
-> Pretty (SyntaxText' Reference)
-> Writer (Set Name) (Pretty (SyntaxText' Reference))
forall a b. (a -> b) -> a -> b
$ PrettyPrintEnvDecl
-> Reference
-> HashQualified Name
-> EffectDeclaration v a
-> Pretty (SyntaxText' Reference)
forall v a.
Var v =>
PrettyPrintEnvDecl
-> Reference
-> HashQualified Name
-> EffectDeclaration v a
-> Pretty (SyntaxText' Reference)
prettyEffectDecl PrettyPrintEnvDecl
ppe Reference
r HashQualified Name
hq EffectDeclaration v a
e
  Right DataDeclaration v a
dd -> PrettyPrintEnvDecl
-> Reference
-> HashQualified Name
-> DataDeclaration v a
-> Writer (Set Name) (Pretty (SyntaxText' Reference))
forall v a.
Var v =>
PrettyPrintEnvDecl
-> Reference
-> HashQualified Name
-> DataDeclaration v a
-> Writer (Set Name) (Pretty (SyntaxText' Reference))
prettyDataDecl PrettyPrintEnvDecl
ppe Reference
r HashQualified Name
hq DataDeclaration v a
dd

prettyDecl ::
  (Var v) =>
  PrettyPrintEnvDecl ->
  TypeReference ->
  HQ.HashQualified Name ->
  DD.Decl v a ->
  Pretty SyntaxText
prettyDecl :: forall v a.
Var v =>
PrettyPrintEnvDecl
-> Reference
-> HashQualified Name
-> Decl v a
-> Pretty (SyntaxText' Reference)
prettyDecl PrettyPrintEnvDecl
ppe Reference
r HashQualified Name
hq Decl v a
d = (Pretty (SyntaxText' Reference), Set Name)
-> Pretty (SyntaxText' Reference)
forall a b. (a, b) -> a
fst ((Pretty (SyntaxText' Reference), Set Name)
 -> Pretty (SyntaxText' Reference))
-> (Writer (Set Name) (Pretty (SyntaxText' Reference))
    -> (Pretty (SyntaxText' Reference), Set Name))
-> Writer (Set Name) (Pretty (SyntaxText' Reference))
-> Pretty (SyntaxText' Reference)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Writer (Set Name) (Pretty (SyntaxText' Reference))
-> (Pretty (SyntaxText' Reference), Set Name)
forall w a. Writer w a -> (a, w)
runWriter (Writer (Set Name) (Pretty (SyntaxText' Reference))
 -> Pretty (SyntaxText' Reference))
-> Writer (Set Name) (Pretty (SyntaxText' Reference))
-> Pretty (SyntaxText' Reference)
forall a b. (a -> b) -> a -> b
$ PrettyPrintEnvDecl
-> Reference
-> HashQualified Name
-> Decl v a
-> Writer (Set Name) (Pretty (SyntaxText' Reference))
forall v a.
Var v =>
PrettyPrintEnvDecl
-> Reference
-> HashQualified Name
-> Decl v a
-> Writer (Set Name) (Pretty (SyntaxText' Reference))
prettyDeclW PrettyPrintEnvDecl
ppe Reference
r HashQualified Name
hq Decl v a
d

prettyEffectDecl ::
  (Var v) =>
  PrettyPrintEnvDecl ->
  TypeReference ->
  HQ.HashQualified Name ->
  EffectDeclaration v a ->
  Pretty SyntaxText
prettyEffectDecl :: forall v a.
Var v =>
PrettyPrintEnvDecl
-> Reference
-> HashQualified Name
-> EffectDeclaration v a
-> Pretty (SyntaxText' Reference)
prettyEffectDecl PrettyPrintEnvDecl
ppe Reference
r HashQualified Name
name = PrettyPrintEnvDecl
-> ConstructorType
-> Reference
-> HashQualified Name
-> DataDeclaration v a
-> Pretty (SyntaxText' Reference)
forall v a.
Var v =>
PrettyPrintEnvDecl
-> ConstructorType
-> Reference
-> HashQualified Name
-> DataDeclaration v a
-> Pretty (SyntaxText' Reference)
prettyGADT PrettyPrintEnvDecl
ppe ConstructorType
CT.Effect Reference
r HashQualified Name
name (DataDeclaration v a -> Pretty (SyntaxText' Reference))
-> (EffectDeclaration v a -> DataDeclaration v a)
-> EffectDeclaration v a
-> Pretty (SyntaxText' Reference)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EffectDeclaration v a -> DataDeclaration v a
forall v a. EffectDeclaration v a -> DataDeclaration v a
toDataDecl

prettyGADT ::
  (Var v) =>
  PrettyPrintEnvDecl ->
  CT.ConstructorType ->
  TypeReference ->
  HQ.HashQualified Name ->
  DataDeclaration v a ->
  Pretty SyntaxText
prettyGADT :: forall v a.
Var v =>
PrettyPrintEnvDecl
-> ConstructorType
-> Reference
-> HashQualified Name
-> DataDeclaration v a
-> Pretty (SyntaxText' Reference)
prettyGADT PrettyPrintEnvDecl
env ConstructorType
ctorType Reference
r HashQualified Name
name DataDeclaration v a
dd =
  Pretty (SyntaxText' Reference)
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
P.hang Pretty (SyntaxText' Reference)
header (Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference))
-> ([Pretty (SyntaxText' Reference)]
    -> Pretty (SyntaxText' Reference))
-> [Pretty (SyntaxText' Reference)]
-> Pretty (SyntaxText' Reference)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pretty (SyntaxText' Reference)] -> Pretty (SyntaxText' Reference)
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ([Pretty (SyntaxText' Reference)]
 -> Pretty (SyntaxText' Reference))
-> [Pretty (SyntaxText' Reference)]
-> Pretty (SyntaxText' Reference)
forall a b. (a -> b) -> a -> b
$
    (ConstructorId, (a, v, Type v a)) -> Pretty (SyntaxText' Reference)
constructor ((ConstructorId, (a, v, Type v a))
 -> Pretty (SyntaxText' Reference))
-> [(ConstructorId, (a, v, Type v a))]
-> [Pretty (SyntaxText' Reference)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ConstructorId]
-> [(a, v, Type v a)] -> [(ConstructorId, (a, v, Type v a))]
forall a b. [a] -> [b] -> [(a, b)]
zip [ConstructorId
0 ..] (DataDeclaration v a -> [(a, v, Type v a)]
forall v a. DataDeclaration v a -> [(a, v, Type v a)]
DD.constructors' DataDeclaration v a
dd)
  where
    constructor :: (ConstructorId, (a, v, Type v a)) -> Pretty (SyntaxText' Reference)
constructor (ConstructorId
n, (a
_, v
_, Type v a
t)) =
      PrettyPrintEnv
-> ConstructorType
-> HashQualified Name
-> ConstructorReference
-> Pretty (SyntaxText' Reference)
prettyPattern (PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.unsuffixifiedPPE PrettyPrintEnvDecl
env) ConstructorType
ctorType HashQualified Name
name (Reference -> ConstructorId -> ConstructorReference
forall r. r -> ConstructorId -> GConstructorReference r
ConstructorReference Reference
r ConstructorId
n)
        Pretty (SyntaxText' Reference)
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall a. Semigroup a => a -> a -> a
<> Element Reference
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall r.
Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
fmt Element Reference
forall r. Element r
S.TypeAscriptionColon Pretty (SyntaxText' Reference)
" :"
          Pretty (SyntaxText' Reference)
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
`P.hang` PrettyPrintEnv -> Type v a -> Pretty (SyntaxText' Reference)
forall v a.
Var v =>
PrettyPrintEnv -> Type v a -> Pretty (SyntaxText' Reference)
TypePrinter.prettySyntax (PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.suffixifiedPPE PrettyPrintEnvDecl
env) Type v a
t
    header :: Pretty (SyntaxText' Reference)
header = HashQualified Name
-> EffectDeclaration v a -> Pretty (SyntaxText' Reference)
forall v a.
Var v =>
HashQualified Name
-> EffectDeclaration v a -> Pretty (SyntaxText' Reference)
prettyEffectHeader HashQualified Name
name (DataDeclaration v a -> EffectDeclaration v a
forall v a. DataDeclaration v a -> EffectDeclaration v a
DD.EffectDeclaration DataDeclaration v a
dd) Pretty (SyntaxText' Reference)
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall a. Semigroup a => a -> a -> a
<> Element Reference
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall r.
Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
fmt Element Reference
forall r. Element r
S.ControlKeyword Pretty (SyntaxText' Reference)
" where"

prettyPattern ::
  PrettyPrintEnv ->
  CT.ConstructorType ->
  HQ.HashQualified Name ->
  ConstructorReference ->
  Pretty SyntaxText
prettyPattern :: PrettyPrintEnv
-> ConstructorType
-> HashQualified Name
-> ConstructorReference
-> Pretty (SyntaxText' Reference)
prettyPattern PrettyPrintEnv
env ConstructorType
ctorType HashQualified Name
namespace ConstructorReference
ref =
  (Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference))
-> HashQualified Name -> Pretty (SyntaxText' Reference)
styleHashQualified''
    (Element Reference
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall r.
Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
fmt (Referent' Reference -> Element Reference
forall r. Referent' r -> Element r
S.TermReference Referent' Reference
conRef))
    ( let strip :: HashQualified Name -> HashQualified Name
strip =
            case HashQualified Name -> Maybe Name
forall n. HashQualified n -> Maybe n
HQ.toName HashQualified Name
namespace of
              Maybe Name
Nothing -> HashQualified Name -> HashQualified Name
forall a. a -> a
id
              Just Name
name -> Name -> HashQualified Name -> HashQualified Name
HQ.stripNamespace Name
name
       in HashQualified Name -> HashQualified Name
strip (PrettyPrintEnv -> Referent' Reference -> HashQualified Name
PPE.termName PrettyPrintEnv
env Referent' Reference
conRef)
    )
  where
    conRef :: Referent' Reference
conRef = ConstructorReference -> ConstructorType -> Referent' Reference
Referent.Con ConstructorReference
ref ConstructorType
ctorType

prettyDataDecl ::
  (Var v) =>
  PrettyPrintEnvDecl ->
  TypeReference ->
  HQ.HashQualified Name ->
  DataDeclaration v a ->
  Writer (Set AccessorName) (Pretty SyntaxText)
prettyDataDecl :: forall v a.
Var v =>
PrettyPrintEnvDecl
-> Reference
-> HashQualified Name
-> DataDeclaration v a
-> Writer (Set Name) (Pretty (SyntaxText' Reference))
prettyDataDecl (PrettyPrintEnvDecl PrettyPrintEnv
unsuffixifiedPPE PrettyPrintEnv
suffixifiedPPE) Reference
r HashQualified Name
name DataDeclaration v a
dd =
  (Pretty (SyntaxText' Reference)
header Pretty (SyntaxText' Reference)
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall a. Semigroup a => a -> a -> a
<>) (Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference))
-> ([Pretty (SyntaxText' Reference)]
    -> Pretty (SyntaxText' Reference))
-> [Pretty (SyntaxText' Reference)]
-> Pretty (SyntaxText' Reference)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty (SyntaxText' Reference)
-> [Pretty (SyntaxText' Reference)]
-> Pretty (SyntaxText' Reference)
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
P.sep (Element Reference
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall r.
Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
fmt Element Reference
forall r. Element r
S.DelimiterChar (Pretty (SyntaxText' Reference)
" | " Pretty (SyntaxText' Reference)
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall s. Pretty s -> Pretty s -> Pretty s
`P.orElse` Pretty (SyntaxText' Reference)
"\n  | "))
    ([Pretty (SyntaxText' Reference)]
 -> Pretty (SyntaxText' Reference))
-> WriterT (Set Name) Identity [Pretty (SyntaxText' Reference)]
-> Writer (Set Name) (Pretty (SyntaxText' Reference))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ConstructorId, (a, v, Type v a))
-> Writer (Set Name) (Pretty (SyntaxText' Reference))
constructor ((ConstructorId, (a, v, Type v a))
 -> Writer (Set Name) (Pretty (SyntaxText' Reference)))
-> [(ConstructorId, (a, v, Type v a))]
-> WriterT (Set Name) Identity [Pretty (SyntaxText' Reference)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
`traverse` [ConstructorId]
-> [(a, v, Type v a)] -> [(ConstructorId, (a, v, Type v a))]
forall a b. [a] -> [b] -> [(a, b)]
zip [ConstructorId
0 ..] (DataDeclaration v a -> [(a, v, Type v a)]
forall v a. DataDeclaration v a -> [(a, v, Type v a)]
DD.constructors' DataDeclaration v a
dd)
  where
    constructor :: (ConstructorId, (a, v, Type v a))
-> Writer (Set Name) (Pretty (SyntaxText' Reference))
constructor (ConstructorId
n, (a
_, v
_, Type.ForallsNamed' [v]
_ Type v a
t)) = ConstructorId
-> Type v a -> Writer (Set Name) (Pretty (SyntaxText' Reference))
constructor' ConstructorId
n Type v a
t
    constructor (ConstructorId
n, (a
_, v
_, Type v a
t)) = ConstructorId
-> Type v a -> Writer (Set Name) (Pretty (SyntaxText' Reference))
constructor' ConstructorId
n Type v a
t
    constructor' :: ConstructorId
-> Type v a -> Writer (Set Name) (Pretty (SyntaxText' Reference))
constructor' ConstructorId
n Type v a
t = case Type v a -> Maybe [Type v a]
forall v a. Type v a -> Maybe [Type v a]
Type.unArrows Type v a
t of
      Maybe [Type v a]
Nothing -> Pretty (SyntaxText' Reference)
-> Writer (Set Name) (Pretty (SyntaxText' Reference))
forall a. a -> WriterT (Set Name) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty (SyntaxText' Reference)
 -> Writer (Set Name) (Pretty (SyntaxText' Reference)))
-> Pretty (SyntaxText' Reference)
-> Writer (Set Name) (Pretty (SyntaxText' Reference))
forall a b. (a -> b) -> a -> b
$ PrettyPrintEnv
-> ConstructorType
-> HashQualified Name
-> ConstructorReference
-> Pretty (SyntaxText' Reference)
prettyPattern PrettyPrintEnv
unsuffixifiedPPE ConstructorType
CT.Data HashQualified Name
name (Reference -> ConstructorId -> ConstructorReference
forall r. r -> ConstructorId -> GConstructorReference r
ConstructorReference Reference
r ConstructorId
n)
      Just [Type v a]
ts -> case PrettyPrintEnv
-> Reference
-> HashQualified Name
-> DataDeclaration v a
-> Maybe ([Name], [Name])
forall v a.
Var v =>
PrettyPrintEnv
-> Reference
-> HashQualified Name
-> DataDeclaration v a
-> Maybe ([Name], [Name])
getFieldAndAccessorNames PrettyPrintEnv
unsuffixifiedPPE Reference
r HashQualified Name
name DataDeclaration v a
dd of
        Maybe ([Name], [Name])
Nothing ->
          Pretty (SyntaxText' Reference)
-> Writer (Set Name) (Pretty (SyntaxText' Reference))
forall a. a -> WriterT (Set Name) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            (Pretty (SyntaxText' Reference)
 -> Writer (Set Name) (Pretty (SyntaxText' Reference)))
-> (Pretty (SyntaxText' Reference)
    -> Pretty (SyntaxText' Reference))
-> Pretty (SyntaxText' Reference)
-> Writer (Set Name) (Pretty (SyntaxText' Reference))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall s. Pretty s -> Pretty s
P.group
            (Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference))
-> (Pretty (SyntaxText' Reference)
    -> Pretty (SyntaxText' Reference))
-> Pretty (SyntaxText' Reference)
-> Pretty (SyntaxText' Reference)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty (SyntaxText' Reference)
-> Pretty (SyntaxText' Reference)
-> Pretty (SyntaxText' Reference)
-> Pretty (SyntaxText' Reference)
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s -> Pretty s
P.hang' (PrettyPrintEnv
-> ConstructorType
-> HashQualified Name
-> ConstructorReference
-> Pretty (SyntaxText' Reference)
prettyPattern PrettyPrintEnv
unsuffixifiedPPE ConstructorType
CT.Data HashQualified Name
name (Reference -> ConstructorId -> ConstructorReference
forall r. r -> ConstructorId -> GConstructorReference r
ConstructorReference Reference
r ConstructorId
n)) Pretty (SyntaxText' Reference)
"      "
            (Pretty (SyntaxText' Reference)
 -> Writer (Set Name) (Pretty (SyntaxText' Reference)))
-> Pretty (SyntaxText' Reference)
-> Writer (Set Name) (Pretty (SyntaxText' Reference))
forall a b. (a -> b) -> a -> b
$ [Pretty (SyntaxText' Reference)] -> Pretty (SyntaxText' Reference)
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.spaced (PrettyPrintEnv
-> Reader (Env v) [Pretty (SyntaxText' Reference)]
-> [Pretty (SyntaxText' Reference)]
forall v a. Var v => PrettyPrintEnv -> Reader (Env v) a -> a
runPretty PrettyPrintEnv
suffixifiedPPE ((Type v a
 -> ReaderT (Env v) Identity (Pretty (SyntaxText' Reference)))
-> [Type v a] -> Reader (Env v) [Pretty (SyntaxText' Reference)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Imports
-> Int
-> Type v a
-> ReaderT (Env v) Identity (Pretty (SyntaxText' Reference))
forall v a (m :: * -> *).
MonadPretty v m =>
Imports -> Int -> Type v a -> m (Pretty (SyntaxText' Reference))
TypePrinter.prettyRaw Imports
forall k a. Map k a
Map.empty Int
10) ([Type v a] -> [Type v a]
forall a. HasCallStack => [a] -> [a]
init [Type v a]
ts)))
        Just ([Name]
fieldNames, [Name]
_) -> do
          Set Name -> WriterT (Set Name) Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Set Name -> WriterT (Set Name) Identity ())
-> Set Name -> WriterT (Set Name) Identity ()
forall a b. (a -> b) -> a -> b
$
            [Name] -> Set Name
forall a. Ord a => [a] -> Set a
Set.fromList ([Name] -> Set Name) -> [Name] -> Set Name
forall a b. (a -> b) -> a -> b
$
              [ case Maybe Name
accessor of
                  Maybe Name
Nothing -> Name
declName HasCallStack => Name -> Name -> Name
Name -> Name -> Name
`Name.joinDot` Name
fieldName
                  Just Name
accessor -> Name
declName HasCallStack => Name -> Name -> Name
Name -> Name -> Name
`Name.joinDot` Name
fieldName HasCallStack => Name -> Name -> Name
Name -> Name -> Name
`Name.joinDot` Name
accessor
                | HQ.NameOnly Name
declName <- [HashQualified Name
name],
                  Name
fieldName <- [Name]
fieldNames,
                  Maybe Name
accessor <-
                    [ Maybe Name
forall a. Maybe a
Nothing,
                      Name -> Maybe Name
forall a. a -> Maybe a
Just (NameSegment -> Name
Name.fromSegment NameSegment
NameSegment.setSegment),
                      Name -> Maybe Name
forall a. a -> Maybe a
Just (NameSegment -> Name
Name.fromSegment NameSegment
NameSegment.modifySegment)
                    ]
              ]
          Pretty (SyntaxText' Reference)
-> Writer (Set Name) (Pretty (SyntaxText' Reference))
forall a. a -> WriterT (Set Name) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty (SyntaxText' Reference)
 -> Writer (Set Name) (Pretty (SyntaxText' Reference)))
-> (Pretty (SyntaxText' Reference)
    -> Pretty (SyntaxText' Reference))
-> Pretty (SyntaxText' Reference)
-> Writer (Set Name) (Pretty (SyntaxText' Reference))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall s. Pretty s -> Pretty s
P.group (Pretty (SyntaxText' Reference)
 -> Writer (Set Name) (Pretty (SyntaxText' Reference)))
-> Pretty (SyntaxText' Reference)
-> Writer (Set Name) (Pretty (SyntaxText' Reference))
forall a b. (a -> b) -> a -> b
$
            Element Reference
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall r.
Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
fmt Element Reference
forall r. Element r
S.DelimiterChar Pretty (SyntaxText' Reference)
"{ "
              Pretty (SyntaxText' Reference)
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall a. Semigroup a => a -> a -> a
<> Pretty (SyntaxText' Reference)
-> [Pretty (SyntaxText' Reference)]
-> Pretty (SyntaxText' Reference)
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
P.sep
                (Element Reference
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall r.
Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
fmt Element Reference
forall r. Element r
S.DelimiterChar Pretty (SyntaxText' Reference)
"," Pretty (SyntaxText' Reference)
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall a. Semigroup a => a -> a -> a
<> Pretty (SyntaxText' Reference)
" " Pretty (SyntaxText' Reference)
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall s. Pretty s -> Pretty s -> Pretty s
`P.orElse` Pretty (SyntaxText' Reference)
"\n      ")
                ((Name, Type v a) -> Pretty (SyntaxText' Reference)
field ((Name, Type v a) -> Pretty (SyntaxText' Reference))
-> [(Name, Type v a)] -> [Pretty (SyntaxText' Reference)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name] -> [Type v a] -> [(Name, Type v a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Name]
fieldNames ([Type v a] -> [Type v a]
forall a. HasCallStack => [a] -> [a]
init [Type v a]
ts))
              Pretty (SyntaxText' Reference)
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall a. Semigroup a => a -> a -> a
<> Element Reference
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall r.
Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
fmt Element Reference
forall r. Element r
S.DelimiterChar Pretty (SyntaxText' Reference)
" }"
    field :: (Name, Type v a) -> Pretty (SyntaxText' Reference)
field (Name
fname, Type v a
typ) =
      Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall s. Pretty s -> Pretty s
P.group (Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference))
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall a b. (a -> b) -> a -> b
$
        Element Reference
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall r.
Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
fmt (Reference -> Element Reference
forall r. r -> Element r
S.TypeReference Reference
r) (Name -> Pretty (SyntaxText' Reference)
forall s. IsString s => Name -> Pretty s
prettyName Name
fname)
          Pretty (SyntaxText' Reference)
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall a. Semigroup a => a -> a -> a
<> Element Reference
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall r.
Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
fmt Element Reference
forall r. Element r
S.TypeAscriptionColon Pretty (SyntaxText' Reference)
" :"
            Pretty (SyntaxText' Reference)
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
`P.hang` PrettyPrintEnv
-> ReaderT (Env v) Identity (Pretty (SyntaxText' Reference))
-> Pretty (SyntaxText' Reference)
forall v a. Var v => PrettyPrintEnv -> Reader (Env v) a -> a
runPretty PrettyPrintEnv
suffixifiedPPE (Imports
-> Int
-> Type v a
-> ReaderT (Env v) Identity (Pretty (SyntaxText' Reference))
forall v a (m :: * -> *).
MonadPretty v m =>
Imports -> Int -> Type v a -> m (Pretty (SyntaxText' Reference))
TypePrinter.prettyRaw Imports
forall k a. Map k a
Map.empty (-Int
1) Type v a
typ)
    header :: Pretty (SyntaxText' Reference)
header = HashQualified Name
-> DataDeclaration v a -> Pretty (SyntaxText' Reference)
forall v a.
Var v =>
HashQualified Name
-> DataDeclaration v a -> Pretty (SyntaxText' Reference)
prettyDataHeader HashQualified Name
name DataDeclaration v a
dd Pretty (SyntaxText' Reference)
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall a. Semigroup a => a -> a -> a
<> Element Reference
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall r.
Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
fmt Element Reference
forall r. Element r
S.DelimiterChar (Pretty (SyntaxText' Reference)
" = " Pretty (SyntaxText' Reference)
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall s. Pretty s -> Pretty s -> Pretty s
`P.orElse` Pretty (SyntaxText' Reference)
"\n  = ")

-- This function determines if a data declaration "looks like a record", and if so, returns both its auto-generated
-- accessor names (such as "Pt.x.set") and field names (such as "x"). Because we generate three accessors per field,
-- there will always be three times as many accessors as there are fields.
--
-- It works by works by generating the record accessor terms for the data type, hashing these terms, and then checking
-- the `PrettyPrintEnv` for the names of those hashes.
--
-- For example, for a type named "Pt", if the names of its accessors are
--
--   `Pt.x`, `Pt.x.set`, `Pt.x.modify`, `Pt.y`, `Pt.y.set`, `Pt.y.modify`
--
-- then we will return those accessors along with the field names
--
--   `x`, `y`
--
-- This function returns `Nothing` if the given data declaration does not "look like a record".
getFieldAndAccessorNames ::
  forall v a.
  (Var v) =>
  PrettyPrintEnv ->
  TypeReference ->
  HQ.HashQualified Name ->
  DataDeclaration v a ->
  Maybe ([Name], [Name]) -- field names, accessor names
getFieldAndAccessorNames :: forall v a.
Var v =>
PrettyPrintEnv
-> Reference
-> HashQualified Name
-> DataDeclaration v a
-> Maybe ([Name], [Name])
getFieldAndAccessorNames PrettyPrintEnv
env Reference
r HashQualified Name
hqTypename DataDeclaration v a
dd = do
  -- If we only have a hash for the decl, then we can't know where in the namespace to look for the generated accessors,
  -- so we just give up trying to infer whether this was a record (even if it was one).
  Name
typename <- HashQualified Name -> Maybe Name
forall n. HashQualified n -> Maybe n
HQ.toName HashQualified Name
hqTypename

  -- Records have exactly one constructor
  [(v
_, Type v a
typ)] <- [(v, Type v a)] -> Maybe [(v, Type v a)]
forall a. a -> Maybe a
Just (DataDeclaration v a -> [(v, Type v a)]
forall v a. DataDeclaration v a -> [(v, Type v a)]
DD.constructors DataDeclaration v a
dd)

  -- [ "_0", "_1"-1 ]
  let vars :: [v]
      -- We add `n` to the end of the variable name as a quick fix to #4752, but we suspect there's a more
      -- fundamental fix to be made somewhere in the term printer to automatically suffix a var name with its
      -- freshened id if it would be ambiguous otherwise.
      vars :: [v]
vars = [ConstructorId -> v -> v
forall v. Var v => ConstructorId -> v -> v
Var.freshenId (Int -> ConstructorId
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) (Text -> v
forall v. Var v => Text -> v
Var.named (Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Int -> String
forall a. Show a => a -> String
show Int
n))) | Int
n <- [Int
0 .. Type v a -> Int
forall v a. Type v a -> Int
Type.arity Type v a
typ Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]]

  -- {
  --   "Pt._0"         => ( #getx    ,   pt -> match pt with Pt x _ -> x          , Pt -> Int                )
  --   "Pt._0.set"     => ( #setx    , x pt -> match pt with Pt _ y -> Pt x y     , Int -> Pt -> Pt          )
  --   "Pt._0.modify"  => ( #modifyx , f pt -> match pt with Pt x y -> Pt (f x) y , (Int -> Int) -> Pt -> Pt )
  --   "Pt._11"        => ( #gety    ,   pt -> match pt with Pt _ y -> y          , Pt -> Int                )
  --   "Pt._11.set"    => ( #sety    , y pt -> match pt with Pt x _ -> Pt x y     , Int -> Pt -> Pt          )
  --   "Pt._11.modify" => ( #modifyy , f pt -> match pt with Pt x y -> Pt x (f y) , (Int -> Int) -> Pt -> Pt )
  -- }
  Map v (TermReferenceId, Term v (), Type v ())
hashes <- PrettyPrintEnv
-> v
-> [v]
-> Reference
-> DataDeclaration v a
-> Maybe (Map v (TermReferenceId, Term v (), Type v ()))
forall v a.
Var v =>
PrettyPrintEnv
-> v
-> [v]
-> Reference
-> DataDeclaration v a
-> Maybe (Map v (TermReferenceId, Term v (), Type v ()))
DD.hashFieldAccessors PrettyPrintEnv
env (Name -> v
forall v. Var v => Name -> v
Name.toVar Name
typename) [v]
vars Reference
r DataDeclaration v a
dd

  -- [
  --   ( #getx    , "Pt.x"        )
  --   ( #setx    , "Pt.x.set"    )
  --   ( #modifyx , "Pt.x.modify" )
  --   ( #gety    , "Pt.y"        )
  --   ( #sety    , "Pt.y.set"    )
  --   ( #modifyy , "Pt.y.modify" )
  -- ]
  let accessorNamesByHash :: [(TermReferenceId, Text)]
accessorNamesByHash =
        Map v (TermReferenceId, Term v (), Type v ())
hashes
          Map v (TermReferenceId, Term v (), Type v ())
-> (Map v (TermReferenceId, Term v (), Type v ())
    -> [(TermReferenceId, Term v (), Type v ())])
-> [(TermReferenceId, Term v (), Type v ())]
forall a b. a -> (a -> b) -> b
& Map v (TermReferenceId, Term v (), Type v ())
-> [(TermReferenceId, Term v (), Type v ())]
forall k a. Map k a -> [a]
Map.elems
          [(TermReferenceId, Term v (), Type v ())]
-> ([(TermReferenceId, Term v (), Type v ())]
    -> [(TermReferenceId, Text)])
-> [(TermReferenceId, Text)]
forall a b. a -> (a -> b) -> b
& ((TermReferenceId, Term v (), Type v ())
 -> (TermReferenceId, Text))
-> [(TermReferenceId, Term v (), Type v ())]
-> [(TermReferenceId, Text)]
forall a b. (a -> b) -> [a] -> [b]
map \(TermReferenceId
refId, Term v ()
_term, Type v ()
_typ) ->
            (TermReferenceId
refId, HashQualified Name -> Text
HQ.toText (PrettyPrintEnv -> Referent' Reference -> HashQualified Name
PPE.termName PrettyPrintEnv
env (TermReferenceId -> Referent' Reference
Referent.fromTermReferenceId TermReferenceId
refId)))

  -- {
  --   #getx    => "x"
  --   #setx    => "x"
  --   #modifyx => "x"
  --   #gety    => "y"
  --   #sety    => "y"
  --   #modifyy => "y"
  -- }
  let fieldNamesByHash :: Map TermReferenceId Text
fieldNamesByHash =
        [(TermReferenceId, Text)] -> Map TermReferenceId Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
          [ (TermReferenceId
r, Text
f)
            | (TermReferenceId
r, Text
n) <- [(TermReferenceId, Text)]
accessorNamesByHash,
              let typenameText :: Text
typenameText = Name -> Text
Name.toText Name
typename,
              Text
typenameText Text -> Text -> Bool
`Text.isPrefixOf` Text
n,
              let rest :: Text
rest = Int -> Text -> Text
Text.drop (Text -> Int
Text.length Text
typenameText Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text
n,
              (Text
f, Text
rest) <- (Text, Text) -> [(Text, Text)]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Text, Text) -> [(Text, Text)]) -> (Text, Text) -> [(Text, Text)]
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> (Text, Text)
Text.span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'.') Text
rest,
              Text
rest Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"", Text
".set", Text
".modify"]
          ]

  if Map TermReferenceId Text -> Int
forall k a. Map k a -> Int
Map.size Map TermReferenceId Text
fieldNamesByHash Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [(TermReferenceId, Text)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(TermReferenceId, Text)]
accessorNamesByHash
    then
      ([Name], [Name]) -> Maybe ([Name], [Name])
forall a. a -> Maybe a
Just
        ( [ HasCallStack => Text -> Name
Text -> Name
Name.unsafeParseText Text
name
            | -- "_0"
              v
v <- [v]
vars,
              -- #getx
              Just (TermReferenceId
ref, Term v ()
_, Type v ()
_) <- [v
-> Map v (TermReferenceId, Term v (), Type v ())
-> Maybe (TermReferenceId, Term v (), Type v ())
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (NonEmpty v -> v
forall v. Var v => NonEmpty v -> v
Var.namespaced (Name -> v
forall v. Var v => Name -> v
Name.toVar Name
typename v -> [v] -> NonEmpty v
forall a. a -> [a] -> NonEmpty a
:| [v
v])) Map v (TermReferenceId, Term v (), Type v ())
hashes],
              -- "x"
              Just Text
name <- [TermReferenceId -> Map TermReferenceId Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TermReferenceId
ref Map TermReferenceId Text
fieldNamesByHash]
          ],
          ((TermReferenceId, Text) -> Name)
-> [(TermReferenceId, Text)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (HasCallStack => Text -> Name
Text -> Name
Name.unsafeParseText (Text -> Name)
-> ((TermReferenceId, Text) -> Text)
-> (TermReferenceId, Text)
-> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TermReferenceId, Text) -> Text
forall a b. (a, b) -> b
snd) [(TermReferenceId, Text)]
accessorNamesByHash
        )
    else Maybe ([Name], [Name])
forall a. Maybe a
Nothing

prettyModifier :: DD.Modifier -> Pretty SyntaxText
prettyModifier :: Modifier -> Pretty (SyntaxText' Reference)
prettyModifier Modifier
DD.Structural = Element Reference
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall r.
Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
fmt Element Reference
forall r. Element r
S.DataTypeModifier Pretty (SyntaxText' Reference)
"structural"
prettyModifier (DD.Unique Text
_uid) = Pretty (SyntaxText' Reference)
forall a. Monoid a => a
mempty -- don't print anything since 'unique' is the default
-- leaving this comment for the historical record so the syntax for uid is not forgotten
-- fmt S.DataTypeModifier "unique" -- <> ("[" <> P.text uid <> "] ")

prettyDataHeader ::
  (Var v) => HQ.HashQualified Name -> DD.DataDeclaration v a -> Pretty SyntaxText
prettyDataHeader :: forall v a.
Var v =>
HashQualified Name
-> DataDeclaration v a -> Pretty (SyntaxText' Reference)
prettyDataHeader HashQualified Name
name DataDeclaration v a
dd =
  Pretty (SyntaxText' Reference)
-> [Pretty (SyntaxText' Reference)]
-> Pretty (SyntaxText' Reference)
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
P.sepNonEmpty
    Pretty (SyntaxText' Reference)
" "
    [ Modifier -> Pretty (SyntaxText' Reference)
prettyModifier (DataDeclaration v a -> Modifier
forall v a. DataDeclaration v a -> Modifier
DD.modifier DataDeclaration v a
dd),
      Element Reference
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall r.
Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
fmt Element Reference
forall r. Element r
S.DataTypeKeyword Pretty (SyntaxText' Reference)
"type",
      (Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference))
-> HashQualified Name -> Pretty (SyntaxText' Reference)
styleHashQualified'' (Element Reference
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall r.
Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
fmt (Element Reference
 -> Pretty (SyntaxText' Reference)
 -> Pretty (SyntaxText' Reference))
-> Element Reference
-> Pretty (SyntaxText' Reference)
-> Pretty (SyntaxText' Reference)
forall a b. (a -> b) -> a -> b
$ HashQualified Name -> Element Reference
forall r. HashQualified Name -> Element r
S.HashQualifier HashQualified Name
name) HashQualified Name
name,
      Pretty (SyntaxText' Reference)
-> [Pretty (SyntaxText' Reference)]
-> Pretty (SyntaxText' Reference)
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
P.sep Pretty (SyntaxText' Reference)
" " (Element Reference
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall r.
Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
fmt Element Reference
forall r. Element r
S.DataTypeParams (Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference))
-> (v -> Pretty (SyntaxText' Reference))
-> v
-> Pretty (SyntaxText' Reference)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Pretty (SyntaxText' Reference)
forall s. IsString s => Text -> Pretty s
P.text (Text -> Pretty (SyntaxText' Reference))
-> (v -> Text) -> v -> Pretty (SyntaxText' Reference)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Text
forall v. Var v => v -> Text
Var.name (v -> Pretty (SyntaxText' Reference))
-> [v] -> [Pretty (SyntaxText' Reference)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DataDeclaration v a -> [v]
forall v a. DataDeclaration v a -> [v]
DD.bound DataDeclaration v a
dd)
    ]

prettyEffectHeader ::
  (Var v) =>
  HQ.HashQualified Name ->
  DD.EffectDeclaration v a ->
  Pretty SyntaxText
prettyEffectHeader :: forall v a.
Var v =>
HashQualified Name
-> EffectDeclaration v a -> Pretty (SyntaxText' Reference)
prettyEffectHeader HashQualified Name
name EffectDeclaration v a
ed =
  Pretty (SyntaxText' Reference)
-> [Pretty (SyntaxText' Reference)]
-> Pretty (SyntaxText' Reference)
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
P.sepNonEmpty
    Pretty (SyntaxText' Reference)
" "
    [ Modifier -> Pretty (SyntaxText' Reference)
prettyModifier (DataDeclaration v a -> Modifier
forall v a. DataDeclaration v a -> Modifier
DD.modifier (EffectDeclaration v a -> DataDeclaration v a
forall v a. EffectDeclaration v a -> DataDeclaration v a
DD.toDataDecl EffectDeclaration v a
ed)),
      Element Reference
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall r.
Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
fmt Element Reference
forall r. Element r
S.DataTypeKeyword Pretty (SyntaxText' Reference)
"ability",
      (Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference))
-> HashQualified Name -> Pretty (SyntaxText' Reference)
styleHashQualified'' (Element Reference
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall r.
Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
fmt (Element Reference
 -> Pretty (SyntaxText' Reference)
 -> Pretty (SyntaxText' Reference))
-> Element Reference
-> Pretty (SyntaxText' Reference)
-> Pretty (SyntaxText' Reference)
forall a b. (a -> b) -> a -> b
$ HashQualified Name -> Element Reference
forall r. HashQualified Name -> Element r
S.HashQualifier HashQualified Name
name) HashQualified Name
name,
      Pretty (SyntaxText' Reference)
-> [Pretty (SyntaxText' Reference)]
-> Pretty (SyntaxText' Reference)
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
P.sep
        Pretty (SyntaxText' Reference)
" "
        (Element Reference
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall r.
Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
fmt Element Reference
forall r. Element r
S.DataTypeParams (Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference))
-> (v -> Pretty (SyntaxText' Reference))
-> v
-> Pretty (SyntaxText' Reference)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Pretty (SyntaxText' Reference)
forall s. IsString s => Text -> Pretty s
P.text (Text -> Pretty (SyntaxText' Reference))
-> (v -> Text) -> v -> Pretty (SyntaxText' Reference)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Text
forall v. Var v => v -> Text
Var.name (v -> Pretty (SyntaxText' Reference))
-> [v] -> [Pretty (SyntaxText' Reference)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DataDeclaration v a -> [v]
forall v a. DataDeclaration v a -> [v]
DD.bound (EffectDeclaration v a -> DataDeclaration v a
forall v a. EffectDeclaration v a -> DataDeclaration v a
DD.toDataDecl EffectDeclaration v a
ed))
    ]

prettyDeclHeader ::
  (Var v) =>
  HQ.HashQualified Name ->
  Either (DD.EffectDeclaration v a) (DD.DataDeclaration v a) ->
  Pretty SyntaxText
prettyDeclHeader :: forall v a.
Var v =>
HashQualified Name
-> Either (EffectDeclaration v a) (DataDeclaration v a)
-> Pretty (SyntaxText' Reference)
prettyDeclHeader HashQualified Name
name (Left EffectDeclaration v a
e) = HashQualified Name
-> EffectDeclaration v a -> Pretty (SyntaxText' Reference)
forall v a.
Var v =>
HashQualified Name
-> EffectDeclaration v a -> Pretty (SyntaxText' Reference)
prettyEffectHeader HashQualified Name
name EffectDeclaration v a
e
prettyDeclHeader HashQualified Name
name (Right DataDeclaration v a
d) = HashQualified Name
-> DataDeclaration v a -> Pretty (SyntaxText' Reference)
forall v a.
Var v =>
HashQualified Name
-> DataDeclaration v a -> Pretty (SyntaxText' Reference)
prettyDataHeader HashQualified Name
name DataDeclaration v a
d

prettyDeclOrBuiltinHeader ::
  (Var v) =>
  HQ.HashQualified Name ->
  DD.DeclOrBuiltin v a ->
  Pretty SyntaxText
prettyDeclOrBuiltinHeader :: forall v a.
Var v =>
HashQualified Name
-> DeclOrBuiltin v a -> Pretty (SyntaxText' Reference)
prettyDeclOrBuiltinHeader HashQualified Name
name (DD.Builtin ConstructorType
ctype) = case ConstructorType
ctype of
  ConstructorType
CT.Data -> Element Reference
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall r.
Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
fmt Element Reference
forall r. Element r
S.DataTypeKeyword Pretty (SyntaxText' Reference)
"builtin type " Pretty (SyntaxText' Reference)
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall a. Semigroup a => a -> a -> a
<> (Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference))
-> HashQualified Name -> Pretty (SyntaxText' Reference)
styleHashQualified'' (Element Reference
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall r.
Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
fmt (Element Reference
 -> Pretty (SyntaxText' Reference)
 -> Pretty (SyntaxText' Reference))
-> Element Reference
-> Pretty (SyntaxText' Reference)
-> Pretty (SyntaxText' Reference)
forall a b. (a -> b) -> a -> b
$ HashQualified Name -> Element Reference
forall r. HashQualified Name -> Element r
S.HashQualifier HashQualified Name
name) HashQualified Name
name
  ConstructorType
CT.Effect -> Element Reference
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall r.
Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
fmt Element Reference
forall r. Element r
S.DataTypeKeyword Pretty (SyntaxText' Reference)
"builtin ability " Pretty (SyntaxText' Reference)
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall a. Semigroup a => a -> a -> a
<> (Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference))
-> HashQualified Name -> Pretty (SyntaxText' Reference)
styleHashQualified'' (Element Reference
-> Pretty (SyntaxText' Reference) -> Pretty (SyntaxText' Reference)
forall r.
Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
fmt (Element Reference
 -> Pretty (SyntaxText' Reference)
 -> Pretty (SyntaxText' Reference))
-> Element Reference
-> Pretty (SyntaxText' Reference)
-> Pretty (SyntaxText' Reference)
forall a b. (a -> b) -> a -> b
$ HashQualified Name -> Element Reference
forall r. HashQualified Name -> Element r
S.HashQualifier HashQualified Name
name) HashQualified Name
name
prettyDeclOrBuiltinHeader HashQualified Name
name (DD.Decl Decl v a
e) = HashQualified Name -> Decl v a -> Pretty (SyntaxText' Reference)
forall v a.
Var v =>
HashQualified Name
-> Either (EffectDeclaration v a) (DataDeclaration v a)
-> Pretty (SyntaxText' Reference)
prettyDeclHeader HashQualified Name
name Decl v a
e

fmt :: S.Element r -> Pretty (S.SyntaxText' r) -> Pretty (S.SyntaxText' r)
fmt :: forall r.
Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
fmt = Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
forall r.
Element r -> Pretty (SyntaxText' r) -> Pretty (SyntaxText' r)
P.withSyntax