module Unison.Syntax.DeclParser
  ( declarations,
  )
where

import Control.Lens
import Control.Monad.Reader (MonadReader (..))
import Data.List.NonEmpty (pattern (:|))
import Data.List.NonEmpty qualified as NonEmpty
import Data.Map qualified as Map
import Text.Megaparsec qualified as P
import Unison.ABT qualified as ABT
import Unison.DataDeclaration (DataDeclaration, EffectDeclaration)
import Unison.DataDeclaration qualified as DD
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)

-- The parsed form of record accessors, as in:
--
-- type Additive a = { zero : a, (+) : a -> a -> a }
--
-- The `Token v` is the variable name and location (here `zero` and `(+)`) of
-- each field, and the type is the type of that field
type Accessors v = [(L.Token v, [(L.Token v, Type v Ann)])]

declarations ::
  (Monad m, Var v) =>
  P
    v
    m
    ( Map v (DataDeclaration v Ann),
      Map v (EffectDeclaration v Ann),
      Accessors v
    )
declarations :: forall (m :: * -> *) v.
(Monad m, Var v) =>
P v
  m
  (Map v (DataDeclaration v Ann), Map v (EffectDeclaration v Ann),
   Accessors v)
declarations = do
  [Either
   (v, DataDeclaration v Ann, Accessors v)
   (v, EffectDeclaration v Ann)]
declarations <- ParsecT
  (Error v)
  Input
  (ReaderT (ParsingEnv m) m)
  (Either
     (v, DataDeclaration v Ann, Accessors v)
     (v, EffectDeclaration v Ann))
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     [Either
        (v, DataDeclaration v Ann, Accessors v)
        (v, EffectDeclaration 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)
   (Either
      (v, DataDeclaration v Ann, Accessors v)
      (v, EffectDeclaration v Ann))
 -> ParsecT
      (Error v)
      Input
      (ReaderT (ParsingEnv m) m)
      [Either
         (v, DataDeclaration v Ann, Accessors v)
         (v, EffectDeclaration v Ann)])
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Either
        (v, DataDeclaration v Ann, Accessors v)
        (v, EffectDeclaration v Ann))
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     [Either
        (v, DataDeclaration v Ann, Accessors v)
        (v, EffectDeclaration v Ann)]
forall a b. (a -> b) -> a -> b
$ ParsecT
  (Error v)
  Input
  (ReaderT (ParsingEnv m) m)
  (Either
     (v, DataDeclaration v Ann, Accessors v)
     (v, EffectDeclaration v Ann))
forall (m :: * -> *) v.
(Monad m, Var v) =>
P v
  m
  (Either
     (v, DataDeclaration v Ann, Accessors v)
     (v, EffectDeclaration v Ann))
declaration ParsecT
  (Error v)
  Input
  (ReaderT (ParsingEnv m) m)
  (Either
     (v, DataDeclaration v Ann, Accessors v)
     (v, EffectDeclaration v Ann))
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Maybe (Token ()))
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Either
        (v, DataDeclaration v Ann, Accessors v)
        (v, EffectDeclaration 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
<* 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
  let ([(v, DataDeclaration v Ann, Accessors v)]
dataDecls0, [(v, EffectDeclaration v Ann)]
effectDecls) = [Either
   (v, DataDeclaration v Ann, Accessors v)
   (v, EffectDeclaration v Ann)]
-> ([(v, DataDeclaration v Ann, Accessors v)],
    [(v, EffectDeclaration v Ann)])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either
   (v, DataDeclaration v Ann, Accessors v)
   (v, EffectDeclaration v Ann)]
declarations
      dataDecls :: [(v, DataDeclaration v Ann)]
dataDecls = [(v
a, DataDeclaration v Ann
b) | (v
a, DataDeclaration v Ann
b, Accessors v
_) <- [(v, DataDeclaration v Ann, Accessors v)]
dataDecls0]
      multimap :: (Ord k) => [(k, v)] -> Map k [v]
      multimap :: forall k v. Ord k => [(k, v)] -> Map k [v]
multimap = (Map k [v] -> (k, v) -> Map k [v])
-> Map k [v] -> [(k, v)] -> Map k [v]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Map k [v] -> (k, v) -> Map k [v]
forall {k} {a}. Ord k => Map k [a] -> (k, a) -> Map k [a]
mi Map k [v]
forall k a. Map k a
Map.empty
      mi :: Map k [a] -> (k, a) -> Map k [a]
mi Map k [a]
m (k
k, a
v) = ([a] -> [a] -> [a]) -> k -> [a] -> Map k [a] -> Map k [a]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++) k
k [a
v] Map k [a]
m
      mds :: Map v [DataDeclaration v Ann]
mds = [(v, DataDeclaration v Ann)] -> Map v [DataDeclaration v Ann]
forall k v. Ord k => [(k, v)] -> Map k [v]
multimap [(v, DataDeclaration v Ann)]
dataDecls
      mes :: Map v [EffectDeclaration v Ann]
mes = [(v, EffectDeclaration v Ann)] -> Map v [EffectDeclaration v Ann]
forall k v. Ord k => [(k, v)] -> Map k [v]
multimap [(v, EffectDeclaration v Ann)]
effectDecls
      mdsBad :: Map v [DataDeclaration v Ann]
mdsBad = ([DataDeclaration v Ann] -> Bool)
-> Map v [DataDeclaration v Ann] -> Map v [DataDeclaration v Ann]
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (\[DataDeclaration v Ann]
xs -> [DataDeclaration v Ann] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [DataDeclaration v Ann]
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1) Map v [DataDeclaration v Ann]
mds
      mesBad :: Map v [EffectDeclaration v Ann]
mesBad = ([EffectDeclaration v Ann] -> Bool)
-> Map v [EffectDeclaration v Ann]
-> Map v [EffectDeclaration v Ann]
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (\[EffectDeclaration v Ann]
xs -> [EffectDeclaration v Ann] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [EffectDeclaration v Ann]
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1) Map v [EffectDeclaration v Ann]
mes
  if Map v [DataDeclaration v Ann] -> Bool
forall k a. Map k a -> Bool
Map.null Map v [DataDeclaration v Ann]
mdsBad Bool -> Bool -> Bool
&& Map v [EffectDeclaration v Ann] -> Bool
forall k a. Map k a -> Bool
Map.null Map v [EffectDeclaration v Ann]
mesBad
    then
      (Map v (DataDeclaration v Ann), Map v (EffectDeclaration v Ann),
 Accessors v)
-> P v
     m
     (Map v (DataDeclaration v Ann), Map v (EffectDeclaration v Ann),
      Accessors v)
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        ( [(v, DataDeclaration v Ann)] -> Map v (DataDeclaration v Ann)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(v, DataDeclaration v Ann)]
dataDecls,
          [(v, EffectDeclaration v Ann)] -> Map v (EffectDeclaration v Ann)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(v, EffectDeclaration v Ann)]
effectDecls,
          [Accessors v] -> Accessors v
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([Accessors v] -> Accessors v)
-> ([(v, DataDeclaration v Ann, Accessors v)] -> [Accessors v])
-> [(v, DataDeclaration v Ann, Accessors v)]
-> Accessors v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((v, DataDeclaration v Ann, Accessors v) -> Accessors v)
-> [(v, DataDeclaration v Ann, Accessors v)] -> [Accessors v]
forall a b. (a -> b) -> [a] -> [b]
map (Getting
  (Accessors v) (v, DataDeclaration v Ann, Accessors v) (Accessors v)
-> (v, DataDeclaration v Ann, Accessors v) -> Accessors v
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Accessors v) (v, DataDeclaration v Ann, Accessors v) (Accessors v)
forall s t a b. Field3 s t a b => Lens s t a b
Lens
  (v, DataDeclaration v Ann, Accessors v)
  (v, DataDeclaration v Ann, Accessors v)
  (Accessors v)
  (Accessors v)
_3) ([(v, DataDeclaration v Ann, Accessors v)] -> Accessors v)
-> [(v, DataDeclaration v Ann, Accessors v)] -> Accessors v
forall a b. (a -> b) -> a -> b
$ [(v, DataDeclaration v Ann, Accessors v)]
dataDecls0
        )
    else
      Error v
-> P v
     m
     (Map v (DataDeclaration v Ann), Map v (EffectDeclaration v Ann),
      Accessors v)
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
P.customFailure (Error v
 -> P v
      m
      (Map v (DataDeclaration v Ann), Map v (EffectDeclaration v Ann),
       Accessors v))
-> ([(v, [Ann])] -> Error v)
-> [(v, [Ann])]
-> P v
     m
     (Map v (DataDeclaration v Ann), Map v (EffectDeclaration v Ann),
      Accessors v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(v, [Ann])] -> Error v
forall v. [(v, [Ann])] -> Error v
DuplicateTypeNames ([(v, [Ann])]
 -> P v
      m
      (Map v (DataDeclaration v Ann), Map v (EffectDeclaration v Ann),
       Accessors v))
-> [(v, [Ann])]
-> P v
     m
     (Map v (DataDeclaration v Ann), Map v (EffectDeclaration v Ann),
      Accessors v)
forall a b. (a -> b) -> a -> b
$
        [(v
v, DataDeclaration v Ann -> Ann
forall v a. DataDeclaration v a -> a
DD.annotation (DataDeclaration v Ann -> Ann) -> [DataDeclaration v Ann] -> [Ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [DataDeclaration v Ann]
ds) | (v
v, [DataDeclaration v Ann]
ds) <- Map v [DataDeclaration v Ann] -> [(v, [DataDeclaration v Ann])]
forall k a. Map k a -> [(k, a)]
Map.toList Map v [DataDeclaration v Ann]
mdsBad]
          [(v, [Ann])] -> [(v, [Ann])] -> [(v, [Ann])]
forall a. Semigroup a => a -> a -> a
<> [(v
v, DataDeclaration v Ann -> Ann
forall v a. DataDeclaration v a -> a
DD.annotation (DataDeclaration v Ann -> Ann)
-> (EffectDeclaration v Ann -> DataDeclaration v Ann)
-> EffectDeclaration v Ann
-> Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EffectDeclaration v Ann -> DataDeclaration v Ann
forall v a. EffectDeclaration v a -> DataDeclaration v a
DD.toDataDecl (EffectDeclaration v Ann -> Ann)
-> [EffectDeclaration v Ann] -> [Ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [EffectDeclaration v Ann]
es) | (v
v, [EffectDeclaration v Ann]
es) <- Map v [EffectDeclaration v Ann] -> [(v, [EffectDeclaration v Ann])]
forall k a. Map k a -> [(k, a)]
Map.toList Map v [EffectDeclaration v Ann]
mesBad]

-- | 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
  | -- The Text here is a random GUID that we *may not end up using*, as in the case when we instead have a GUID to
    -- reuse (which we will discover soon, once we parse this unique type's name and pass it into the `uniqueTypeGuid`
    -- function in the parser environment).
    --
    -- However, we generate this GUID anyway for backwards-compatibility with *transcripts*. Since the GUID we assign
    -- is a function of the current source location in the parser state, if we generate it later (after moving a few
    -- tokens ahead to the type's name), then we'll get a different value.
    --
    -- This is only done to make the transcript diff smaller and easier to review, as the PR that adds this GUID-reuse
    -- feature ought not to change any hashes. However, at any point after it lands in trunk, this Text could be
    -- removed from this constructor, the generation of these GUIDs could be delayed until we actually need them, and
    -- the transcripts could all be re-generated.
    UnresolvedModifier'UniqueWithoutGuid !Text

resolveUnresolvedModifier :: (Monad m, Var v) => L.Token UnresolvedModifier -> v -> P v m (L.Token DD.Modifier)
resolveUnresolvedModifier :: forall (m :: * -> *) v.
(Monad m, Var v) =>
Token UnresolvedModifier -> v -> P v m (Token Modifier)
resolveUnresolvedModifier Token UnresolvedModifier
unresolvedModifier v
var =
  case Token UnresolvedModifier -> UnresolvedModifier
forall a. Token a -> a
L.payload Token UnresolvedModifier
unresolvedModifier of
    UnresolvedModifier
UnresolvedModifier'Structural -> Token Modifier -> P v m (Token Modifier)
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Modifier
DD.Structural Modifier -> Token UnresolvedModifier -> Token Modifier
forall a b. a -> Token b -> Token a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token UnresolvedModifier
unresolvedModifier)
    UnresolvedModifier'UniqueWithGuid Text
guid -> Token Modifier -> P v m (Token Modifier)
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Modifier
DD.Unique Text
guid Modifier -> Token UnresolvedModifier -> Token Modifier
forall a b. a -> Token b -> Token a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token UnresolvedModifier
unresolvedModifier)
    UnresolvedModifier'UniqueWithoutGuid Text
guid0 -> do
      Modifier
unique <- v -> Text -> P v m Modifier
forall (m :: * -> *) v.
(Monad m, Var v) =>
v -> Text -> P v m Modifier
resolveUniqueModifier v
var Text
guid0
      pure $ Modifier
unique Modifier -> Token UnresolvedModifier -> Token Modifier
forall a b. a -> Token b -> Token a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token UnresolvedModifier
unresolvedModifier

resolveUniqueModifier :: (Monad m, Var v) => v -> Text -> P v m DD.Modifier
resolveUniqueModifier :: forall (m :: * -> *) v.
(Monad m, Var v) =>
v -> Text -> P v m Modifier
resolveUniqueModifier v
var Text
guid0 = do
  ParsingEnv {Name -> m (Maybe Text)
uniqueTypeGuid :: Name -> m (Maybe Text)
$sel:uniqueTypeGuid:ParsingEnv :: forall (m :: * -> *). ParsingEnv m -> Name -> m (Maybe Text)
uniqueTypeGuid} <- ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (ParsingEnv m)
forall r (m :: * -> *). MonadReader r m => m r
ask
  Text
guid <- Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
guid0 (Maybe Text -> Text)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Maybe Text)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT (ParsingEnv m) m (Maybe Text)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Maybe Text)
forall (m :: * -> *) a.
Monad m =>
m a -> ParsecT (Error v) Input m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe Text) -> ReaderT (ParsingEnv m) m (Maybe Text)
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (ParsingEnv m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Name -> m (Maybe Text)
uniqueTypeGuid (v -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar v
var)))
  pure $ Text -> Modifier
DD.Unique Text
guid

defaultUniqueModifier :: (Monad m, Var v) => v -> P v m DD.Modifier
defaultUniqueModifier :: forall (m :: * -> *) v. (Monad m, Var v) => v -> P v m Modifier
defaultUniqueModifier v
var =
  Int -> P v m Text
forall (m :: * -> *) v. (Monad m, Var v) => Int -> P v m Text
uniqueName Int
32 P v m Text
-> (Text
    -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) Modifier)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) Modifier
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
>>= v
-> Text
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) Modifier
forall (m :: * -> *) v.
(Monad m, Var v) =>
v -> Text -> P v m Modifier
resolveUniqueModifier v
var

-- unique[someguid] type Blah = ...
modifier :: (Monad m, Var v) => P v m (Maybe (L.Token UnresolvedModifier))
modifier :: forall (m :: * -> *) v.
(Monad m, Var v) =>
P v m (Maybe (Token UnresolvedModifier))
modifier = 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)
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 -> do
          Text
guid <- Int -> P v m Text
forall (m :: * -> *) v. (Monad m, Var v) => Int -> P v m Text
uniqueName Int
32
          pure (Text -> UnresolvedModifier
UnresolvedModifier'UniqueWithoutGuid Text
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)
        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)

declaration ::
  (Monad m, Var v) =>
  P
    v
    m
    ( Either
        (v, DataDeclaration v Ann, Accessors v)
        (v, EffectDeclaration v Ann)
    )
declaration :: forall (m :: * -> *) v.
(Monad m, Var v) =>
P v
  m
  (Either
     (v, DataDeclaration v Ann, Accessors v)
     (v, EffectDeclaration v Ann))
declaration = do
  Maybe (Token UnresolvedModifier)
mod <- P v m (Maybe (Token UnresolvedModifier))
forall (m :: * -> *) v.
(Monad m, Var v) =>
P v m (Maybe (Token UnresolvedModifier))
modifier
  ((v, EffectDeclaration v Ann)
 -> Either
      (v, DataDeclaration v Ann, Accessors v)
      (v, EffectDeclaration v Ann))
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (v, EffectDeclaration v Ann)
-> P v
     m
     (Either
        (v, DataDeclaration v Ann, Accessors v)
        (v, EffectDeclaration v Ann))
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 (v, EffectDeclaration v Ann)
-> Either
     (v, DataDeclaration v Ann, Accessors v)
     (v, EffectDeclaration v Ann)
forall a b. b -> Either a b
Right (Maybe (Token UnresolvedModifier)
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (v, EffectDeclaration v Ann)
forall (m :: * -> *) v.
(Monad m, Var v) =>
Maybe (Token UnresolvedModifier)
-> P v m (v, EffectDeclaration v Ann)
effectDeclaration Maybe (Token UnresolvedModifier)
mod) P v
  m
  (Either
     (v, DataDeclaration v Ann, Accessors v)
     (v, EffectDeclaration v Ann))
-> P v
     m
     (Either
        (v, DataDeclaration v Ann, Accessors v)
        (v, EffectDeclaration v Ann))
-> P v
     m
     (Either
        (v, DataDeclaration v Ann, Accessors v)
        (v, EffectDeclaration v Ann))
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
<|> ((v, DataDeclaration v Ann, Accessors v)
 -> Either
      (v, DataDeclaration v Ann, Accessors v)
      (v, EffectDeclaration v Ann))
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (v, DataDeclaration v Ann, Accessors v)
-> P v
     m
     (Either
        (v, DataDeclaration v Ann, Accessors v)
        (v, EffectDeclaration v Ann))
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 (v, DataDeclaration v Ann, Accessors v)
-> Either
     (v, DataDeclaration v Ann, Accessors v)
     (v, EffectDeclaration v Ann)
forall a b. a -> Either a b
Left (Maybe (Token UnresolvedModifier)
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (v, DataDeclaration v Ann, Accessors v)
forall (m :: * -> *) v.
(Monad m, Var v) =>
Maybe (Token UnresolvedModifier)
-> P v m (v, DataDeclaration v Ann, Accessors v)
dataDeclaration Maybe (Token UnresolvedModifier)
mod)

dataDeclaration ::
  forall m v.
  (Monad m, Var v) =>
  Maybe (L.Token UnresolvedModifier) ->
  P v m (v, DataDeclaration v Ann, Accessors v)
dataDeclaration :: forall (m :: * -> *) v.
(Monad m, Var v) =>
Maybe (Token UnresolvedModifier)
-> P v m (v, DataDeclaration v Ann, Accessors v)
dataDeclaration Maybe (Token UnresolvedModifier)
maybeUnresolvedModifier = 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)
-> 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)
  ([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)
-> 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)
  let typeArgVs :: [v]
typeArgVs = 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 (Token v -> Ann
forall a. Annotated a => a -> Ann
ann Token v
ctorName) 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]
typeArgVs Type v Ann
ctorType
              )
            )
      prefixVar :: P v m (Token v)
prefixVar = 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
      dataConstructor :: P v m (Ann, (Ann, v, Type v Ann))
      dataConstructor :: P v m (Ann, (Ann, v, Type v Ann))
dataConstructor = 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)
forall {m :: * -> *}. P v 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
      record :: P v m ([(Ann, (Ann, v, Type v Ann))], [(L.Token v, [(L.Token v, Type v Ann)])], Ann)
      record :: P v m ([(Ann, (Ann, v, Type v Ann))], Accessors v, 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)
forall {m :: * -> *}. P v 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 ([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
name, [(Token v, Type v Ann)]
fields)], Token () -> Ann
forall a. Annotated a => a -> Ann
ann Token ()
closingToken)
  ([(Ann, (Ann, v, Type v Ann))]
constructors, Accessors v
accessors, Ann
closingAnn) <-
    [ParsecT
   (Error v)
   Input
   (ReaderT (ParsingEnv m) m)
   (Either
      ([(Ann, (Ann, v, Type v Ann))], Accessors v, Ann)
      [(Ann, (Ann, v, Type v Ann))])]
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Either
        ([(Ann, (Ann, v, Type v Ann))], Accessors v, Ann)
        [(Ann, (Ann, v, Type v Ann))])
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [([(Ann, (Ann, v, Type v Ann))], Accessors v, Ann)
-> Either
     ([(Ann, (Ann, v, Type v Ann))], Accessors v, Ann)
     [(Ann, (Ann, v, Type v Ann))]
forall a b. a -> Either a b
Left (([(Ann, (Ann, v, Type v Ann))], Accessors v, Ann)
 -> Either
      ([(Ann, (Ann, v, Type v Ann))], Accessors v, Ann)
      [(Ann, (Ann, v, Type v Ann))])
-> P v m ([(Ann, (Ann, v, Type v Ann))], Accessors v, Ann)
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Either
        ([(Ann, (Ann, v, Type v Ann))], Accessors v, Ann)
        [(Ann, (Ann, v, Type v Ann))])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P v m ([(Ann, (Ann, v, Type v Ann))], Accessors v, Ann)
record, [(Ann, (Ann, v, Type v Ann))]
-> Either
     ([(Ann, (Ann, v, Type v Ann))], Accessors v, Ann)
     [(Ann, (Ann, v, Type v Ann))]
forall a b. b -> Either a b
Right ([(Ann, (Ann, v, Type v Ann))]
 -> Either
      ([(Ann, (Ann, v, Type v Ann))], Accessors v, Ann)
      [(Ann, (Ann, v, Type v Ann))])
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     [(Ann, (Ann, v, Type v Ann))]
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Either
        ([(Ann, (Ann, v, Type v Ann))], Accessors 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 String)
-> P v m (Ann, (Ann, v, Type v Ann))
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) 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
"|") P v m (Ann, (Ann, v, Type v Ann))
dataConstructor] ParsecT
  (Error v)
  Input
  (ReaderT (ParsingEnv m) m)
  (Either
     ([(Ann, (Ann, v, Type v Ann))], Accessors v, Ann)
     [(Ann, (Ann, v, Type v Ann))])
-> (Either
      ([(Ann, (Ann, v, Type v Ann))], Accessors v, Ann)
      [(Ann, (Ann, v, Type v Ann))]
    -> ([(Ann, (Ann, v, Type v Ann))], Accessors v, Ann))
-> P v m ([(Ann, (Ann, v, Type v Ann))], Accessors v, Ann)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
      Left ([(Ann, (Ann, v, Type v Ann))]
constructors, Accessors v
accessors, Ann
closingAnn) -> ([(Ann, (Ann, v, Type v Ann))]
constructors, Accessors v
accessors, Ann
closingAnn)
      Right [(Ann, (Ann, v, Type v Ann))]
constructors -> do
        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))
         in ([(Ann, (Ann, v, Type v Ann))]
constructors, [], Ann
closingAnn)
  Token ()
_ <- ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
forall v (m :: * -> *). Ord v => P v m (Token ())
closeBlock
  case Maybe (Token UnresolvedModifier)
maybeUnresolvedModifier of
    Maybe (Token UnresolvedModifier)
Nothing -> do
      Modifier
modifier <- v -> P v m Modifier
forall (m :: * -> *) v. (Monad m, Var v) => v -> P v m Modifier
defaultUniqueModifier (Token v -> v
forall a. Token a -> a
L.payload Token v
name)
      -- ann spanning the whole Decl.
      let declSpanAnn :: Ann
declSpanAnn = Token () -> Ann
forall a. Annotated a => a -> Ann
ann Token ()
typeToken Ann -> Ann -> Ann
forall a. Semigroup a => a -> a -> a
<> Ann
closingAnn
      pure
        ( Token v -> v
forall a. Token a -> a
L.payload Token v
name,
          Modifier
-> Ann -> [v] -> [(Ann, v, Type v Ann)] -> DataDeclaration v Ann
forall a v.
Modifier -> a -> [v] -> [(a, v, Type v a)] -> DataDeclaration v a
DD.mkDataDecl' Modifier
modifier Ann
declSpanAnn [v]
typeArgVs ((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),
          Accessors v
accessors
        )
    Just Token UnresolvedModifier
unresolvedModifier -> do
      Token Modifier
modifier <- Token UnresolvedModifier -> v -> P v m (Token Modifier)
forall (m :: * -> *) v.
(Monad m, Var v) =>
Token UnresolvedModifier -> v -> P v m (Token Modifier)
resolveUnresolvedModifier Token UnresolvedModifier
unresolvedModifier (Token v -> v
forall a. Token a -> a
L.payload Token v
name)
      -- ann spanning the whole Decl.
      -- Technically the typeToken is redundant here, but this is more future proof.
      let declSpanAnn :: Ann
declSpanAnn = Token () -> Ann
forall a. Annotated a => a -> Ann
ann Token ()
typeToken Ann -> Ann -> Ann
forall a. Semigroup a => a -> a -> a
<> Token Modifier -> Ann
forall a. Annotated a => a -> Ann
ann Token Modifier
modifier Ann -> Ann -> Ann
forall a. Semigroup a => a -> a -> a
<> Ann
closingAnn
      (v, DataDeclaration v Ann, Accessors v)
-> P v m (v, DataDeclaration v Ann, Accessors v)
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        ( Token v -> v
forall a. Token a -> a
L.payload Token v
name,
          Modifier
-> Ann -> [v] -> [(Ann, v, Type v Ann)] -> DataDeclaration v Ann
forall a v.
Modifier -> a -> [v] -> [(a, v, Type v a)] -> DataDeclaration v a
DD.mkDataDecl' (Token Modifier -> Modifier
forall a. Token a -> a
L.payload Token Modifier
modifier) Ann
declSpanAnn [v]
typeArgVs ((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),
          Accessors v
accessors
        )

effectDeclaration ::
  forall m v.
  (Monad m, Var v) =>
  Maybe (L.Token UnresolvedModifier) ->
  P v m (v, EffectDeclaration v Ann)
effectDeclaration :: forall (m :: * -> *) v.
(Monad m, Var v) =>
Maybe (Token UnresolvedModifier)
-> P v m (v, EffectDeclaration v Ann)
effectDeclaration Maybe (Token UnresolvedModifier)
maybeUnresolvedModifier = 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)
  let typeArgVs :: [v]
typeArgVs = 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 ()
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)
constructor [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)

  case Maybe (Token UnresolvedModifier)
maybeUnresolvedModifier of
    Maybe (Token UnresolvedModifier)
Nothing -> do
      Modifier
modifier <- v -> P v m Modifier
forall (m :: * -> *) v. (Monad m, Var v) => v -> P v m Modifier
defaultUniqueModifier (Token v -> v
forall a. Token a -> a
L.payload Token v
name)
      -- ann spanning the whole ability declaration.
      let abilitySpanAnn :: Ann
abilitySpanAnn = Token () -> Ann
forall a. Annotated a => a -> Ann
ann Token ()
abilityToken Ann -> Ann -> Ann
forall a. Semigroup a => a -> a -> a
<> Ann
closingAnn
      pure
        ( Token v -> v
forall a. Token a -> a
L.payload Token v
name,
          Modifier
-> Ann -> [v] -> [(Ann, v, Type v Ann)] -> EffectDeclaration v Ann
forall a v.
Modifier -> a -> [v] -> [(a, v, Type v a)] -> EffectDeclaration v a
DD.mkEffectDecl' Modifier
modifier Ann
abilitySpanAnn [v]
typeArgVs [(Ann, v, Type v Ann)]
constructors
        )
    Just Token UnresolvedModifier
unresolvedModifier -> do
      Token Modifier
modifier <- Token UnresolvedModifier -> v -> P v m (Token Modifier)
forall (m :: * -> *) v.
(Monad m, Var v) =>
Token UnresolvedModifier -> v -> P v m (Token Modifier)
resolveUnresolvedModifier Token UnresolvedModifier
unresolvedModifier (Token v -> v
forall a. Token a -> a
L.payload Token v
name)
      -- ann spanning the whole ability declaration.
      -- Technically the abilityToken is redundant here, but this is more future proof.
      let abilitySpanAnn :: Ann
abilitySpanAnn = Token () -> Ann
forall a. Annotated a => a -> Ann
ann Token ()
abilityToken Ann -> Ann -> Ann
forall a. Semigroup a => a -> a -> a
<> Token Modifier -> Ann
forall a. Annotated a => a -> Ann
ann Token Modifier
modifier Ann -> Ann -> Ann
forall a. Semigroup a => a -> a -> a
<> Ann
closingAnn
      (v, EffectDeclaration v Ann) -> P v m (v, EffectDeclaration 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 -> v
forall a. Token a -> a
L.payload Token v
name,
          Modifier
-> Ann -> [v] -> [(Ann, v, Type v Ann)] -> EffectDeclaration v Ann
forall a v.
Modifier -> a -> [v] -> [(a, v, Type v a)] -> EffectDeclaration v a
DD.mkEffectDecl'
            (Token Modifier -> Modifier
forall a. Token a -> a
L.payload Token Modifier
modifier)
            Ann
abilitySpanAnn
            [v]
typeArgVs
            [(Ann, v, Type v Ann)]
constructors
        )
  where
    constructor :: [L.Token v] -> L.Token v -> P v m (Ann, v, Type v Ann)
    constructor :: [Token v] -> Token v -> P v m (Ann, v, Type v Ann)
constructor [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))
-> P v 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
<$> 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
        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)
-> P v 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