module Unison.Syntax.DeclParser
  ( synDeclsP,
    SynDecl (..),
    synDeclConstructors,
    synDeclName,
    SynDataDecl (..),
    SynEffectDecl (..),
  )
where

import Control.Lens
import Data.List.NonEmpty (pattern (:|))
import Data.List.NonEmpty qualified as NonEmpty
import Unison.ABT qualified as ABT
import Unison.DataDeclaration qualified as DataDeclaration
import Unison.Name qualified as Name
import Unison.Parser.Ann (Ann)
import Unison.Prelude
import Unison.Syntax.Lexer qualified as L
import Unison.Syntax.Name qualified as Name (toText, unsafeParseVar)
import Unison.Syntax.Parser
import Unison.Syntax.TermParser qualified as TermParser
import Unison.Syntax.TypeParser qualified as TypeParser
import Unison.Syntax.Var qualified as Var (namespaced)
import Unison.Type (Type)
import Unison.Type qualified as Type
import Unison.Var (Var)
import Unison.Var qualified as Var (name, named)
import Prelude hiding (readFile)

data SynDecl v
  = SynDecl'Data !(SynDataDecl v)
  | SynDecl'Effect !(SynEffectDecl v)

instance Annotated (SynDecl v) where
  ann :: SynDecl v -> Ann
ann = \case
    SynDecl'Data SynDataDecl v
decl -> SynDataDecl v
decl.annotation
    SynDecl'Effect SynEffectDecl v
decl -> SynEffectDecl v
decl.annotation

synDeclConstructors :: SynDecl v -> [(Ann, v, Type v Ann)]
synDeclConstructors :: forall v. SynDecl v -> [(Ann, v, Type v Ann)]
synDeclConstructors = \case
  SynDecl'Data SynDataDecl v
decl -> SynDataDecl v
decl.constructors
  SynDecl'Effect SynEffectDecl v
decl -> SynEffectDecl v
decl.constructors

synDeclName :: SynDecl v -> L.Token v
synDeclName :: forall v. SynDecl v -> Token v
synDeclName = \case
  SynDecl'Data SynDataDecl v
decl -> SynDataDecl v
decl.name
  SynDecl'Effect SynEffectDecl v
decl -> SynEffectDecl v
decl.name

data SynDataDecl v = SynDataDecl
  { forall v. SynDataDecl v -> Ann
annotation :: !Ann,
    forall v. SynDataDecl v -> [(Ann, v, Type v Ann)]
constructors :: ![(Ann, v, Type v Ann)],
    forall v. SynDataDecl v -> Maybe [(Token v, Type v Ann)]
fields :: !(Maybe [(L.Token v, Type v Ann)]),
    forall v. SynDataDecl v -> Modifier
modifier :: !DataDeclaration.Modifier,
    forall v. SynDataDecl v -> Token v
name :: !(L.Token v),
    forall v. SynDataDecl v -> [v]
tyvars :: ![v]
  }
  deriving stock ((forall x. SynDataDecl v -> Rep (SynDataDecl v) x)
-> (forall x. Rep (SynDataDecl v) x -> SynDataDecl v)
-> Generic (SynDataDecl v)
forall x. Rep (SynDataDecl v) x -> SynDataDecl v
forall x. SynDataDecl v -> Rep (SynDataDecl v) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall v x. Rep (SynDataDecl v) x -> SynDataDecl v
forall v x. SynDataDecl v -> Rep (SynDataDecl v) x
$cfrom :: forall v x. SynDataDecl v -> Rep (SynDataDecl v) x
from :: forall x. SynDataDecl v -> Rep (SynDataDecl v) x
$cto :: forall v x. Rep (SynDataDecl v) x -> SynDataDecl v
to :: forall x. Rep (SynDataDecl v) x -> SynDataDecl v
Generic)

data SynEffectDecl v = SynEffectDecl
  { forall v. SynEffectDecl v -> Ann
annotation :: !Ann,
    forall v. SynEffectDecl v -> [(Ann, v, Type v Ann)]
constructors :: ![(Ann, v, Type v Ann)],
    forall v. SynEffectDecl v -> Modifier
modifier :: !DataDeclaration.Modifier,
    forall v. SynEffectDecl v -> Token v
name :: !(L.Token v),
    forall v. SynEffectDecl v -> [v]
tyvars :: ![v]
  }
  deriving stock ((forall x. SynEffectDecl v -> Rep (SynEffectDecl v) x)
-> (forall x. Rep (SynEffectDecl v) x -> SynEffectDecl v)
-> Generic (SynEffectDecl v)
forall x. Rep (SynEffectDecl v) x -> SynEffectDecl v
forall x. SynEffectDecl v -> Rep (SynEffectDecl v) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall v x. Rep (SynEffectDecl v) x -> SynEffectDecl v
forall v x. SynEffectDecl v -> Rep (SynEffectDecl v) x
$cfrom :: forall v x. SynEffectDecl v -> Rep (SynEffectDecl v) x
from :: forall x. SynEffectDecl v -> Rep (SynEffectDecl v) x
$cto :: forall v x. Rep (SynEffectDecl v) x -> SynEffectDecl v
to :: forall x. Rep (SynEffectDecl v) x -> SynEffectDecl v
Generic)

synDeclsP :: (Monad m, Var v) => P v m [SynDecl v]
synDeclsP :: forall (m :: * -> *) v. (Monad m, Var v) => P v m [SynDecl v]
synDeclsP =
  ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (SynDecl v)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) [SynDecl v]
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (SynDecl v)
forall (m :: * -> *) v. (Monad m, Var v) => P v m (SynDecl v)
synDeclP ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (SynDecl v)
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Maybe (Token ()))
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (SynDecl v)
forall a b.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Maybe (Token ()))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
forall v (m :: * -> *). Ord v => P v m (Token ())
semi)

-- | When we first walk over the modifier, it may be a `unique`, in which case we want to use a function in the parsing
-- environment to map the type's name (which we haven't parsed yet) to a GUID to reuse (if any).
--
-- So, we parse into this temporary "unresolved modifier" type, which is soon resolved to a real Modifier once we know
-- the type name.
data UnresolvedModifier
  = UnresolvedModifier'Structural
  | UnresolvedModifier'UniqueWithGuid !Text
  | UnresolvedModifier'UniqueWithoutGuid

-- unique[someguid] type Blah = ...
modifierP :: (Monad m, Var v) => P v m (Maybe (L.Token UnresolvedModifier))
modifierP :: forall (m :: * -> *) v.
(Monad m, Var v) =>
P v m (Maybe (Token UnresolvedModifier))
modifierP = do
  ParsecT
  (Error v)
  Input
  (ReaderT (ParsingEnv m) m)
  (Token UnresolvedModifier)
-> P v m (Maybe (Token UnresolvedModifier))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT
  (Error v)
  Input
  (ReaderT (ParsingEnv m) m)
  (Token UnresolvedModifier)
forall {m :: * -> *}.
ParsecT
  (Error v)
  Input
  (ReaderT (ParsingEnv m) m)
  (Token UnresolvedModifier)
unique ParsecT
  (Error v)
  Input
  (ReaderT (ParsingEnv m) m)
  (Token UnresolvedModifier)
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Token UnresolvedModifier)
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Token UnresolvedModifier)
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT
  (Error v)
  Input
  (ReaderT (ParsingEnv m) m)
  (Token UnresolvedModifier)
forall {m :: * -> *}.
ParsecT
  (Error v)
  Input
  (ReaderT (ParsingEnv m) m)
  (Token UnresolvedModifier)
structural)
  where
    unique :: ParsecT
  (Error v)
  Input
  (ReaderT (ParsingEnv m) m)
  (Token UnresolvedModifier)
unique = do
      Token ()
tok <- String -> P v m (Token ())
forall v (m :: * -> *). Ord v => String -> P v m (Token ())
openBlockWith String
"unique"
      ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token Name)
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Maybe (Token Name))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (String -> P v m (Token ())
forall v (m :: * -> *). Ord v => String -> P v m (Token ())
openBlockWith String
"[" P v m (Token ())
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token Name)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token Name)
forall a b.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token Name)
forall v (m :: * -> *). Ord v => P v m (Token Name)
importWordyId ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token Name)
-> P v m (Token ())
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token Name)
forall a b.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P v m (Token ())
forall v (m :: * -> *). Ord v => P v m (Token ())
closeBlock) ParsecT
  (Error v) Input (ReaderT (ParsingEnv m) m) (Maybe (Token Name))
-> (Maybe (Token Name)
    -> ParsecT
         (Error v)
         Input
         (ReaderT (ParsingEnv m) m)
         (Token UnresolvedModifier))
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Token UnresolvedModifier)
forall a b.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> (a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe (Token Name)
Nothing -> Token UnresolvedModifier
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Token UnresolvedModifier)
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UnresolvedModifier
UnresolvedModifier'UniqueWithoutGuid UnresolvedModifier -> Token () -> Token UnresolvedModifier
forall a b. a -> Token b -> Token a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token ()
tok)
        Just Token Name
guid -> Token UnresolvedModifier
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Token UnresolvedModifier)
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> UnresolvedModifier
UnresolvedModifier'UniqueWithGuid (Name -> Text
Name.toText (Token Name -> Name
forall a. Token a -> a
L.payload Token Name
guid)) UnresolvedModifier -> Token () -> Token UnresolvedModifier
forall a b. a -> Token b -> Token a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token ()
tok)
    structural :: ParsecT
  (Error v)
  Input
  (ReaderT (ParsingEnv m) m)
  (Token UnresolvedModifier)
structural = do
      Token ()
tok <- String -> P v m (Token ())
forall v (m :: * -> *). Ord v => String -> P v m (Token ())
openBlockWith String
"structural"
      pure (UnresolvedModifier
UnresolvedModifier'Structural UnresolvedModifier -> Token () -> Token UnresolvedModifier
forall a b. a -> Token b -> Token a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token ()
tok)

synDeclP :: (Monad m, Var v) => P v m (SynDecl v)
synDeclP :: forall (m :: * -> *) v. (Monad m, Var v) => P v m (SynDecl v)
synDeclP = do
  Maybe (Token UnresolvedModifier)
modifier <- P v m (Maybe (Token UnresolvedModifier))
forall (m :: * -> *) v.
(Monad m, Var v) =>
P v m (Maybe (Token UnresolvedModifier))
modifierP
  SynEffectDecl v -> SynDecl v
forall v. SynEffectDecl v -> SynDecl v
SynDecl'Effect (SynEffectDecl v -> SynDecl v)
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (SynEffectDecl v)
-> P v m (SynDecl v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Token UnresolvedModifier)
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (SynEffectDecl v)
forall (m :: * -> *) v.
(Monad m, Var v) =>
Maybe (Token UnresolvedModifier) -> P v m (SynEffectDecl v)
synEffectDeclP Maybe (Token UnresolvedModifier)
modifier P v m (SynDecl v) -> P v m (SynDecl v) -> P v m (SynDecl v)
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SynDataDecl v -> SynDecl v
forall v. SynDataDecl v -> SynDecl v
SynDecl'Data (SynDataDecl v -> SynDecl v)
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (SynDataDecl v)
-> P v m (SynDecl v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Token UnresolvedModifier)
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (SynDataDecl v)
forall (m :: * -> *) v.
(Monad m, Var v) =>
Maybe (Token UnresolvedModifier) -> P v m (SynDataDecl v)
synDataDeclP Maybe (Token UnresolvedModifier)
modifier

synDataDeclP :: forall m v. (Monad m, Var v) => Maybe (L.Token UnresolvedModifier) -> P v m (SynDataDecl v)
synDataDeclP :: forall (m :: * -> *) v.
(Monad m, Var v) =>
Maybe (Token UnresolvedModifier) -> P v m (SynDataDecl v)
synDataDeclP Maybe (Token UnresolvedModifier)
modifier0 = do
  Token ()
typeToken <- (Token String -> Token ())
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Token String)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
forall a b.
(a -> b)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Token String -> Token ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (String
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Token String)
forall v (m :: * -> *). Ord v => String -> P v m (Token String)
reserved String
"type") ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
forall v (m :: * -> *). Ord v => String -> P v m (Token ())
openBlockWith String
"type"
  (Token v
name, [Token v]
typeArgs) <- (,) (Token v -> [Token v] -> (Token v, [Token v]))
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token v)
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     ([Token v] -> (Token v, [Token v]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token v)
prefixVar ParsecT
  (Error v)
  Input
  (ReaderT (ParsingEnv m) m)
  ([Token v] -> (Token v, [Token v]))
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) [Token v]
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Token v, [Token v])
forall a b.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (a -> b)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token v)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) [Token v]
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token v)
prefixVar
  let tyvars :: [v]
tyvars = Token v -> v
forall a. Token a -> a
L.payload (Token v -> v) -> [Token v] -> [v]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Token v]
typeArgs
  Token String
eq <- String
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Token String)
forall v (m :: * -> *). Ord v => String -> P v m (Token String)
reserved String
"="
  let -- go gives the type of the constructor, given the types of
      -- the constructor arguments, e.g. Cons becomes forall a . a -> List a -> List a
      go :: L.Token v -> [Type v Ann] -> (Ann {- Ann spanning the constructor and its args -}, (Ann, v, Type v Ann))
      go :: Token v -> [Type v Ann] -> (Ann, (Ann, v, Type v Ann))
go Token v
ctorName [Type v Ann]
ctorArgs =
        let arrow :: Term F v Ann -> Term F v Ann -> Term F v Ann
arrow Term F v Ann
i Term F v Ann
o = Ann -> Term F v Ann -> Term F v Ann -> Term F v Ann
forall v a. Ord v => a -> Type v a -> Type v a -> Type v a
Type.arrow (Term F v Ann -> Ann
forall a. Annotated a => a -> Ann
ann Term F v Ann
i Ann -> Ann -> Ann
forall a. Semigroup a => a -> a -> a
<> Term F v Ann -> Ann
forall a. Annotated a => a -> Ann
ann Term F v Ann
o) Term F v Ann
i Term F v Ann
o
            app :: Term F v Ann -> Term F v Ann -> Term F v Ann
app Term F v Ann
f Term F v Ann
arg = Ann -> Term F v Ann -> Term F v Ann -> Term F v Ann
forall v a. Ord v => a -> Type v a -> Type v a -> Type v a
Type.app (Term F v Ann -> Ann
forall a. Annotated a => a -> Ann
ann Term F v Ann
f Ann -> Ann -> Ann
forall a. Semigroup a => a -> a -> a
<> Term F v Ann -> Ann
forall a. Annotated a => a -> Ann
ann Term F v Ann
arg) Term F v Ann
f Term F v Ann
arg
            -- ctorReturnType e.g. `Optional a`
            ctorReturnType :: Type v Ann
ctorReturnType = (Type v Ann -> Type v Ann -> Type v Ann)
-> Type v Ann -> [Type v Ann] -> Type v Ann
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Type v Ann -> Type v Ann -> Type v Ann
forall {v}. Ord v => Term F v Ann -> Term F v Ann -> Term F v Ann
app ((Ann -> v -> Type v Ann) -> Token v -> Type v Ann
forall a b. (Ann -> a -> b) -> Token a -> b
tok Ann -> v -> Type v Ann
forall v a. Ord v => a -> v -> Type v a
Type.var Token v
name) ((Ann -> v -> Type v Ann) -> Token v -> Type v Ann
forall a b. (Ann -> a -> b) -> Token a -> b
tok Ann -> v -> Type v Ann
forall v a. Ord v => a -> v -> Type v a
Type.var (Token v -> Type v Ann) -> [Token v] -> [Type v Ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Token v]
typeArgs)
            -- ctorType e.g. `a -> Optional a`
            --    or just `Optional a` in the case of `None`
            ctorType :: Type v Ann
ctorType = (Type v Ann -> Type v Ann -> Type v Ann)
-> Type v Ann -> [Type v Ann] -> Type v Ann
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Type v Ann -> Type v Ann -> Type v Ann
forall {v}. Ord v => Term F v Ann -> Term F v Ann -> Term F v Ann
arrow Type v Ann
ctorReturnType [Type v Ann]
ctorArgs
            ctorAnn :: Ann
ctorAnn = Token v -> Ann
forall a. Annotated a => a -> Ann
ann Token v
ctorName Ann -> Ann -> Ann
forall a. Semigroup a => a -> a -> a
<> Ann -> (Type v Ann -> Ann) -> Maybe (Type v Ann) -> Ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Ann
forall a. Monoid a => a
mempty Type v Ann -> Ann
forall a. Annotated a => a -> Ann
ann ([Type v Ann] -> Maybe (Type v Ann)
forall a. [a] -> Maybe a
lastMay [Type v Ann]
ctorArgs)
         in ( Ann
ctorAnn,
              ( Token v -> Ann
forall a. Annotated a => a -> Ann
ann Token v
ctorName,
                NonEmpty v -> v
forall v. Var v => NonEmpty v -> v
Var.namespaced (Token v -> v
forall a. Token a -> a
L.payload Token v
name v -> [v] -> NonEmpty v
forall a. a -> [a] -> NonEmpty a
:| [Token v -> v
forall a. Token a -> a
L.payload Token v
ctorName]),
                Ann -> [v] -> Type v Ann -> Type v Ann
forall v a. Ord v => a -> [v] -> Type v a -> Type v a
Type.foralls Ann
ctorAnn [v]
tyvars Type v Ann
ctorType
              )
            )
      record :: P v m ((Ann, v, Type v Ann), Maybe [(L.Token v, Type v Ann)], Ann)
      record :: P v m ((Ann, v, Type v Ann), Maybe [(Token v, Type v Ann)], Ann)
record = do
        Token ()
_ <- String
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
forall v (m :: * -> *). Ord v => String -> P v m (Token ())
openBlockWith String
"{"
        let field :: P v m [(L.Token v, Type v Ann)]
            field :: P v m [(Token v, Type v Ann)]
field = do
              (Token v, Type v Ann)
f <- (Token v -> Type v Ann -> (Token v, Type v Ann))
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token v)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Type v Ann)
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Token v, Type v Ann)
forall a b c.
(a -> b -> c)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token v)
prefixVar ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token v)
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Token String)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token v)
forall a b.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Token String)
forall v (m :: * -> *). Ord v => String -> P v m (Token String)
reserved String
":") ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Type v Ann)
forall (m :: * -> *) v. (Monad m, Var v) => TypeP v m
TypeParser.valueType
              ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token String)
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Maybe (Token String))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (String
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Token String)
forall v (m :: * -> *). Ord v => String -> P v m (Token String)
reserved String
",") ParsecT
  (Error v) Input (ReaderT (ParsingEnv m) m) (Maybe (Token String))
-> (Maybe (Token String) -> P v m [(Token v, Type v Ann)])
-> P v m [(Token v, Type v Ann)]
forall a b.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> (a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Maybe (Token String)
Nothing -> [(Token v, Type v Ann)] -> P v m [(Token v, Type v Ann)]
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(Token v, Type v Ann)
f]
                Just Token String
_ -> [(Token v, Type v Ann)]
-> ([(Token v, Type v Ann)] -> [(Token v, Type v Ann)])
-> Maybe [(Token v, Type v Ann)]
-> [(Token v, Type v Ann)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [(Token v, Type v Ann)
f] ((Token v, Type v Ann)
f (Token v, Type v Ann)
-> [(Token v, Type v Ann)] -> [(Token v, Type v Ann)]
forall a. a -> [a] -> [a]
:) (Maybe [(Token v, Type v Ann)] -> [(Token v, Type v Ann)])
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Maybe [(Token v, Type v Ann)])
-> P v m [(Token v, Type v Ann)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Maybe (Token ()))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
forall v (m :: * -> *). Ord v => P v m (Token ())
semi ParsecT
  (Error v) Input (ReaderT (ParsingEnv m) m) (Maybe (Token ()))
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Maybe [(Token v, Type v Ann)])
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Maybe [(Token v, Type v Ann)])
forall a b.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P v m [(Token v, Type v Ann)]
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Maybe [(Token v, Type v Ann)])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional P v m [(Token v, Type v Ann)]
field)
        [(Token v, Type v Ann)]
fields <- P v m [(Token v, Type v Ann)]
field
        Token ()
closingToken <- ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
forall v (m :: * -> *). Ord v => P v m (Token ())
closeBlock
        let lastSegment :: Token v
lastSegment = Token v
name Token v -> (v -> v) -> Token v
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (\v
v -> Text -> v
forall v. Var v => Text -> v
Var.named (Name -> Text
Name.toText (Name -> Text) -> Name -> Text
forall a b. (a -> b) -> a -> b
$ Name -> Name
Name.unqualified (v -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar v
v)))
        pure ((Ann, (Ann, v, Type v Ann)) -> (Ann, v, Type v Ann)
forall a b. (a, b) -> b
snd (Token v -> [Type v Ann] -> (Ann, (Ann, v, Type v Ann))
go Token v
lastSegment ((Token v, Type v Ann) -> Type v Ann
forall a b. (a, b) -> b
snd ((Token v, Type v Ann) -> Type v Ann)
-> [(Token v, Type v Ann)] -> [Type v Ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Token v, Type v Ann)]
fields)), [(Token v, Type v Ann)] -> Maybe [(Token v, Type v Ann)]
forall a. a -> Maybe a
Just [(Token v, Type v Ann)]
fields, Token () -> Ann
forall a. Annotated a => a -> Ann
ann Token ()
closingToken)
  P v m ((Ann, v, Type v Ann), Maybe [(Token v, Type v Ann)], Ann)
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Maybe ((Ann, v, Type v Ann), Maybe [(Token v, Type v Ann)], Ann))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional P v m ((Ann, v, Type v Ann), Maybe [(Token v, Type v Ann)], Ann)
record ParsecT
  (Error v)
  Input
  (ReaderT (ParsingEnv m) m)
  (Maybe ((Ann, v, Type v Ann), Maybe [(Token v, Type v Ann)], Ann))
-> (Maybe
      ((Ann, v, Type v Ann), Maybe [(Token v, Type v Ann)], Ann)
    -> P v m (SynDataDecl v))
-> P v m (SynDataDecl v)
forall a b.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> (a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe ((Ann, v, Type v Ann), Maybe [(Token v, Type v Ann)], Ann)
Nothing -> do
      [(Ann, (Ann, v, Type v Ann))]
constructors <- ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token String)
-> P v m (Ann, (Ann, v, Type v Ann))
-> P v m [(Ann, (Ann, v, Type v Ann))]
forall v (m :: * -> *) a b.
Ord v =>
P v m a -> P v m b -> P v m [b]
sepBy (String
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Token String)
forall v (m :: * -> *). Ord v => String -> P v m (Token String)
reserved String
"|") (Token v -> [Type v Ann] -> (Ann, (Ann, v, Type v Ann))
go (Token v -> [Type v Ann] -> (Ann, (Ann, v, Type v Ann)))
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token v)
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     ([Type v Ann] -> (Ann, (Ann, v, Type v Ann)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token v)
prefixVar ParsecT
  (Error v)
  Input
  (ReaderT (ParsingEnv m) m)
  ([Type v Ann] -> (Ann, (Ann, v, Type v Ann)))
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) [Type v Ann]
-> P v m (Ann, (Ann, v, Type v Ann))
forall a b.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (a -> b)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Type v Ann)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) [Type v Ann]
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Type v Ann)
forall (m :: * -> *) v. (Monad m, Var v) => TypeP v m
TypeParser.valueTypeLeaf)
      Token ()
_ <- ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
forall v (m :: * -> *). Ord v => P v m (Token ())
closeBlock
      let closingAnn :: Ann
          closingAnn :: Ann
closingAnn = NonEmpty Ann -> Ann
forall a. NonEmpty a -> a
NonEmpty.last (Token String -> Ann
forall a. Annotated a => a -> Ann
ann Token String
eq Ann -> [Ann] -> NonEmpty Ann
forall a. a -> [a] -> NonEmpty a
NonEmpty.:| ((\(Ann
constrSpanAnn, (Ann, v, Type v Ann)
_) -> Ann
constrSpanAnn) ((Ann, (Ann, v, Type v Ann)) -> Ann)
-> [(Ann, (Ann, v, Type v Ann))] -> [Ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Ann, (Ann, v, Type v Ann))]
constructors))
      Modifier
modifier <- Token v -> Maybe (Token UnresolvedModifier) -> P v m Modifier
forall (m :: * -> *) v.
(Monad m, Var v) =>
Token v -> Maybe (Token UnresolvedModifier) -> P v m Modifier
resolveModifier Token v
name Maybe (Token UnresolvedModifier)
modifier0
      pure
        SynDataDecl
          { $sel:annotation:SynDataDecl :: Ann
annotation = Ann
-> (Token UnresolvedModifier -> Ann)
-> Maybe (Token UnresolvedModifier)
-> Ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Token () -> Ann
forall a. Annotated a => a -> Ann
ann Token ()
typeToken) Token UnresolvedModifier -> Ann
forall a. Annotated a => a -> Ann
ann Maybe (Token UnresolvedModifier)
modifier0 Ann -> Ann -> Ann
forall a. Semigroup a => a -> a -> a
<> Ann
closingAnn,
            $sel:constructors:SynDataDecl :: [(Ann, v, Type v Ann)]
constructors = (Ann, (Ann, v, Type v Ann)) -> (Ann, v, Type v Ann)
forall a b. (a, b) -> b
snd ((Ann, (Ann, v, Type v Ann)) -> (Ann, v, Type v Ann))
-> [(Ann, (Ann, v, Type v Ann))] -> [(Ann, v, Type v Ann)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Ann, (Ann, v, Type v Ann))]
constructors,
            $sel:fields:SynDataDecl :: Maybe [(Token v, Type v Ann)]
fields = Maybe [(Token v, Type v Ann)]
forall a. Maybe a
Nothing,
            Modifier
$sel:modifier:SynDataDecl :: Modifier
modifier :: Modifier
modifier,
            Token v
$sel:name:SynDataDecl :: Token v
name :: Token v
name,
            [v]
$sel:tyvars:SynDataDecl :: [v]
tyvars :: [v]
tyvars
          }
    Just ((Ann, v, Type v Ann)
constructor, Maybe [(Token v, Type v Ann)]
fields, Ann
closingAnn) -> do
      Token ()
_ <- ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
forall v (m :: * -> *). Ord v => P v m (Token ())
closeBlock
      Modifier
modifier <- Token v -> Maybe (Token UnresolvedModifier) -> P v m Modifier
forall (m :: * -> *) v.
(Monad m, Var v) =>
Token v -> Maybe (Token UnresolvedModifier) -> P v m Modifier
resolveModifier Token v
name Maybe (Token UnresolvedModifier)
modifier0
      pure
        SynDataDecl
          { $sel:annotation:SynDataDecl :: Ann
annotation = Ann
-> (Token UnresolvedModifier -> Ann)
-> Maybe (Token UnresolvedModifier)
-> Ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Token () -> Ann
forall a. Annotated a => a -> Ann
ann Token ()
typeToken) Token UnresolvedModifier -> Ann
forall a. Annotated a => a -> Ann
ann Maybe (Token UnresolvedModifier)
modifier0 Ann -> Ann -> Ann
forall a. Semigroup a => a -> a -> a
<> Ann
closingAnn,
            $sel:constructors:SynDataDecl :: [(Ann, v, Type v Ann)]
constructors = [(Ann, v, Type v Ann)
constructor],
            Maybe [(Token v, Type v Ann)]
$sel:fields:SynDataDecl :: Maybe [(Token v, Type v Ann)]
fields :: Maybe [(Token v, Type v Ann)]
fields,
            Modifier
$sel:modifier:SynDataDecl :: Modifier
modifier :: Modifier
modifier,
            Token v
$sel:name:SynDataDecl :: Token v
name :: Token v
name,
            [v]
$sel:tyvars:SynDataDecl :: [v]
tyvars :: [v]
tyvars
          }
  where
    prefixVar :: P v m (L.Token v)
    prefixVar :: ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token v)
prefixVar =
      ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token v)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token v)
forall v (m :: * -> *). Var v => P v m (Token v) -> P v m (Token v)
TermParser.verifyRelativeVarName ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token v)
forall v (m :: * -> *). Var v => P v m (Token v)
prefixDefinitionName

synEffectDeclP :: forall m v. (Monad m, Var v) => Maybe (L.Token UnresolvedModifier) -> P v m (SynEffectDecl v)
synEffectDeclP :: forall (m :: * -> *) v.
(Monad m, Var v) =>
Maybe (Token UnresolvedModifier) -> P v m (SynEffectDecl v)
synEffectDeclP Maybe (Token UnresolvedModifier)
modifier0 = do
  Token ()
abilityToken <- (Token String -> Token ())
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Token String)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
forall a b.
(a -> b)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Token String -> Token ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (String
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Token String)
forall v (m :: * -> *). Ord v => String -> P v m (Token String)
reserved String
"ability") ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
forall v (m :: * -> *). Ord v => String -> P v m (Token ())
openBlockWith String
"ability"
  Token v
name <- P v m (Token v) -> P v m (Token v)
forall v (m :: * -> *). Var v => P v m (Token v) -> P v m (Token v)
TermParser.verifyRelativeVarName P v m (Token v)
forall v (m :: * -> *). Var v => P v m (Token v)
prefixDefinitionName
  [Token v]
typeArgs <- P v m (Token v)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) [Token v]
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (P v m (Token v) -> P v m (Token v)
forall v (m :: * -> *). Var v => P v m (Token v) -> P v m (Token v)
TermParser.verifyRelativeVarName P v m (Token v)
forall v (m :: * -> *). Var v => P v m (Token v)
prefixDefinitionName)
  Token ()
blockStart <- String
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
forall v (m :: * -> *). Ord v => String -> P v m (Token ())
openBlockWith String
"where"
  [(Ann, v, Type v Ann)]
constructors <- ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
-> P v m (Ann, v, Type v Ann) -> P v m [(Ann, v, Type v Ann)]
forall v (m :: * -> *) a b.
Ord v =>
P v m a -> P v m b -> P v m [b]
sepBy ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
forall v (m :: * -> *). Ord v => P v m (Token ())
semi ([Token v] -> Token v -> P v m (Ann, v, Type v Ann)
forall (m :: * -> *) v.
(Monad m, Var v) =>
[Token v] -> Token v -> P v m (Ann, v, Type v Ann)
effectConstructorP [Token v]
typeArgs Token v
name)
  -- `ability` opens a block, as does `where`
  Token ()
_ <- ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
forall v (m :: * -> *). Ord v => P v m (Token ())
closeBlock ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
forall a b.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
forall v (m :: * -> *). Ord v => P v m (Token ())
closeBlock
  let closingAnn :: Ann
closingAnn =
        [Ann] -> Ann
forall a. HasCallStack => [a] -> a
last ([Ann] -> Ann) -> [Ann] -> Ann
forall a b. (a -> b) -> a -> b
$ Token () -> Ann
forall a. Annotated a => a -> Ann
ann Token ()
blockStart Ann -> [Ann] -> [Ann]
forall a. a -> [a] -> [a]
: ((\(Ann
_, v
_, Type v Ann
t) -> Type v Ann -> Ann
forall a. Annotated a => a -> Ann
ann Type v Ann
t) ((Ann, v, Type v Ann) -> Ann) -> [(Ann, v, Type v Ann)] -> [Ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Ann, v, Type v Ann)]
constructors)
  Modifier
modifier <- Token v -> Maybe (Token UnresolvedModifier) -> P v m Modifier
forall (m :: * -> *) v.
(Monad m, Var v) =>
Token v -> Maybe (Token UnresolvedModifier) -> P v m Modifier
resolveModifier Token v
name Maybe (Token UnresolvedModifier)
modifier0
  pure
    SynEffectDecl
      { $sel:annotation:SynEffectDecl :: Ann
annotation = Ann
-> (Token UnresolvedModifier -> Ann)
-> Maybe (Token UnresolvedModifier)
-> Ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Token () -> Ann
forall a. Annotated a => a -> Ann
ann Token ()
abilityToken) Token UnresolvedModifier -> Ann
forall a. Annotated a => a -> Ann
ann Maybe (Token UnresolvedModifier)
modifier0 Ann -> Ann -> Ann
forall a. Semigroup a => a -> a -> a
<> Ann
closingAnn,
        [(Ann, v, Type v Ann)]
$sel:constructors:SynEffectDecl :: [(Ann, v, Type v Ann)]
constructors :: [(Ann, v, Type v Ann)]
constructors,
        Modifier
$sel:modifier:SynEffectDecl :: Modifier
modifier :: Modifier
modifier,
        Token v
$sel:name:SynEffectDecl :: Token v
name :: Token v
name,
        $sel:tyvars:SynEffectDecl :: [v]
tyvars = Token v -> v
forall a. Token a -> a
L.payload (Token v -> v) -> [Token v] -> [v]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Token v]
typeArgs
      }

effectConstructorP :: (Monad m, Var v) => [L.Token v] -> L.Token v -> P v m (Ann, v, Type v Ann)
effectConstructorP :: forall (m :: * -> *) v.
(Monad m, Var v) =>
[Token v] -> Token v -> P v m (Ann, v, Type v Ann)
effectConstructorP [Token v]
typeArgs Token v
name =
  Token v -> Type v Ann -> (Ann, v, Type v Ann)
explodeToken
    (Token v -> Type v Ann -> (Ann, v, Type v Ann))
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token v)
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Type v Ann -> (Ann, v, Type v Ann))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token v)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token v)
forall v (m :: * -> *). Var v => P v m (Token v) -> P v m (Token v)
TermParser.verifyRelativeVarName ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token v)
forall v (m :: * -> *). Var v => P v m (Token v)
prefixDefinitionName
    ParsecT
  (Error v)
  Input
  (ReaderT (ParsingEnv m) m)
  (Type v Ann -> (Ann, v, Type v Ann))
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Token String)
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Type v Ann -> (Ann, v, Type v Ann))
forall a b.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Token String)
forall v (m :: * -> *). Ord v => String -> P v m (Token String)
reserved String
":"
    ParsecT
  (Error v)
  Input
  (ReaderT (ParsingEnv m) m)
  (Type v Ann -> (Ann, v, Type v Ann))
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Type v Ann)
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Ann, v, Type v Ann)
forall a b.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (a -> b)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Set v -> Type v Ann -> Type v Ann
forall v a. Var v => Set v -> Type v a -> Type v a
Type.generalizeLowercase Set v
forall a. Monoid a => a
mempty
            (Type v Ann -> Type v Ann)
-> (Type v Ann -> Type v Ann) -> Type v Ann -> Type v Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type v Ann -> Type v Ann
ensureEffect
            (Type v Ann -> Type v Ann)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Type v Ann)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Type v Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Type v Ann)
forall (m :: * -> *) v. (Monad m, Var v) => TypeP v m
TypeParser.computationType
        )
  where
    explodeToken :: Token v -> Type v Ann -> (Ann, v, Type v Ann)
explodeToken Token v
v Type v Ann
t = (Token v -> Ann
forall a. Annotated a => a -> Ann
ann Token v
v, NonEmpty v -> v
forall v. Var v => NonEmpty v -> v
Var.namespaced (Token v -> v
forall a. Token a -> a
L.payload Token v
name v -> [v] -> NonEmpty v
forall a. a -> [a] -> NonEmpty a
:| [Token v -> v
forall a. Token a -> a
L.payload Token v
v]), Type v Ann
t)
    -- If the effect is not syntactically present in the constructor types,
    -- add them after parsing.
    ensureEffect :: Type v Ann -> Type v Ann
ensureEffect Type v Ann
t = case Type v Ann
t of
      Type.Effect' [Type v Ann]
_ Type v Ann
_ -> Type v Ann -> Type v Ann
modEffect Type v Ann
t
      Type v Ann
x -> (Type v Ann -> Type v Ann) -> Type v Ann -> Type v Ann
forall v a. Ord v => (Type v a -> Type v a) -> Type v a -> Type v a
Type.editFunctionResult Type v Ann -> Type v Ann
modEffect Type v Ann
x
    modEffect :: Type v Ann -> Type v Ann
modEffect Type v Ann
t = case Type v Ann
t of
      Type.Effect' [Type v Ann]
es Type v Ann
t -> [Type v Ann] -> Type v Ann -> Type v Ann
go [Type v Ann]
es Type v Ann
t
      Type v Ann
t -> [Type v Ann] -> Type v Ann -> Type v Ann
go [] Type v Ann
t
    toTypeVar :: Token v -> Type v Ann
toTypeVar Token v
t = Ann -> Text -> Type v Ann
forall v a. Var v => a -> Text -> Type v a
Type.av' (Token v -> Ann
forall a. Annotated a => a -> Ann
ann Token v
t) (v -> Text
forall v. Var v => v -> Text
Var.name (v -> Text) -> v -> Text
forall a b. (a -> b) -> a -> b
$ Token v -> v
forall a. Token a -> a
L.payload Token v
t)
    headIs :: Type a a -> a -> Bool
headIs Type a a
t a
v = case Type a a
t of
      Type.Apps' (Type.Var' a
x) [Type a a]
_ -> a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
v
      Type.Var' a
x -> a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
v
      Type a a
_ -> Bool
False
    go :: [Type v Ann] -> Type v Ann -> Type v Ann
go [Type v Ann]
es Type v Ann
t =
      let es' :: [Type v Ann]
es' =
            if (Type v Ann -> Bool) -> [Type v Ann] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Type v Ann -> v -> Bool
forall {a} {a}. Eq a => Type a a -> a -> Bool
`headIs` Token v -> v
forall a. Token a -> a
L.payload Token v
name) [Type v Ann]
es
              then [Type v Ann]
es
              else Type v Ann -> [Type v Ann] -> Type v Ann
forall a v.
(Semigroup a, Ord v) =>
Type v a -> [Type v a] -> Type v a
Type.apps' (Token v -> Type v Ann
forall {v} {v}. (Var v, Var v) => Token v -> Type v Ann
toTypeVar Token v
name) (Token v -> Type v Ann
forall {v} {v}. (Var v, Var v) => Token v -> Type v Ann
toTypeVar (Token v -> Type v Ann) -> [Token v] -> [Type v Ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Token v]
typeArgs) Type v Ann -> [Type v Ann] -> [Type v Ann]
forall a. a -> [a] -> [a]
: [Type v Ann]
es
       in Type v Ann -> Type v Ann
forall v a. Var v => Type v a -> Type v a
Type.cleanupAbilityLists (Type v Ann -> Type v Ann) -> Type v Ann -> Type v Ann
forall a b. (a -> b) -> a -> b
$ Ann -> [Type v Ann] -> Type v Ann -> Type v Ann
forall v a. Ord v => a -> [Type v a] -> Type v a -> Type v a
Type.effect (Type v Ann -> Ann
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Type v Ann
t) [Type v Ann]
es' Type v Ann
t

resolveModifier :: (Monad m, Var v) => L.Token v -> Maybe (L.Token UnresolvedModifier) -> P v m DataDeclaration.Modifier
resolveModifier :: forall (m :: * -> *) v.
(Monad m, Var v) =>
Token v -> Maybe (Token UnresolvedModifier) -> P v m Modifier
resolveModifier Token v
name Maybe (Token UnresolvedModifier)
modifier =
  case Token UnresolvedModifier -> UnresolvedModifier
forall a. Token a -> a
L.payload (Token UnresolvedModifier -> UnresolvedModifier)
-> Maybe (Token UnresolvedModifier) -> Maybe UnresolvedModifier
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Token UnresolvedModifier)
modifier of
    Just UnresolvedModifier
UnresolvedModifier'Structural -> Modifier -> P v m Modifier
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Modifier
DataDeclaration.Structural
    Just (UnresolvedModifier'UniqueWithGuid Text
guid) -> Modifier -> P v m Modifier
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Modifier
DataDeclaration.Unique Text
guid)
    Just UnresolvedModifier
UnresolvedModifier'UniqueWithoutGuid -> v -> P v m Modifier
forall (m :: * -> *) v. (Monad m, Var v) => v -> P v m Modifier
resolveUniqueTypeGuid Token v
name.payload
    Maybe UnresolvedModifier
Nothing -> v -> P v m Modifier
forall (m :: * -> *) v. (Monad m, Var v) => v -> P v m Modifier
resolveUniqueTypeGuid Token v
name.payload