module Unison.Syntax.FileParser
  ( file,
  )
where

import Control.Lens
import Control.Monad.Reader (asks, local)
import Data.Foldable (foldlM)
import Data.List qualified as List
import Data.Map qualified as Map
import Data.Set qualified as Set
import Data.Text qualified as Text
import Text.Megaparsec qualified as P
import Unison.ABT qualified as ABT
import Unison.DataDeclaration (DataDeclaration (..), EffectDeclaration)
import Unison.DataDeclaration qualified as DataDeclaration
import Unison.DataDeclaration.Records (generateRecordAccessors)
import Unison.Name qualified as Name
import Unison.NameSegment qualified as NameSegment
import Unison.Names qualified as Names
import Unison.Names.ResolutionResult qualified as Names
import Unison.Parser.Ann (Ann)
import Unison.Parser.Ann qualified as Ann
import Unison.Prelude
import Unison.Reference (TypeReferenceId)
import Unison.Syntax.DeclParser (SynDataDecl (..), SynDecl (..), SynEffectDecl (..), synDeclConstructors, synDeclName, synDeclsP)
import Unison.Syntax.Lexer qualified as L
import Unison.Syntax.Name qualified as Name (toText, toVar, unsafeParseVar)
import Unison.Syntax.Parser
import Unison.Syntax.TermParser qualified as TermParser
import Unison.Syntax.Var qualified as Var (namespaced, namespaced2)
import Unison.Term (Term, Term2)
import Unison.Term qualified as Term
import Unison.Type (Type)
import Unison.Type qualified as Type
import Unison.UnisonFile (UnisonFile (..))
import Unison.UnisonFile.Env qualified as UF
import Unison.UnisonFile.Names qualified as UFN
import Unison.Util.List qualified as List
import Unison.Var (Var)
import Unison.Var qualified as Var
import Unison.WatchKind (WatchKind)
import Unison.WatchKind qualified as UF
import Prelude hiding (readFile)

resolutionFailures :: (Ord v) => [Names.ResolutionFailure Ann] -> P v m x
resolutionFailures :: forall v (m :: * -> *) x.
Ord v =>
[ResolutionFailure Ann] -> P v m x
resolutionFailures [ResolutionFailure Ann]
es = Error v -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) x
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
P.customFailure ([ResolutionFailure Ann] -> Error v
forall v. [ResolutionFailure Ann] -> Error v
ResolutionFailures [ResolutionFailure Ann]
es)

file :: forall m v. (Monad m, Var v) => P v m (UnisonFile v Ann)
file :: forall (m :: * -> *) v.
(Monad m, Var v) =>
P v m (UnisonFile v Ann)
file = do
  Token WatchKind
_ <- P v m (Token WatchKind)
forall v (m :: * -> *). Ord v => P v m (Token WatchKind)
openBlock

  -- Parse an optional directive like "namespace foo.bar"
  Maybe Name
maybeNamespace :: Maybe Name.Name <-
    P v m (Token WatchKind)
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Maybe (Token WatchKind))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (WatchKind -> P v m (Token WatchKind)
forall v (m :: * -> *).
Ord v =>
WatchKind -> P v m (Token WatchKind)
reserved WatchKind
"namespace") ParsecT
  (Error v)
  Input
  (ReaderT (ParsingEnv m) m)
  (Maybe (Token WatchKind))
-> (Maybe (Token WatchKind)
    -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Maybe Name))
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Maybe Name)
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 WatchKind)
Nothing -> Maybe Name
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Maybe Name)
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Name
forall a. Maybe a
Nothing
      Just Token WatchKind
_ -> do
        Token Name
namespace <- P v m (Token Name)
forall v (m :: * -> *). Ord v => P v m (Token Name)
importWordyId P v m (Token Name) -> P v m (Token Name) -> P v m (Token Name)
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
<|> P v m (Token Name)
forall v (m :: * -> *). Ord v => P v m (Token Name)
importSymbolyId
        ParsecT
  (Error v) Input (ReaderT (ParsingEnv m) m) (Maybe (Token ()))
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (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)
        pure (Name -> Maybe Name
forall a. a -> Maybe a
Just Token Name
namespace.payload)
  let maybeNamespaceVar :: Maybe v
maybeNamespaceVar = Name -> v
forall v. Var v => Name -> v
Name.toVar (Name -> v) -> Maybe Name -> Maybe v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Name
maybeNamespace

  -- The file may optionally contain top-level imports,
  -- which are parsed and applied to the type decls and term stanzas
  (Names
namesStart, [(v, v)]
imports) <- P v m (Names, [(v, v)])
forall (m :: * -> *) v. (Monad m, Var v) => P v m (Names, [(v, v)])
TermParser.imports P v m (Names, [(v, v)])
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Maybe (Token ()))
-> P v m (Names, [(v, 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

  -- Parse all syn decls. The namespace in the parsing environment is required here in order to avoid unique type churn.
  [SynDecl v]
unNamespacedSynDecls <- (ParsingEnv m -> ParsingEnv m)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) [SynDecl v]
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) [SynDecl v]
forall a.
(ParsingEnv m -> ParsingEnv m)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\ParsingEnv m
e -> ParsingEnv m
e {maybeNamespace}) ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) [SynDecl v]
forall (m :: * -> *) v. (Monad m, Var v) => P v m [SynDecl v]
synDeclsP

  -- Sanity check: bail if there's a duplicate name among them
  [SynDecl v]
unNamespacedSynDecls
    [SynDecl v]
-> ([SynDecl v] -> [(v, SynDecl v)]) -> [(v, SynDecl v)]
forall a b. a -> (a -> b) -> b
& (SynDecl v -> (v, SynDecl v)) -> [SynDecl v] -> [(v, SynDecl v)]
forall a b. (a -> b) -> [a] -> [b]
List.map (\SynDecl v
decl -> (Token v -> v
forall a. Token a -> a
L.payload (SynDecl v -> Token v
forall v. SynDecl v -> Token v
synDeclName SynDecl v
decl), SynDecl v
decl))
    [(v, SynDecl v)]
-> ([(v, SynDecl v)] -> Map v [SynDecl v]) -> Map v [SynDecl v]
forall a b. a -> (a -> b) -> b
& [(v, SynDecl v)] -> Map v [SynDecl v]
forall (f :: * -> *) k v.
(Foldable f, Ord k) =>
f (k, v) -> Map k [v]
List.multimap
    Map v [SynDecl v]
-> (Map v [SynDecl v] -> [(v, [SynDecl v])]) -> [(v, [SynDecl v])]
forall a b. a -> (a -> b) -> b
& Map v [SynDecl v] -> [(v, [SynDecl v])]
forall k a. Map k a -> [(k, a)]
Map.toList
    [(v, [SynDecl v])]
-> ([(v, [SynDecl v])] -> [(v, [Ann])]) -> [(v, [Ann])]
forall a b. a -> (a -> b) -> b
& ((v, [SynDecl v]) -> Maybe (v, [Ann]))
-> [(v, [SynDecl v])] -> [(v, [Ann])]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe \case
      (v
name, decls :: [SynDecl v]
decls@(SynDecl v
_ : SynDecl v
_ : [SynDecl v]
_)) -> (v, [Ann]) -> Maybe (v, [Ann])
forall a. a -> Maybe a
Just (v
name, (SynDecl v -> Ann) -> [SynDecl v] -> [Ann]
forall a b. (a -> b) -> [a] -> [b]
map SynDecl v -> Ann
forall a. Annotated a => a -> Ann
ann [SynDecl v]
decls)
      (v, [SynDecl v])
_ -> Maybe (v, [Ann])
forall a. Maybe a
Nothing
    [(v, [Ann])]
-> ([(v, [Ann])]
    -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) ())
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) ()
forall a b. a -> (a -> b) -> b
& \case
      [] -> () -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) ()
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      [(v, [Ann])]
dupes -> Error v -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) ()
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
P.customFailure ([(v, [Ann])] -> Error v
forall v. [(v, [Ann])] -> Error v
DuplicateTypeNames [(v, [Ann])]
dupes)

  -- Apply the namespace directive (if there is one) to the decls
  let synDecls :: [SynDecl v]
synDecls = ([SynDecl v] -> [SynDecl v])
-> (v -> [SynDecl v] -> [SynDecl v])
-> Maybe v
-> [SynDecl v]
-> [SynDecl v]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [SynDecl v] -> [SynDecl v]
forall a. a -> a
id v -> [SynDecl v] -> [SynDecl v]
forall v. Var v => v -> [SynDecl v] -> [SynDecl v]
applyNamespaceToSynDecls Maybe v
maybeNamespaceVar [SynDecl v]
unNamespacedSynDecls

  -- Compute an environment from the decls that we use to parse terms
  Env v Ann
env <- do
    -- Make real data/effect decls from the "syntactic" ones
    (Map v (DataDeclaration v Ann)
dataDecls, Map v (EffectDeclaration v Ann)
effectDecls) <- [SynDecl v]
-> P v
     m
     (Map v (DataDeclaration v Ann), Map v (EffectDeclaration v Ann))
forall (m :: * -> *) v.
(Monad m, Var v) =>
[SynDecl v]
-> P v
     m
     (Map v (DataDeclaration v Ann), Map v (EffectDeclaration v Ann))
synDeclsToDecls [SynDecl v]
synDecls
    Either [Error v Ann] (Env v Ann)
result <- Names
-> Map v (DataDeclaration v Ann)
-> Map v (EffectDeclaration v Ann)
-> ResolutionResult Ann (Either [Error v Ann] (Env v Ann))
forall v a.
Var v =>
Names
-> Map v (DataDeclaration v a)
-> Map v (EffectDeclaration v a)
-> ResolutionResult a (Either [Error v a] (Env v a))
UFN.environmentFor Names
namesStart Map v (DataDeclaration v Ann)
dataDecls Map v (EffectDeclaration v Ann)
effectDecls ResolutionResult Ann (Either [Error v Ann] (Env v Ann))
-> (ResolutionResult Ann (Either [Error v Ann] (Env v Ann))
    -> ParsecT
         (Error v)
         Input
         (ReaderT (ParsingEnv m) m)
         (Either [Error v Ann] (Env v Ann)))
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Either [Error v Ann] (Env v Ann))
forall a b. a -> (a -> b) -> b
& (Seq (ResolutionFailure Ann)
 -> ParsecT
      (Error v)
      Input
      (ReaderT (ParsingEnv m) m)
      (Either [Error v Ann] (Env v Ann)))
-> ResolutionResult Ann (Either [Error v Ann] (Env v Ann))
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Either [Error v Ann] (Env v Ann))
forall (m :: * -> *) a b.
Applicative m =>
(a -> m b) -> Either a b -> m b
onLeft \Seq (ResolutionFailure Ann)
errs -> [ResolutionFailure Ann]
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Either [Error v Ann] (Env v Ann))
forall v (m :: * -> *) x.
Ord v =>
[ResolutionFailure Ann] -> P v m x
resolutionFailures (Seq (ResolutionFailure Ann) -> [ResolutionFailure Ann]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (ResolutionFailure Ann)
errs)
    Either [Error v Ann] (Env v Ann)
result Either [Error v Ann] (Env v Ann)
-> (Either [Error v Ann] (Env v Ann)
    -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Env v Ann))
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Env v Ann)
forall a b. a -> (a -> b) -> b
& ([Error v Ann]
 -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Env v Ann))
-> Either [Error v Ann] (Env v Ann)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Env v Ann)
forall (m :: * -> *) a b.
Applicative m =>
(a -> m b) -> Either a b -> m b
onLeft \[Error v Ann]
errs -> Error v
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Env v Ann)
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
P.customFailure ([Error v Ann] -> Error v
forall v. [Error v Ann] -> Error v
TypeDeclarationErrors [Error v Ann]
errs)

  -- Generate the record accessors with *un-namespaced* names below, because we need to know these names in order to
  -- perform rewriting. As an example,
  --
  --   namespace foo
  --   type Bar = { baz : Nat }
  --   term = ... Bar.baz ...
  --
  -- we want to rename `Bar.baz` to `foo.Bar.baz`, and it seems easier to first generate un-namespaced accessors like
  -- `Bar.baz`, rather than rip off the namespace from accessors like `foo.Bar.baz` (though not by much).
  let unNamespacedAccessors :: [(v, Ann, Term v Ann)]
      unNamespacedAccessors :: [(v, Ann, Term v Ann)]
unNamespacedAccessors =
        (SynDecl v -> [(v, Ann, Term v Ann)])
-> [SynDecl v] -> [(v, Ann, Term v Ann)]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
          ( \case
              SynDecl'Data SynDataDecl v
decl
                | Just [(Token v, Type v Ann)]
fields <- SynDataDecl v
decl.fields,
                  Just (Reference
ref, DataDeclaration v Ann
_) <-
                    v
-> Map v (Reference, DataDeclaration v Ann)
-> Maybe (Reference, DataDeclaration v Ann)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ((v -> v) -> (v -> v -> v) -> Maybe v -> v -> v
forall b a. b -> (a -> b) -> Maybe a -> b
maybe v -> v
forall a. a -> a
id v -> v -> v
forall v. Var v => v -> v -> v
Var.namespaced2 Maybe v
maybeNamespaceVar SynDataDecl v
decl.name.payload) (Env v Ann -> Map v (Reference, DataDeclaration v Ann)
forall v a. Env v a -> Map v (Reference, DataDeclaration v a)
UF.datas Env v Ann
env) ->
                    (NonEmpty v -> v)
-> (Ann -> Ann)
-> [(v, Ann)]
-> v
-> Reference
-> [(v, Ann, Term v Ann)]
forall a v.
(Semigroup a, Var v) =>
(NonEmpty v -> v)
-> (a -> a) -> [(v, a)] -> v -> Reference -> [(v, a, Term v a)]
generateRecordAccessors
                      NonEmpty v -> v
forall v. Var v => NonEmpty v -> v
Var.namespaced
                      Ann -> Ann
Ann.GeneratedFrom
                      ((Token v, Type v Ann) -> (v, Ann)
forall {a} {a} {a}.
(HasField "payload" a a, Annotated a, Annotated a) =>
(a, a) -> (a, Ann)
toPair ((Token v, Type v Ann) -> (v, Ann))
-> [(Token v, Type v Ann)] -> [(v, Ann)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Token v, Type v Ann)]
fields)
                      SynDataDecl v
decl.name.payload
                      Reference
ref
              SynDecl v
_ -> []
          )
          [SynDecl v]
unNamespacedSynDecls
        where
          toPair :: (a, a) -> (a, Ann)
toPair (a
tok, a
typ) = (a
tok.payload, a -> Ann
forall a. Annotated a => a -> Ann
ann a
tok Ann -> Ann -> Ann
forall a. Semigroup a => a -> a -> a
<> a -> Ann
forall a. Annotated a => a -> Ann
ann a
typ)

  let accessors :: [(v, Ann, Term v Ann)]
      accessors :: [(v, Ann, Term v Ann)]
accessors =
        [(v, Ann, Term v Ann)]
unNamespacedAccessors
          [(v, Ann, Term v Ann)]
-> ([(v, Ann, Term v Ann)] -> [(v, Ann, Term v Ann)])
-> [(v, Ann, Term v Ann)]
forall a b. a -> (a -> b) -> b
& case Maybe v
maybeNamespaceVar of
            Maybe v
Nothing -> [(v, Ann, Term v Ann)] -> [(v, Ann, Term v Ann)]
forall a. a -> a
id
            Just v
namespace -> ASetter [(v, Ann, Term v Ann)] [(v, Ann, Term v Ann)] v v
-> (v -> v) -> [(v, Ann, Term v Ann)] -> [(v, Ann, Term v Ann)]
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (((v, Ann, Term v Ann) -> Identity (v, Ann, Term v Ann))
-> [(v, Ann, Term v Ann)] -> Identity [(v, Ann, Term v Ann)]
Setter
  [(v, Ann, Term v Ann)]
  [(v, Ann, Term v Ann)]
  (v, Ann, Term v Ann)
  (v, Ann, Term v Ann)
forall (f :: * -> *) a b. Functor f => Setter (f a) (f b) a b
mapped (((v, Ann, Term v Ann) -> Identity (v, Ann, Term v Ann))
 -> [(v, Ann, Term v Ann)] -> Identity [(v, Ann, Term v Ann)])
-> ((v -> Identity v)
    -> (v, Ann, Term v Ann) -> Identity (v, Ann, Term v Ann))
-> ASetter [(v, Ann, Term v Ann)] [(v, Ann, Term v Ann)] v v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v -> Identity v)
-> (v, Ann, Term v Ann) -> Identity (v, Ann, Term v Ann)
forall s t a b. Field1 s t a b => Lens s t a b
Lens (v, Ann, Term v Ann) (v, Ann, Term v Ann) v v
_1) (v -> v -> v
forall v. Var v => v -> v -> v
Var.namespaced2 v
namespace)

  -- At this stage of the file parser, we've parsed all the type and ability
  -- declarations.
  let updateEnvForTermParsing :: ParsingEnv m -> ParsingEnv m
updateEnvForTermParsing ParsingEnv m
e =
        ParsingEnv m
e
          { names = Names.shadowing (UF.names env) namesStart,
            maybeNamespace,
            localNamespacePrefixedTypesAndConstructors = UF.names env
          }
  (ParsingEnv m -> ParsingEnv m)
-> P v m (UnisonFile v Ann) -> P v m (UnisonFile v Ann)
forall a.
(ParsingEnv m -> ParsingEnv m)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local ParsingEnv m -> ParsingEnv m
updateEnvForTermParsing do
    Names
names <- (ParsingEnv m -> Names)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) Names
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ParsingEnv m -> Names
forall (m :: * -> *). ParsingEnv m -> Names
names
    [Stanza v (Term v Ann)]
stanzas <- do
      [Stanza v (Term v Ann)]
unNamespacedStanzas0 <- ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
-> P v m (Stanza v (Term v Ann))
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) [Stanza v (Term 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 P v m (Stanza v (Term v Ann))
forall (m :: * -> *) v.
(Monad m, Var v) =>
P v m (Stanza v (Term v Ann))
stanza
      let unNamespacedStanzas :: [Stanza v (Term v Ann)]
unNamespacedStanzas = (Term v Ann -> Term v Ann)
-> Stanza v (Term v Ann) -> Stanza v (Term v Ann)
forall a b. (a -> b) -> Stanza v a -> Stanza v b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Names -> [(v, v)] -> Term v Ann -> Term v Ann
forall v. Var v => Names -> [(v, v)] -> Term v Ann -> Term v Ann
TermParser.substImports Names
names [(v, v)]
imports) (Stanza v (Term v Ann) -> Stanza v (Term v Ann))
-> [Stanza v (Term v Ann)] -> [Stanza v (Term v Ann)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Stanza v (Term v Ann)]
unNamespacedStanzas0
      [Stanza v (Term v Ann)]
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) [Stanza v (Term v Ann)]
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Stanza v (Term v Ann)]
 -> ParsecT
      (Error v) Input (ReaderT (ParsingEnv m) m) [Stanza v (Term v Ann)])
-> [Stanza v (Term v Ann)]
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) [Stanza v (Term v Ann)]
forall a b. (a -> b) -> a -> b
$
        [Stanza v (Term v Ann)]
unNamespacedStanzas
          [Stanza v (Term v Ann)]
-> ([Stanza v (Term v Ann)] -> [Stanza v (Term v Ann)])
-> [Stanza v (Term v Ann)]
forall a b. a -> (a -> b) -> b
& case Maybe v
maybeNamespaceVar of
            Maybe v
Nothing -> [Stanza v (Term v Ann)] -> [Stanza v (Term v Ann)]
forall a. a -> a
id
            Just v
namespace ->
              let unNamespacedTermNamespaceNames :: Set v
                  unNamespacedTermNamespaceNames :: Set v
unNamespacedTermNamespaceNames =
                    [Set v] -> Set v
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions
                      [ -- The vars parsed from the stanzas themselves (before applying namespace directive)
                        [v] -> Set v
forall a. Ord a => [a] -> Set a
Set.fromList ([Stanza v (Term v Ann)]
unNamespacedStanzas [Stanza v (Term v Ann)] -> (Stanza v (Term v Ann) -> [v]) -> [v]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Stanza v (Term v Ann) -> [v]
forall v term. Var v => Stanza v term -> [v]
getVars),
                        -- The un-namespaced constructor names (from the *originally-parsed* data and effect decls)
                        (SynDecl v -> Set v) -> [SynDecl v] -> Set v
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ([v] -> Set v
forall a. Ord a => [a] -> Set a
Set.fromList ([v] -> Set v) -> (SynDecl v -> [v]) -> SynDecl v -> Set v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ann, v, Type v Ann) -> v) -> [(Ann, v, Type v Ann)] -> [v]
forall a b. (a -> b) -> [a] -> [b]
map (Getting v (Ann, v, Type v Ann) v -> (Ann, v, Type v Ann) -> v
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting v (Ann, v, Type v Ann) v
forall s t a b. Field2 s t a b => Lens s t a b
Lens (Ann, v, Type v Ann) (Ann, v, Type v Ann) v v
_2) ([(Ann, v, Type v Ann)] -> [v])
-> (SynDecl v -> [(Ann, v, Type v Ann)]) -> SynDecl v -> [v]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SynDecl v -> [(Ann, v, Type v Ann)]
forall v. SynDecl v -> [(Ann, v, Type v Ann)]
synDeclConstructors) [SynDecl v]
unNamespacedSynDecls,
                        -- The un-namespaced accessors
                        [v] -> Set v
forall a. Ord a => [a] -> Set a
Set.fromList (((v, Ann, Term v Ann) -> v) -> [(v, Ann, Term v Ann)] -> [v]
forall a b. (a -> b) -> [a] -> [b]
map (Getting v (v, Ann, Term v Ann) v -> (v, Ann, Term v Ann) -> v
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting v (v, Ann, Term v Ann) v
forall s t a b. Field1 s t a b => Lens s t a b
Lens (v, Ann, Term v Ann) (v, Ann, Term v Ann) v v
_1) [(v, Ann, Term v Ann)]
unNamespacedAccessors)
                      ]
               in (Stanza v (Term v Ann) -> Stanza v (Term v Ann))
-> [Stanza v (Term v Ann)] -> [Stanza v (Term v Ann)]
forall a b. (a -> b) -> [a] -> [b]
map (v -> Set v -> Stanza v (Term v Ann) -> Stanza v (Term v Ann)
forall a v.
Var v =>
v -> Set v -> Stanza v (Term v a) -> Stanza v (Term v a)
applyNamespaceToStanza v
namespace Set v
unNamespacedTermNamespaceNames)
    Token ()
_ <- ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
forall v (m :: * -> *). Ord v => P v m (Token ())
closeBlock
    let ([(v, Ann, Term v Ann)]
termsr, [(WatchKind, (v, Ann, Term v Ann))]
watchesr) = (([(v, Ann, Term v Ann)], [(WatchKind, (v, Ann, Term v Ann))])
 -> Stanza v (Term v Ann)
 -> ([(v, Ann, Term v Ann)], [(WatchKind, (v, Ann, Term v Ann))]))
-> ([(v, Ann, Term v Ann)], [(WatchKind, (v, Ann, Term v Ann))])
-> [Stanza v (Term v Ann)]
-> ([(v, Ann, Term v Ann)], [(WatchKind, (v, Ann, Term 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' ([(v, Ann, Term v Ann)], [(WatchKind, (v, Ann, Term v Ann))])
-> Stanza v (Term v Ann)
-> ([(v, Ann, Term v Ann)], [(WatchKind, (v, Ann, Term v Ann))])
forall {vt} {v} {a} {a}.
(Var vt, Var v, Var a) =>
([(a, Ann, Term' vt v a)], [(WatchKind, (a, Ann, Term' vt v a))])
-> Stanza a (Term' vt v a)
-> ([(a, Ann, Term' vt v a)],
    [(WatchKind, (a, Ann, Term' vt v a))])
go ([], []) [Stanza v (Term v Ann)]
stanzas
        go :: ([(a, Ann, Term' vt v a)], [(WatchKind, (a, Ann, Term' vt v a))])
-> Stanza a (Term' vt v a)
-> ([(a, Ann, Term' vt v a)],
    [(WatchKind, (a, Ann, Term' vt v a))])
go ([(a, Ann, Term' vt v a)]
terms, [(WatchKind, (a, Ann, Term' vt v a))]
watches) Stanza a (Term' vt v a)
s = case Stanza a (Term' vt v a)
s of
          WatchBinding WatchKind
kind Ann
spanningAnn ((Ann
_, a
v), Term' vt v a
at) ->
            ([(a, Ann, Term' vt v a)]
terms, (WatchKind
kind, (a
v, Ann
spanningAnn, Term' vt v a -> Term' vt v a
forall vt v a. (Var vt, Var v) => Term' vt v a -> Term' vt v a
Term.generalizeTypeSignatures Term' vt v a
at)) (WatchKind, (a, Ann, Term' vt v a))
-> [(WatchKind, (a, Ann, Term' vt v a))]
-> [(WatchKind, (a, Ann, Term' vt v a))]
forall a. a -> [a] -> [a]
: [(WatchKind, (a, Ann, Term' vt v a))]
watches)
          WatchExpression WatchKind
kind Text
guid Ann
spanningAnn Term' vt v a
at ->
            ([(a, Ann, Term' vt v a)]
terms, (WatchKind
kind, (Text -> a
forall v. Var v => Text -> v
Var.unnamedTest Text
guid, Ann
spanningAnn, Term' vt v a -> Term' vt v a
forall vt v a. (Var vt, Var v) => Term' vt v a -> Term' vt v a
Term.generalizeTypeSignatures Term' vt v a
at)) (WatchKind, (a, Ann, Term' vt v a))
-> [(WatchKind, (a, Ann, Term' vt v a))]
-> [(WatchKind, (a, Ann, Term' vt v a))]
forall a. a -> [a] -> [a]
: [(WatchKind, (a, Ann, Term' vt v a))]
watches)
          Binding ((Ann
spanningAnn, a
v), Term' vt v a
at) -> ((a
v, Ann
spanningAnn, Term' vt v a -> Term' vt v a
forall vt v a. (Var vt, Var v) => Term' vt v a -> Term' vt v a
Term.generalizeTypeSignatures Term' vt v a
at) (a, Ann, Term' vt v a)
-> [(a, Ann, Term' vt v a)] -> [(a, Ann, Term' vt v a)]
forall a. a -> [a] -> [a]
: [(a, Ann, Term' vt v a)]
terms, [(WatchKind, (a, Ann, Term' vt v a))]
watches)
          Bindings [((Ann, a), Term' vt v a)]
bs -> ([(a
v, Ann
spanningAnn, Term' vt v a -> Term' vt v a
forall vt v a. (Var vt, Var v) => Term' vt v a -> Term' vt v a
Term.generalizeTypeSignatures Term' vt v a
at) | ((Ann
spanningAnn, a
v), Term' vt v a
at) <- [((Ann, a), Term' vt v a)]
bs] [(a, Ann, Term' vt v a)]
-> [(a, Ann, Term' vt v a)] -> [(a, Ann, Term' vt v a)]
forall a. [a] -> [a] -> [a]
++ [(a, Ann, Term' vt v a)]
terms, [(WatchKind, (a, Ann, Term' vt v a))]
watches)
    let ([(v, Ann, Term v Ann)]
terms, [(WatchKind, (v, Ann, Term v Ann))]
watches) = ([(v, Ann, Term v Ann)] -> [(v, Ann, Term v Ann)]
forall a. [a] -> [a]
reverse [(v, Ann, Term v Ann)]
termsr, [(WatchKind, (v, Ann, Term v Ann))]
-> [(WatchKind, (v, Ann, Term v Ann))]
forall a. [a] -> [a]
reverse [(WatchKind, (v, Ann, Term v Ann))]
watchesr)
        -- All locally declared term variables, running example:
        --   [foo.alice, bar.alice, zonk.bob]
        fqLocalTerms :: [v]
        fqLocalTerms :: [v]
fqLocalTerms = ([Stanza v (Term v Ann)]
stanzas [Stanza v (Term v Ann)] -> (Stanza v (Term v Ann) -> [v]) -> [v]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Stanza v (Term v Ann) -> [v]
forall v term. Var v => Stanza v term -> [v]
getVars) [v] -> [v] -> [v]
forall a. Semigroup a => a -> a -> a
<> (Getting v (v, Ann, Term v Ann) v -> (v, Ann, Term v Ann) -> v
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting v (v, Ann, Term v Ann) v
forall s t a b. Field1 s t a b => Lens s t a b
Lens (v, Ann, Term v Ann) (v, Ann, Term v Ann) v v
_1 ((v, Ann, Term v Ann) -> v) -> [(v, Ann, Term v Ann)] -> [v]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(v, Ann, Term v Ann)]
accessors)
    let bindNames :: Term v Ann -> ResolutionResult Ann (Term v Ann)
bindNames =
          (v -> Name)
-> (Name -> v)
-> Set v
-> Names
-> Term v Ann
-> ResolutionResult Ann (Term v Ann)
forall v a.
Var v =>
(v -> Name)
-> (Name -> v)
-> Set v
-> Names
-> Term v a
-> ResolutionResult a (Term v a)
Term.bindNames
            v -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar
            Name -> v
forall v. Var v => Name -> v
Name.toVar
            ([v] -> Set v
forall a. Ord a => [a] -> Set a
Set.fromList [v]
fqLocalTerms)
            ([Name] -> Names -> Names
Names.shadowTerms ((v -> Name) -> [v] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map v -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar [v]
fqLocalTerms) Names
names)
    [(v, Ann, Term v Ann)]
terms <- case ((v, Ann, Term v Ann)
 -> Either (Seq (ResolutionFailure Ann)) (v, Ann, Term v Ann))
-> [(v, Ann, Term v Ann)]
-> Either (Seq (ResolutionFailure Ann)) [(v, Ann, Term v Ann)]
forall e (f :: * -> *) a b.
(Semigroup e, Foldable f) =>
(a -> Either e b) -> f a -> Either e [b]
List.validate (LensLike
  (Either (Seq (ResolutionFailure Ann)))
  (v, Ann, Term v Ann)
  (v, Ann, Term v Ann)
  (Term v Ann)
  (Term v Ann)
-> LensLike
     (Either (Seq (ResolutionFailure Ann)))
     (v, Ann, Term v Ann)
     (v, Ann, Term v Ann)
     (Term v Ann)
     (Term v Ann)
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf LensLike
  (Either (Seq (ResolutionFailure Ann)))
  (v, Ann, Term v Ann)
  (v, Ann, Term v Ann)
  (Term v Ann)
  (Term v Ann)
forall s t a b. Field3 s t a b => Lens s t a b
Lens
  (v, Ann, Term v Ann) (v, Ann, Term v Ann) (Term v Ann) (Term v Ann)
_3 Term v Ann -> ResolutionResult Ann (Term v Ann)
bindNames) [(v, Ann, Term v Ann)]
terms of
      Left Seq (ResolutionFailure Ann)
es -> [ResolutionFailure Ann]
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) [(v, Ann, Term v Ann)]
forall v (m :: * -> *) x.
Ord v =>
[ResolutionFailure Ann] -> P v m x
resolutionFailures (Seq (ResolutionFailure Ann) -> [ResolutionFailure Ann]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (ResolutionFailure Ann)
es)
      Right [(v, Ann, Term v Ann)]
terms -> [(v, Ann, Term v Ann)]
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) [(v, Ann, Term v Ann)]
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(v, Ann, Term v Ann)]
terms
    [(WatchKind, (v, Ann, Term v Ann))]
watches <- case ((WatchKind, (v, Ann, Term v Ann))
 -> Either
      (Seq (ResolutionFailure Ann)) (WatchKind, (v, Ann, Term v Ann)))
-> [(WatchKind, (v, Ann, Term v Ann))]
-> Either
     (Seq (ResolutionFailure Ann)) [(WatchKind, (v, Ann, Term v Ann))]
forall e (f :: * -> *) a b.
(Semigroup e, Foldable f) =>
(a -> Either e b) -> f a -> Either e [b]
List.validate (LensLike
  (Either (Seq (ResolutionFailure Ann)))
  (WatchKind, (v, Ann, Term v Ann))
  (WatchKind, (v, Ann, Term v Ann))
  (Term v Ann)
  (Term v Ann)
-> LensLike
     (Either (Seq (ResolutionFailure Ann)))
     (WatchKind, (v, Ann, Term v Ann))
     (WatchKind, (v, Ann, Term v Ann))
     (Term v Ann)
     (Term v Ann)
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf (((v, Ann, Term v Ann)
 -> Either (Seq (ResolutionFailure Ann)) (v, Ann, Term v Ann))
-> (WatchKind, (v, Ann, Term v Ann))
-> Either
     (Seq (ResolutionFailure Ann)) (WatchKind, (v, Ann, Term v Ann))
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
IndexedTraversal
  Int
  (WatchKind, (v, Ann, Term v Ann))
  (WatchKind, (v, Ann, Term v Ann))
  (v, Ann, Term v Ann)
  (v, Ann, Term v Ann)
traversed (((v, Ann, Term v Ann)
  -> Either (Seq (ResolutionFailure Ann)) (v, Ann, Term v Ann))
 -> (WatchKind, (v, Ann, Term v Ann))
 -> Either
      (Seq (ResolutionFailure Ann)) (WatchKind, (v, Ann, Term v Ann)))
-> LensLike
     (Either (Seq (ResolutionFailure Ann)))
     (v, Ann, Term v Ann)
     (v, Ann, Term v Ann)
     (Term v Ann)
     (Term v Ann)
-> LensLike
     (Either (Seq (ResolutionFailure Ann)))
     (WatchKind, (v, Ann, Term v Ann))
     (WatchKind, (v, Ann, Term v Ann))
     (Term v Ann)
     (Term v Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LensLike
  (Either (Seq (ResolutionFailure Ann)))
  (v, Ann, Term v Ann)
  (v, Ann, Term v Ann)
  (Term v Ann)
  (Term v Ann)
forall s t a b. Field3 s t a b => Lens s t a b
Lens
  (v, Ann, Term v Ann) (v, Ann, Term v Ann) (Term v Ann) (Term v Ann)
_3) Term v Ann -> ResolutionResult Ann (Term v Ann)
bindNames) [(WatchKind, (v, Ann, Term v Ann))]
watches of
      Left Seq (ResolutionFailure Ann)
es -> [ResolutionFailure Ann]
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     [(WatchKind, (v, Ann, Term v Ann))]
forall v (m :: * -> *) x.
Ord v =>
[ResolutionFailure Ann] -> P v m x
resolutionFailures (Seq (ResolutionFailure Ann) -> [ResolutionFailure Ann]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (ResolutionFailure Ann)
es)
      Right [(WatchKind, (v, Ann, Term v Ann))]
ws -> [(WatchKind, (v, Ann, Term v Ann))]
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     [(WatchKind, (v, Ann, Term v Ann))]
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(WatchKind, (v, Ann, Term v Ann))]
ws
    Map v (TypeReferenceId, DataDeclaration v Ann)
-> Map v (TypeReferenceId, EffectDeclaration v Ann)
-> [(v, Ann, Term v Ann)]
-> Map WatchKind [(v, Ann, Term v Ann)]
-> P v m (UnisonFile v Ann)
forall v (m :: * -> *).
Ord v =>
Map v (TypeReferenceId, DataDeclaration v Ann)
-> Map v (TypeReferenceId, EffectDeclaration v Ann)
-> [(v, Ann, Term v Ann)]
-> Map WatchKind [(v, Ann, Term v Ann)]
-> P v m (UnisonFile v Ann)
validateUnisonFile
      (Env v Ann -> Map v (TypeReferenceId, DataDeclaration v Ann)
forall v a. Env v a -> Map v (TypeReferenceId, DataDeclaration v a)
UF.datasId Env v Ann
env)
      (Env v Ann -> Map v (TypeReferenceId, EffectDeclaration v Ann)
forall v a.
Env v a -> Map v (TypeReferenceId, EffectDeclaration v a)
UF.effectsId Env v Ann
env)
      ([(v, Ann, Term v Ann)]
terms [(v, Ann, Term v Ann)]
-> [(v, Ann, Term v Ann)] -> [(v, Ann, Term v Ann)]
forall a. Semigroup a => a -> a -> a
<> [(v, Ann, Term v Ann)]
accessors)
      ([(WatchKind, (v, Ann, Term v Ann))]
-> Map WatchKind [(v, Ann, Term v Ann)]
forall (f :: * -> *) k v.
(Foldable f, Ord k) =>
f (k, v) -> Map k [v]
List.multimap [(WatchKind, (v, Ann, Term v Ann))]
watches)

-- | Suppose a data declaration `Foo` has a constructor `A` with fields `B` and `C`, where `B` is locally-bound and `C`
-- is not:
--
-- @
-- type B
--
-- type Foo
-- constructor Foo.A : B -> C -> Foo
-- @
--
-- Then, this function applies a namespace "namespace" to the data declaration `Foo` by prefixing each of its
-- constructors and references to locally-bound types with "namespace":
--
-- @
-- type Foo
-- constructor namespace.Foo.A : namespace.B -> C -> foo.Foo
--             ^^^^^^^^^^        ^^^^^^^^^^          ^^^^
-- @
--
-- (note that the name for the data declaration itself is not prefixed within this function, because a data declaration
-- does not contain its own name).
applyNamespaceToSynDecls :: forall v. (Var v) => v -> [SynDecl v] -> [SynDecl v]
applyNamespaceToSynDecls :: forall v. Var v => v -> [SynDecl v] -> [SynDecl v]
applyNamespaceToSynDecls v
namespace [SynDecl v]
decls =
  (SynDecl v -> SynDecl v) -> [SynDecl v] -> [SynDecl v]
forall a b. (a -> b) -> [a] -> [b]
map
    ( \case
        SynDecl'Data SynDataDecl v
decl ->
          SynDataDecl v -> SynDecl v
forall v. SynDataDecl v -> SynDecl v
SynDecl'Data
            ( SynDataDecl v
decl
                SynDataDecl v -> (SynDataDecl v -> SynDataDecl v) -> SynDataDecl v
forall a b. a -> (a -> b) -> b
& ASetter
  (SynDataDecl v)
  (SynDataDecl v)
  (Ann, v, Type v Ann)
  (Ann, v, Type v Ann)
-> ((Ann, v, Type v Ann) -> (Ann, v, Type v Ann))
-> SynDataDecl v
-> SynDataDecl v
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (([(Ann, v, Type v Ann)] -> Identity [(Ann, v, Type v Ann)])
-> SynDataDecl v -> Identity (SynDataDecl v)
#constructors (([(Ann, v, Type v Ann)] -> Identity [(Ann, v, Type v Ann)])
 -> SynDataDecl v -> Identity (SynDataDecl v))
-> (((Ann, v, Type v Ann) -> Identity (Ann, v, Type v Ann))
    -> [(Ann, v, Type v Ann)] -> Identity [(Ann, v, Type v Ann)])
-> ASetter
     (SynDataDecl v)
     (SynDataDecl v)
     (Ann, v, Type v Ann)
     (Ann, v, Type v Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ann, v, Type v Ann) -> Identity (Ann, v, Type v Ann))
-> [(Ann, v, Type v Ann)] -> Identity [(Ann, v, Type v Ann)]
Setter
  [(Ann, v, Type v Ann)]
  [(Ann, v, Type v Ann)]
  (Ann, v, Type v Ann)
  (Ann, v, Type v Ann)
forall (f :: * -> *) a b. Functor f => Setter (f a) (f b) a b
mapped) (Ann, v, Type v Ann) -> (Ann, v, Type v Ann)
applyToConstructor
                SynDataDecl v -> (SynDataDecl v -> SynDataDecl v) -> SynDataDecl v
forall a b. a -> (a -> b) -> b
& ASetter (SynDataDecl v) (SynDataDecl v) v v
-> (v -> v) -> SynDataDecl v -> SynDataDecl v
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ((Token v -> Identity (Token v))
-> SynDataDecl v -> Identity (SynDataDecl v)
#name ((Token v -> Identity (Token v))
 -> SynDataDecl v -> Identity (SynDataDecl v))
-> ((v -> Identity v) -> Token v -> Identity (Token v))
-> ASetter (SynDataDecl v) (SynDataDecl v) v v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v -> Identity v) -> Token v -> Identity (Token v)
Setter (Token v) (Token v) v v
forall (f :: * -> *) a b. Functor f => Setter (f a) (f b) a b
mapped) (v -> v -> v
forall v. Var v => v -> v -> v
Var.namespaced2 v
namespace)
            )
        SynDecl'Effect SynEffectDecl v
decl ->
          SynEffectDecl v -> SynDecl v
forall v. SynEffectDecl v -> SynDecl v
SynDecl'Effect
            ( SynEffectDecl v
decl
                SynEffectDecl v
-> (SynEffectDecl v -> SynEffectDecl v) -> SynEffectDecl v
forall a b. a -> (a -> b) -> b
& ASetter
  (SynEffectDecl v)
  (SynEffectDecl v)
  (Ann, v, Type v Ann)
  (Ann, v, Type v Ann)
-> ((Ann, v, Type v Ann) -> (Ann, v, Type v Ann))
-> SynEffectDecl v
-> SynEffectDecl v
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (([(Ann, v, Type v Ann)] -> Identity [(Ann, v, Type v Ann)])
-> SynEffectDecl v -> Identity (SynEffectDecl v)
#constructors (([(Ann, v, Type v Ann)] -> Identity [(Ann, v, Type v Ann)])
 -> SynEffectDecl v -> Identity (SynEffectDecl v))
-> (((Ann, v, Type v Ann) -> Identity (Ann, v, Type v Ann))
    -> [(Ann, v, Type v Ann)] -> Identity [(Ann, v, Type v Ann)])
-> ASetter
     (SynEffectDecl v)
     (SynEffectDecl v)
     (Ann, v, Type v Ann)
     (Ann, v, Type v Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ann, v, Type v Ann) -> Identity (Ann, v, Type v Ann))
-> [(Ann, v, Type v Ann)] -> Identity [(Ann, v, Type v Ann)]
Setter
  [(Ann, v, Type v Ann)]
  [(Ann, v, Type v Ann)]
  (Ann, v, Type v Ann)
  (Ann, v, Type v Ann)
forall (f :: * -> *) a b. Functor f => Setter (f a) (f b) a b
mapped) (Ann, v, Type v Ann) -> (Ann, v, Type v Ann)
applyToConstructor
                SynEffectDecl v
-> (SynEffectDecl v -> SynEffectDecl v) -> SynEffectDecl v
forall a b. a -> (a -> b) -> b
& ASetter (SynEffectDecl v) (SynEffectDecl v) v v
-> (v -> v) -> SynEffectDecl v -> SynEffectDecl v
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ((Token v -> Identity (Token v))
-> SynEffectDecl v -> Identity (SynEffectDecl v)
#name ((Token v -> Identity (Token v))
 -> SynEffectDecl v -> Identity (SynEffectDecl v))
-> ((v -> Identity v) -> Token v -> Identity (Token v))
-> ASetter (SynEffectDecl v) (SynEffectDecl v) v v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v -> Identity v) -> Token v -> Identity (Token v)
Setter (Token v) (Token v) v v
forall (f :: * -> *) a b. Functor f => Setter (f a) (f b) a b
mapped) (v -> v -> v
forall v. Var v => v -> v -> v
Var.namespaced2 v
namespace)
            )
    )
    [SynDecl v]
decls
  where
    applyToConstructor :: (Ann, v, Type v Ann) -> (Ann, v, Type v Ann)
    applyToConstructor :: (Ann, v, Type v Ann) -> (Ann, v, Type v Ann)
applyToConstructor (Ann
ann, v
name, Type v Ann
typ) =
      ( Ann
ann,
        v -> v -> v
forall v. Var v => v -> v -> v
Var.namespaced2 v
namespace v
name,
        [(v, Term F v ())] -> Type v Ann -> Type v Ann
forall (f :: * -> *) v b a.
(Foldable f, Functor f, Var v) =>
[(v, Term f v b)] -> Term f v a -> Term f v a
ABT.substsInheritAnnotation [(v, Term F v ())]
typeReplacements Type v Ann
typ
      )

    -- Replace var "Foo" with var "namespace.Foo"
    typeReplacements :: [(v, Type v ())]
    typeReplacements :: [(v, Term F v ())]
typeReplacements =
      [SynDecl v]
decls
        [SynDecl v] -> ([SynDecl v] -> Set v) -> Set v
forall a b. a -> (a -> b) -> b
& (Set v -> SynDecl v -> Set v) -> Set v -> [SynDecl v] -> Set v
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (\Set v
acc SynDecl v
decl -> v -> Set v -> Set v
forall a. Ord a => a -> Set a -> Set a
Set.insert (Token v -> v
forall a. Token a -> a
L.payload (SynDecl v -> Token v
forall v. SynDecl v -> Token v
synDeclName SynDecl v
decl)) Set v
acc) Set v
forall a. Set a
Set.empty
        Set v -> (Set v -> [v]) -> [v]
forall a b. a -> (a -> b) -> b
& Set v -> [v]
forall a. Set a -> [a]
Set.toList
        [v] -> ([v] -> [(v, Term F v ())]) -> [(v, Term F v ())]
forall a b. a -> (a -> b) -> b
& (v -> (v, Term F v ())) -> [v] -> [(v, Term F v ())]
forall a b. (a -> b) -> [a] -> [b]
map (\v
v -> (v
v, () -> v -> Term F v ()
forall v a. Ord v => a -> v -> Type v a
Type.var () (v -> v -> v
forall v. Var v => v -> v -> v
Var.namespaced2 v
namespace v
v)))

synDeclsToDecls :: (Monad m, Var v) => [SynDecl v] -> P v m (Map v (DataDeclaration v Ann), Map v (EffectDeclaration v Ann))
synDeclsToDecls :: forall (m :: * -> *) v.
(Monad m, Var v) =>
[SynDecl v]
-> P v
     m
     (Map v (DataDeclaration v Ann), Map v (EffectDeclaration v Ann))
synDeclsToDecls = do
  ((Map v (DataDeclaration v Ann), Map v (EffectDeclaration v Ann))
 -> SynDecl v
 -> P v
      m
      (Map v (DataDeclaration v Ann), Map v (EffectDeclaration v Ann)))
-> (Map v (DataDeclaration v Ann), Map v (EffectDeclaration v Ann))
-> [SynDecl v]
-> P v
     m
     (Map v (DataDeclaration v Ann), Map v (EffectDeclaration v Ann))
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM
    ( \(Map v (DataDeclaration v Ann)
datas, Map v (EffectDeclaration v Ann)
effects) -> \case
        SynDecl'Data SynDataDecl v
decl -> do
          let decl1 :: DataDeclaration v Ann
decl1 = Modifier
-> Ann -> [v] -> [(Ann, v, Type v Ann)] -> DataDeclaration v Ann
forall v a.
Modifier -> a -> [v] -> [(a, v, Type v a)] -> DataDeclaration v a
DataDeclaration SynDataDecl v
decl.modifier SynDataDecl v
decl.annotation SynDataDecl v
decl.tyvars SynDataDecl v
decl.constructors
          let !datas1 :: Map v (DataDeclaration v Ann)
datas1 = v
-> DataDeclaration v Ann
-> Map v (DataDeclaration v Ann)
-> Map v (DataDeclaration v Ann)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert SynDataDecl v
decl.name.payload DataDeclaration v Ann
decl1 Map v (DataDeclaration v Ann)
datas
          (Map v (DataDeclaration v Ann), Map v (EffectDeclaration v Ann))
-> P v
     m
     (Map v (DataDeclaration v Ann), Map 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 (Map v (DataDeclaration v Ann)
datas1, Map v (EffectDeclaration v Ann)
effects)
        SynDecl'Effect SynEffectDecl v
decl -> do
          let decl1 :: EffectDeclaration v Ann
decl1 = 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
DataDeclaration.mkEffectDecl' SynEffectDecl v
decl.modifier SynEffectDecl v
decl.annotation SynEffectDecl v
decl.tyvars SynEffectDecl v
decl.constructors
          let !effects1 :: Map v (EffectDeclaration v Ann)
effects1 = v
-> EffectDeclaration v Ann
-> Map v (EffectDeclaration v Ann)
-> Map v (EffectDeclaration v Ann)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert SynEffectDecl v
decl.name.payload EffectDeclaration v Ann
decl1 Map v (EffectDeclaration v Ann)
effects
          (Map v (DataDeclaration v Ann), Map v (EffectDeclaration v Ann))
-> P v
     m
     (Map v (DataDeclaration v Ann), Map 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 (Map v (DataDeclaration v Ann)
datas, Map v (EffectDeclaration v Ann)
effects1)
    )
    (Map v (DataDeclaration v Ann)
forall k a. Map k a
Map.empty, Map v (EffectDeclaration v Ann)
forall k a. Map k a
Map.empty)

applyNamespaceToStanza ::
  forall a v.
  (Var v) =>
  v ->
  Set v ->
  Stanza v (Term v a) ->
  Stanza v (Term v a)
applyNamespaceToStanza :: forall a v.
Var v =>
v -> Set v -> Stanza v (Term v a) -> Stanza v (Term v a)
applyNamespaceToStanza v
namespace Set v
locallyBoundTerms = \case
  Binding ((Ann, v), Term v a)
x -> ((Ann, v), Term v a) -> Stanza v (Term v a)
forall v term. ((Ann, v), term) -> Stanza v term
Binding (((Ann, v), Term v a) -> ((Ann, v), Term v a)
goBinding ((Ann, v), Term v a)
x)
  Bindings [((Ann, v), Term v a)]
xs -> [((Ann, v), Term v a)] -> Stanza v (Term v a)
forall v term. [((Ann, v), term)] -> Stanza v term
Bindings ((((Ann, v), Term v a) -> ((Ann, v), Term v a))
-> [((Ann, v), Term v a)] -> [((Ann, v), Term v a)]
forall a b. (a -> b) -> [a] -> [b]
map ((Ann, v), Term v a) -> ((Ann, v), Term v a)
goBinding [((Ann, v), Term v a)]
xs)
  WatchBinding WatchKind
wk Ann
ann ((Ann, v), Term v a)
x -> WatchKind -> Ann -> ((Ann, v), Term v a) -> Stanza v (Term v a)
forall v term.
WatchKind -> Ann -> ((Ann, v), term) -> Stanza v term
WatchBinding WatchKind
wk Ann
ann (((Ann, v), Term v a) -> ((Ann, v), Term v a)
goBinding ((Ann, v), Term v a)
x)
  WatchExpression WatchKind
wk Text
guid Ann
ann Term v a
term -> WatchKind -> Text -> Ann -> Term v a -> Stanza v (Term v a)
forall v term. WatchKind -> Text -> Ann -> term -> Stanza v term
WatchExpression WatchKind
wk Text
guid Ann
ann (Term v a -> Term v a
goTerm Term v a
term)
  where
    goBinding :: ((Ann, v), Term v a) -> ((Ann, v), Term v a)
    goBinding :: ((Ann, v), Term v a) -> ((Ann, v), Term v a)
goBinding ((Ann
ann, v
name), Term v a
term) =
      ((Ann
ann, v -> v -> v
forall v. Var v => v -> v -> v
Var.namespaced2 v
namespace v
name), Term v a -> Term v a
goTerm Term v a
term)

    goTerm :: Term v a -> Term v a
    goTerm :: Term v a -> Term v a
goTerm =
      [(v, Term (F v a a) v ())] -> Term v a -> Term v a
forall (f :: * -> *) v b a.
(Foldable f, Functor f, Var v) =>
[(v, Term f v b)] -> Term f v a -> Term f v a
ABT.substsInheritAnnotation [(v, Term (F v a a) v ())]
replacements

    replacements :: [(v, Term2 v a a v ())]
    replacements :: [(v, Term (F v a a) v ())]
replacements =
      Set v
locallyBoundTerms
        Set v -> (Set v -> [v]) -> [v]
forall a b. a -> (a -> b) -> b
& Set v -> [v]
forall a. Set a -> [a]
Set.toList
        [v]
-> ([v] -> [(v, Term (F v a a) v ())])
-> [(v, Term (F v a a) v ())]
forall a b. a -> (a -> b) -> b
& (v -> (v, Term (F v a a) v ()))
-> [v] -> [(v, Term (F v a a) v ())]
forall a b. (a -> b) -> [a] -> [b]
map (\v
v -> (v
v, () -> v -> Term (F v a a) v ()
forall a v vt at ap. a -> v -> Term2 vt at ap v a
Term.var () (v -> v -> v
forall v. Var v => v -> v -> v
Var.namespaced2 v
namespace v
v)))

-- | Final validations and sanity checks to perform before finishing parsing.
validateUnisonFile ::
  (Ord v) =>
  Map v (TypeReferenceId, DataDeclaration v Ann) ->
  Map v (TypeReferenceId, EffectDeclaration v Ann) ->
  [(v, Ann, Term v Ann)] ->
  Map WatchKind [(v, Ann, Term v Ann)] ->
  P v m (UnisonFile v Ann)
validateUnisonFile :: forall v (m :: * -> *).
Ord v =>
Map v (TypeReferenceId, DataDeclaration v Ann)
-> Map v (TypeReferenceId, EffectDeclaration v Ann)
-> [(v, Ann, Term v Ann)]
-> Map WatchKind [(v, Ann, Term v Ann)]
-> P v m (UnisonFile v Ann)
validateUnisonFile Map v (TypeReferenceId, DataDeclaration v Ann)
datas Map v (TypeReferenceId, EffectDeclaration v Ann)
effects [(v, Ann, Term v Ann)]
terms Map WatchKind [(v, Ann, Term v Ann)]
watches =
  Map v (TypeReferenceId, DataDeclaration v Ann)
-> Map v (TypeReferenceId, EffectDeclaration v Ann)
-> [(v, Ann, Term v Ann)]
-> Map WatchKind [(v, Ann, Term v Ann)]
-> P v m (UnisonFile v Ann)
forall (m :: * -> *) v.
Ord v =>
Map v (TypeReferenceId, DataDeclaration v Ann)
-> Map v (TypeReferenceId, EffectDeclaration v Ann)
-> [(v, Ann, Term v Ann)]
-> Map WatchKind [(v, Ann, Term v Ann)]
-> P v m (UnisonFile v Ann)
checkForDuplicateTermsAndConstructors Map v (TypeReferenceId, DataDeclaration v Ann)
datas Map v (TypeReferenceId, EffectDeclaration v Ann)
effects [(v, Ann, Term v Ann)]
terms Map WatchKind [(v, Ann, Term v Ann)]
watches

-- | Because types and abilities can introduce their own constructors and fields it's difficult
-- to detect all duplicate terms during parsing itself. Here we collect all terms and
-- constructors and verify that no duplicates exist in the file, triggering an error if needed.
checkForDuplicateTermsAndConstructors ::
  forall m v.
  (Ord v) =>
  Map v (TypeReferenceId, DataDeclaration v Ann) ->
  Map v (TypeReferenceId, EffectDeclaration v Ann) ->
  [(v, Ann, Term v Ann)] ->
  Map WatchKind [(v, Ann, Term v Ann)] ->
  P v m (UnisonFile v Ann)
checkForDuplicateTermsAndConstructors :: forall (m :: * -> *) v.
Ord v =>
Map v (TypeReferenceId, DataDeclaration v Ann)
-> Map v (TypeReferenceId, EffectDeclaration v Ann)
-> [(v, Ann, Term v Ann)]
-> Map WatchKind [(v, Ann, Term v Ann)]
-> P v m (UnisonFile v Ann)
checkForDuplicateTermsAndConstructors Map v (TypeReferenceId, DataDeclaration v Ann)
datas Map v (TypeReferenceId, EffectDeclaration v Ann)
effects [(v, Ann, Term v Ann)]
terms Map WatchKind [(v, Ann, Term v Ann)]
watches = do
  Bool
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) ()
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool)
-> (Map v (Set Ann) -> Bool) -> Map v (Set Ann) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map v (Set Ann) -> Bool
forall a. Map v a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Map v (Set Ann) -> Bool) -> Map v (Set Ann) -> Bool
forall a b. (a -> b) -> a -> b
$ Map v (Set Ann)
duplicates) (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) ()
 -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) ())
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) ()
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) ()
forall a b. (a -> b) -> a -> b
$ do
    let dupeList :: [(v, [Ann])]
        dupeList :: [(v, [Ann])]
dupeList =
          Map v (Set Ann)
duplicates
            Map v (Set Ann) -> (Map v (Set Ann) -> Map v [Ann]) -> Map v [Ann]
forall a b. a -> (a -> b) -> b
& (Set Ann -> [Ann]) -> Map v (Set Ann) -> Map v [Ann]
forall a b. (a -> b) -> Map v a -> Map v b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Set Ann -> [Ann]
forall a. Set a -> [a]
Set.toList
            Map v [Ann] -> (Map v [Ann] -> [(v, [Ann])]) -> [(v, [Ann])]
forall a b. a -> (a -> b) -> b
& Map v [Ann] -> [(v, [Ann])]
forall k a. Map k a -> [(k, a)]
Map.toList
    Error v -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) ()
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
P.customFailure ([(v, [Ann])] -> Error v
forall v. [(v, [Ann])] -> Error v
DuplicateTermNames [(v, [Ann])]
dupeList)
  pure
    UnisonFileId
      { $sel:dataDeclarationsId:UnisonFileId :: Map v (TypeReferenceId, DataDeclaration v Ann)
dataDeclarationsId = Map v (TypeReferenceId, DataDeclaration v Ann)
datas,
        $sel:effectDeclarationsId:UnisonFileId :: Map v (TypeReferenceId, EffectDeclaration v Ann)
effectDeclarationsId = Map v (TypeReferenceId, EffectDeclaration v Ann)
effects,
        $sel:terms:UnisonFileId :: Map v (Ann, Term v Ann)
terms = (Map v (Ann, Term v Ann)
 -> (v, Ann, Term v Ann) -> Map v (Ann, Term v Ann))
-> Map v (Ann, Term v Ann)
-> [(v, Ann, Term v Ann)]
-> Map v (Ann, Term v Ann)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl (\Map v (Ann, Term v Ann)
acc (v
v, Ann
ann, Term v Ann
term) -> v
-> (Ann, Term v Ann)
-> Map v (Ann, Term v Ann)
-> Map v (Ann, Term v Ann)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert v
v (Ann
ann, Term v Ann
term) Map v (Ann, Term v Ann)
acc) Map v (Ann, Term v Ann)
forall k a. Map k a
Map.empty [(v, Ann, Term v Ann)]
terms,
        Map WatchKind [(v, Ann, Term v Ann)]
watches :: Map WatchKind [(v, Ann, Term v Ann)]
$sel:watches:UnisonFileId :: Map WatchKind [(v, Ann, Term v Ann)]
watches
      }
  where
    effectDecls :: [DataDeclaration v Ann]
    effectDecls :: [DataDeclaration v Ann]
effectDecls = Map v (DataDeclaration v Ann) -> [DataDeclaration v Ann]
forall k a. Map k a -> [a]
Map.elems (Map v (DataDeclaration v Ann) -> [DataDeclaration v Ann])
-> (Map v (TypeReferenceId, EffectDeclaration v Ann)
    -> Map v (DataDeclaration v Ann))
-> Map v (TypeReferenceId, EffectDeclaration v Ann)
-> [DataDeclaration v Ann]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TypeReferenceId, EffectDeclaration v Ann)
 -> DataDeclaration v Ann)
-> Map v (TypeReferenceId, EffectDeclaration v Ann)
-> Map v (DataDeclaration v Ann)
forall a b. (a -> b) -> Map v a -> Map v b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (EffectDeclaration v Ann -> DataDeclaration v Ann
forall v a. EffectDeclaration v a -> DataDeclaration v a
DataDeclaration.toDataDecl (EffectDeclaration v Ann -> DataDeclaration v Ann)
-> ((TypeReferenceId, EffectDeclaration v Ann)
    -> EffectDeclaration v Ann)
-> (TypeReferenceId, EffectDeclaration v Ann)
-> DataDeclaration v Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TypeReferenceId, EffectDeclaration v Ann)
-> EffectDeclaration v Ann
forall a b. (a, b) -> b
snd) (Map v (TypeReferenceId, EffectDeclaration v Ann)
 -> [DataDeclaration v Ann])
-> Map v (TypeReferenceId, EffectDeclaration v Ann)
-> [DataDeclaration v Ann]
forall a b. (a -> b) -> a -> b
$ Map v (TypeReferenceId, EffectDeclaration v Ann)
effects
    dataDecls :: [DataDeclaration v Ann]
    dataDecls :: [DataDeclaration v Ann]
dataDecls = ((TypeReferenceId, DataDeclaration v Ann) -> DataDeclaration v Ann)
-> [(TypeReferenceId, DataDeclaration v Ann)]
-> [DataDeclaration v Ann]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TypeReferenceId, DataDeclaration v Ann) -> DataDeclaration v Ann
forall a b. (a, b) -> b
snd ([(TypeReferenceId, DataDeclaration v Ann)]
 -> [DataDeclaration v Ann])
-> [(TypeReferenceId, DataDeclaration v Ann)]
-> [DataDeclaration v Ann]
forall a b. (a -> b) -> a -> b
$ Map v (TypeReferenceId, DataDeclaration v Ann)
-> [(TypeReferenceId, DataDeclaration v Ann)]
forall k a. Map k a -> [a]
Map.elems Map v (TypeReferenceId, DataDeclaration v Ann)
datas
    allConstructors :: [(v, Ann)]
    allConstructors :: [(v, Ann)]
allConstructors =
      ([DataDeclaration v Ann]
dataDecls [DataDeclaration v Ann]
-> [DataDeclaration v Ann] -> [DataDeclaration v Ann]
forall a. Semigroup a => a -> a -> a
<> [DataDeclaration v Ann]
effectDecls)
        [DataDeclaration v Ann]
-> ([DataDeclaration v Ann] -> [(Ann, v, Type v Ann)])
-> [(Ann, v, Type v Ann)]
forall a b. a -> (a -> b) -> b
& (DataDeclaration v Ann -> [(Ann, v, Type v Ann)])
-> [DataDeclaration v Ann] -> [(Ann, v, Type v Ann)]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap DataDeclaration v Ann -> [(Ann, v, Type v Ann)]
forall v a. DataDeclaration v a -> [(a, v, Type v a)]
DataDeclaration.constructors'
        [(Ann, v, Type v Ann)]
-> ([(Ann, v, Type v Ann)] -> [(v, Ann)]) -> [(v, Ann)]
forall a b. a -> (a -> b) -> b
& ((Ann, v, Type v Ann) -> (v, Ann))
-> [(Ann, v, Type v Ann)] -> [(v, Ann)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Ann
ann, v
v, Type v Ann
_typ) -> (v
v, Ann
ann))
    allTerms :: [(v, Ann)]
    allTerms :: [(v, Ann)]
allTerms =
      ((v, Ann, Term v Ann) -> (v, Ann))
-> [(v, Ann, Term v Ann)] -> [(v, Ann)]
forall a b. (a -> b) -> [a] -> [b]
map (\(v
v, Ann
ann, Term v Ann
_term) -> (v
v, Ann
ann)) [(v, Ann, Term v Ann)]
terms

    mergedTerms :: Map v (Set Ann)
    mergedTerms :: Map v (Set Ann)
mergedTerms =
      ([(v, Ann)]
allConstructors [(v, Ann)] -> [(v, Ann)] -> [(v, Ann)]
forall a. Semigroup a => a -> a -> a
<> [(v, Ann)]
allTerms)
        [(v, Ann)] -> ([(v, Ann)] -> [(v, Set Ann)]) -> [(v, Set Ann)]
forall a b. a -> (a -> b) -> b
& (((v, Ann) -> (v, Set Ann)) -> [(v, Ann)] -> [(v, Set Ann)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((v, Ann) -> (v, Set Ann)) -> [(v, Ann)] -> [(v, Set Ann)])
-> ((Ann -> Set Ann) -> (v, Ann) -> (v, Set Ann))
-> (Ann -> Set Ann)
-> [(v, Ann)]
-> [(v, Set Ann)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ann -> Set Ann) -> (v, Ann) -> (v, Set Ann)
forall a b. (a -> b) -> (v, a) -> (v, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) Ann -> Set Ann
forall a. a -> Set a
Set.singleton
        [(v, Set Ann)]
-> ([(v, Set Ann)] -> Map v (Set Ann)) -> Map v (Set Ann)
forall a b. a -> (a -> b) -> b
& (Set Ann -> Set Ann -> Set Ann)
-> [(v, Set Ann)] -> Map v (Set Ann)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Set Ann -> Set Ann -> Set Ann
forall a. Ord a => Set a -> Set a -> Set a
Set.union
    duplicates :: Map v (Set Ann)
    duplicates :: Map v (Set Ann)
duplicates =
      -- Any vars with multiple annotations are duplicates.
      (Set Ann -> Bool) -> Map v (Set Ann) -> Map v (Set Ann)
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (Int -> Bool) -> (Set Ann -> Int) -> Set Ann -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Ann -> Int
forall a. Set a -> Int
Set.size) Map v (Set Ann)
mergedTerms

-- A stanza is either a watch expression like:
--   > 1 + x
--   > z = x + 1
-- Or it is a binding like:
--   foo : Nat -> Nat
--   foo x = x + 42

data Stanza v term
  = WatchBinding UF.WatchKind Ann ((Ann, v), term)
  | WatchExpression UF.WatchKind Text Ann term
  | Binding ((Ann, v), term)
  | Bindings [((Ann, v), term)]
  deriving ((forall m. Monoid m => Stanza v m -> m)
-> (forall m a. Monoid m => (a -> m) -> Stanza v a -> m)
-> (forall m a. Monoid m => (a -> m) -> Stanza v a -> m)
-> (forall a b. (a -> b -> b) -> b -> Stanza v a -> b)
-> (forall a b. (a -> b -> b) -> b -> Stanza v a -> b)
-> (forall b a. (b -> a -> b) -> b -> Stanza v a -> b)
-> (forall b a. (b -> a -> b) -> b -> Stanza v a -> b)
-> (forall a. (a -> a -> a) -> Stanza v a -> a)
-> (forall a. (a -> a -> a) -> Stanza v a -> a)
-> (forall a. Stanza v a -> [a])
-> (forall a. Stanza v a -> Bool)
-> (forall a. Stanza v a -> Int)
-> (forall a. Eq a => a -> Stanza v a -> Bool)
-> (forall a. Ord a => Stanza v a -> a)
-> (forall a. Ord a => Stanza v a -> a)
-> (forall a. Num a => Stanza v a -> a)
-> (forall a. Num a => Stanza v a -> a)
-> Foldable (Stanza v)
forall a. Eq a => a -> Stanza v a -> Bool
forall a. Num a => Stanza v a -> a
forall a. Ord a => Stanza v a -> a
forall m. Monoid m => Stanza v m -> m
forall a. Stanza v a -> Bool
forall a. Stanza v a -> Int
forall a. Stanza v a -> [a]
forall a. (a -> a -> a) -> Stanza v a -> a
forall v a. Eq a => a -> Stanza v a -> Bool
forall v a. Num a => Stanza v a -> a
forall v a. Ord a => Stanza v a -> a
forall m a. Monoid m => (a -> m) -> Stanza v a -> m
forall v m. Monoid m => Stanza v m -> m
forall v a. Stanza v a -> Bool
forall v a. Stanza v a -> Int
forall v a. Stanza v a -> [a]
forall b a. (b -> a -> b) -> b -> Stanza v a -> b
forall a b. (a -> b -> b) -> b -> Stanza v a -> b
forall v a. (a -> a -> a) -> Stanza v a -> a
forall v m a. Monoid m => (a -> m) -> Stanza v a -> m
forall v b a. (b -> a -> b) -> b -> Stanza v a -> b
forall v a b. (a -> b -> b) -> b -> Stanza v a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall v m. Monoid m => Stanza v m -> m
fold :: forall m. Monoid m => Stanza v m -> m
$cfoldMap :: forall v m a. Monoid m => (a -> m) -> Stanza v a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Stanza v a -> m
$cfoldMap' :: forall v m a. Monoid m => (a -> m) -> Stanza v a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Stanza v a -> m
$cfoldr :: forall v a b. (a -> b -> b) -> b -> Stanza v a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Stanza v a -> b
$cfoldr' :: forall v a b. (a -> b -> b) -> b -> Stanza v a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Stanza v a -> b
$cfoldl :: forall v b a. (b -> a -> b) -> b -> Stanza v a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Stanza v a -> b
$cfoldl' :: forall v b a. (b -> a -> b) -> b -> Stanza v a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Stanza v a -> b
$cfoldr1 :: forall v a. (a -> a -> a) -> Stanza v a -> a
foldr1 :: forall a. (a -> a -> a) -> Stanza v a -> a
$cfoldl1 :: forall v a. (a -> a -> a) -> Stanza v a -> a
foldl1 :: forall a. (a -> a -> a) -> Stanza v a -> a
$ctoList :: forall v a. Stanza v a -> [a]
toList :: forall a. Stanza v a -> [a]
$cnull :: forall v a. Stanza v a -> Bool
null :: forall a. Stanza v a -> Bool
$clength :: forall v a. Stanza v a -> Int
length :: forall a. Stanza v a -> Int
$celem :: forall v a. Eq a => a -> Stanza v a -> Bool
elem :: forall a. Eq a => a -> Stanza v a -> Bool
$cmaximum :: forall v a. Ord a => Stanza v a -> a
maximum :: forall a. Ord a => Stanza v a -> a
$cminimum :: forall v a. Ord a => Stanza v a -> a
minimum :: forall a. Ord a => Stanza v a -> a
$csum :: forall v a. Num a => Stanza v a -> a
sum :: forall a. Num a => Stanza v a -> a
$cproduct :: forall v a. Num a => Stanza v a -> a
product :: forall a. Num a => Stanza v a -> a
Foldable, Functor (Stanza v)
Foldable (Stanza v)
(Functor (Stanza v), Foldable (Stanza v)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Stanza v a -> f (Stanza v b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Stanza v (f a) -> f (Stanza v a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Stanza v a -> m (Stanza v b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Stanza v (m a) -> m (Stanza v a))
-> Traversable (Stanza v)
forall v. Functor (Stanza v)
forall v. Foldable (Stanza v)
forall v (m :: * -> *) a.
Monad m =>
Stanza v (m a) -> m (Stanza v a)
forall v (f :: * -> *) a.
Applicative f =>
Stanza v (f a) -> f (Stanza v a)
forall v (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Stanza v a -> m (Stanza v b)
forall v (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Stanza v a -> f (Stanza v b)
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Stanza v (m a) -> m (Stanza v a)
forall (f :: * -> *) a.
Applicative f =>
Stanza v (f a) -> f (Stanza v a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Stanza v a -> m (Stanza v b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Stanza v a -> f (Stanza v b)
$ctraverse :: forall v (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Stanza v a -> f (Stanza v b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Stanza v a -> f (Stanza v b)
$csequenceA :: forall v (f :: * -> *) a.
Applicative f =>
Stanza v (f a) -> f (Stanza v a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Stanza v (f a) -> f (Stanza v a)
$cmapM :: forall v (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Stanza v a -> m (Stanza v b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Stanza v a -> m (Stanza v b)
$csequence :: forall v (m :: * -> *) a.
Monad m =>
Stanza v (m a) -> m (Stanza v a)
sequence :: forall (m :: * -> *) a. Monad m => Stanza v (m a) -> m (Stanza v a)
Traversable, (forall a b. (a -> b) -> Stanza v a -> Stanza v b)
-> (forall a b. a -> Stanza v b -> Stanza v a)
-> Functor (Stanza v)
forall a b. a -> Stanza v b -> Stanza v a
forall a b. (a -> b) -> Stanza v a -> Stanza v b
forall v a b. a -> Stanza v b -> Stanza v a
forall v a b. (a -> b) -> Stanza v a -> Stanza v b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall v a b. (a -> b) -> Stanza v a -> Stanza v b
fmap :: forall a b. (a -> b) -> Stanza v a -> Stanza v b
$c<$ :: forall v a b. a -> Stanza v b -> Stanza v a
<$ :: forall a b. a -> Stanza v b -> Stanza v a
Functor)

getVars :: (Var v) => Stanza v term -> [v]
getVars :: forall v term. Var v => Stanza v term -> [v]
getVars = \case
  WatchBinding WatchKind
_ Ann
_ ((Ann
_, v
v), term
_) -> [v
v]
  WatchExpression WatchKind
_ Text
guid Ann
_ term
_ -> [Text -> v
forall v. Var v => Text -> v
Var.unnamedTest Text
guid]
  Binding ((Ann
_, v
v), term
_) -> [v
v]
  Bindings [((Ann, v), term)]
bs -> [v
v | ((Ann
_, v
v), term
_) <- [((Ann, v), term)]
bs]

stanza :: (Monad m, Var v) => P v m (Stanza v (Term v Ann))
stanza :: forall (m :: * -> *) v.
(Monad m, Var v) =>
P v m (Stanza v (Term v Ann))
stanza = ParsecT
  (Error v) Input (ReaderT (ParsingEnv m) m) (Stanza v (Term v Ann))
watchExpression ParsecT
  (Error v) Input (ReaderT (ParsingEnv m) m) (Stanza v (Term v Ann))
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Stanza v (Term v Ann))
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Stanza v (Term 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
<|> ParsecT
  (Error v) Input (ReaderT (ParsingEnv m) m) (Stanza v (Term v Ann))
unexpectedAction ParsecT
  (Error v) Input (ReaderT (ParsingEnv m) m) (Stanza v (Term v Ann))
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Stanza v (Term v Ann))
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Stanza v (Term 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
<|> ParsecT
  (Error v) Input (ReaderT (ParsingEnv m) m) (Stanza v (Term v Ann))
binding
  where
    unexpectedAction :: ParsecT
  (Error v) Input (ReaderT (ParsingEnv m) m) (Stanza v (Term v Ann))
unexpectedAction = P v
  m
  (ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Stanza v (Term v Ann)))
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Stanza v (Term v Ann))
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Stanza v (Term v Ann))
forall v (m :: * -> *) b a.
Ord v =>
P v m (P v m b) -> P v m a -> P v m b
failureIf (TermP v m
forall (m :: * -> *) v. (Monad m, Var v) => TermP v m
TermParser.blockTerm TermP v m
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Stanza v (Term v Ann))
-> P v
     m
     (ParsecT
        (Error v) Input (ReaderT (ParsingEnv m) m) (Stanza v (Term v Ann)))
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ParsecT
  (Error v) Input (ReaderT (ParsingEnv m) m) (Stanza v (Term v Ann))
forall {m :: * -> *} {a}.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
getErr) ParsecT
  (Error v) Input (ReaderT (ParsingEnv m) m) (Stanza v (Term v Ann))
binding
    getErr :: ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
getErr = do
      Token Lexeme
t <- P v m (Token Lexeme)
forall v (m :: * -> *). Ord v => P v m (Token Lexeme)
anyToken
      Maybe (Token Lexeme)
t2 <- P v m (Token Lexeme)
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Maybe (Token Lexeme))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional P v m (Token Lexeme)
forall v (m :: * -> *). Ord v => P v m (Token Lexeme)
anyToken
      Error v -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
P.customFailure (Error v -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a)
-> Error v -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall a b. (a -> b) -> a -> b
$ Token Lexeme -> Maybe (Token Lexeme) -> Error v
forall v. Token Lexeme -> Maybe (Token Lexeme) -> Error v
DidntExpectExpression Token Lexeme
t Maybe (Token Lexeme)
t2
    watchExpression :: ParsecT
  (Error v) Input (ReaderT (ParsingEnv m) m) (Stanza v (Term v Ann))
watchExpression = do
      (WatchKind
kind, Text
guid, Ann
ann) <- P v m (WatchKind, Text, Ann)
forall (m :: * -> *) v.
(Monad m, Var v) =>
P v m (WatchKind, Text, Ann)
watched
      ()
_ <- Ann -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) ()
forall {v} {m :: * -> *}.
Ord v =>
Ann -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) ()
guardEmptyWatch Ann
ann
      [ParsecT
   (Error v) Input (ReaderT (ParsingEnv m) m) (Stanza v (Term v Ann))]
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Stanza v (Term v Ann))
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
        [ P v m ((Ann, v), Term v Ann)
forall (m :: * -> *) v.
(Monad m, Var v) =>
P v m ((Ann, v), Term v Ann)
TermParser.binding P v m ((Ann, v), Term v Ann)
-> (((Ann, v), Term v Ann) -> Stanza v (Term v Ann))
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Stanza v (Term v Ann))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (\trm :: ((Ann, v), Term v Ann)
trm@(((Ann
trmSpanAnn, v
_), Term v Ann
_)) -> WatchKind -> Ann -> ((Ann, v), Term v Ann) -> Stanza v (Term v Ann)
forall v term.
WatchKind -> Ann -> ((Ann, v), term) -> Stanza v term
WatchBinding WatchKind
kind (Ann
ann Ann -> Ann -> Ann
forall a. Semigroup a => a -> a -> a
<> Ann
trmSpanAnn) ((Ann, v), Term v Ann)
trm),
          TermP v m
forall (m :: * -> *) v. (Monad m, Var v) => TermP v m
TermParser.blockTerm TermP v m
-> (Term v Ann -> Stanza v (Term v Ann))
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Stanza v (Term v Ann))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (\Term v Ann
trm -> WatchKind -> Text -> Ann -> Term v Ann -> Stanza v (Term v Ann)
forall v term. WatchKind -> Text -> Ann -> term -> Stanza v term
WatchExpression WatchKind
kind Text
guid (Ann
ann Ann -> Ann -> Ann
forall a. Semigroup a => a -> a -> a
<> Term v Ann -> Ann
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term v Ann
trm) Term v Ann
trm)
        ]

    guardEmptyWatch :: Ann -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) ()
guardEmptyWatch Ann
ann =
      ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) ()
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) ()
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) ()
 -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) ())
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) ()
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) ()
forall a b. (a -> b) -> a -> b
$ do
        Maybe ()
op <- ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) ()
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Token () -> ()
forall a. Token a -> a
L.payload (Token () -> ())
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) ()
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) (Token ())
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.lookAhead ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
forall v (m :: * -> *). Ord v => P v m (Token ())
closeBlock)
        case Maybe ()
op of
          Just () -> Error v -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) ()
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
P.customFailure (Ann -> Error v
forall v. Ann -> Error v
EmptyWatch Ann
ann)
          Maybe ()
_ -> () -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) ()
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

    -- binding :: forall v. Var v => P v ((Ann, v), Term v Ann)
    binding :: ParsecT
  (Error v) Input (ReaderT (ParsingEnv m) m) (Stanza v (Term v Ann))
binding = do
      -- this logic converts
      --   {{ A doc }}  to   foo.doc = {{ A doc }}
      --   foo = 42          foo = 42
      Maybe (Ann, Term v Ann)
doc <- ParsecT
  (Error v) Input (ReaderT (ParsingEnv m) m) (Ann, Term v Ann)
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Maybe (Ann, Term v Ann))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (ParsecT
  (Error v) Input (ReaderT (ParsingEnv m) m) (Ann, Term v Ann)
forall (m :: * -> *) v. (Monad m, Var v) => P v m (Ann, Term v Ann)
TermParser.doc2Block ParsecT
  (Error v) Input (ReaderT (ParsingEnv m) m) (Ann, Term v Ann)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Ann, Term 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 ())
forall v (m :: * -> *). Ord v => P v m (Token ())
semi)
      binding :: ((Ann, v), Term v Ann)
binding@((Ann
_, v
v), Term v Ann
_) <- P v m ((Ann, v), Term v Ann)
forall (m :: * -> *) v.
(Monad m, Var v) =>
P v m ((Ann, v), Term v Ann)
TermParser.binding
      pure $ case Maybe (Ann, Term v Ann)
doc of
        Maybe (Ann, Term v Ann)
Nothing -> ((Ann, v), Term v Ann) -> Stanza v (Term v Ann)
forall v term. ((Ann, v), term) -> Stanza v term
Binding ((Ann, v), Term v Ann)
binding
        Just (Ann
spanAnn, Term v Ann
doc) -> [((Ann, v), Term v Ann)] -> Stanza v (Term v Ann)
forall v term. [((Ann, v), term)] -> Stanza v term
Bindings [((Ann
spanAnn, v -> v -> v
forall v. Var v => v -> v -> v
Var.namespaced2 v
v (Text -> v
forall v. Var v => Text -> v
Var.named Text
"doc")), Term v Ann
doc), ((Ann, v), Term v Ann)
binding]

watched :: (Monad m, Var v) => P v m (UF.WatchKind, Text, Ann)
watched :: forall (m :: * -> *) v.
(Monad m, Var v) =>
P v m (WatchKind, Text, Ann)
watched = ParsecT
  (Error v) Input (ReaderT (ParsingEnv m) m) (WatchKind, Text, Ann)
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (WatchKind, Text, Ann)
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try do
  Maybe (Token WatchKind)
kind <- ((Maybe (Token Name) -> Maybe (Token WatchKind))
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Maybe (Token Name))
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Maybe (Token WatchKind))
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 ((Maybe (Token Name) -> Maybe (Token WatchKind))
 -> ParsecT
      (Error v) Input (ReaderT (ParsingEnv m) m) (Maybe (Token Name))
 -> ParsecT
      (Error v)
      Input
      (ReaderT (ParsingEnv m) m)
      (Maybe (Token WatchKind)))
-> ((Name -> WatchKind)
    -> Maybe (Token Name) -> Maybe (Token WatchKind))
-> (Name -> WatchKind)
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Maybe (Token Name))
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Maybe (Token WatchKind))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Token Name -> Token WatchKind)
-> Maybe (Token Name) -> Maybe (Token WatchKind)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Token Name -> Token WatchKind)
 -> Maybe (Token Name) -> Maybe (Token WatchKind))
-> ((Name -> WatchKind) -> Token Name -> Token WatchKind)
-> (Name -> WatchKind)
-> Maybe (Token Name)
-> Maybe (Token WatchKind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> WatchKind) -> Token Name -> Token WatchKind
forall a b. (a -> b) -> Token a -> Token b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (Text -> WatchKind
Text.unpack (Text -> WatchKind) -> (Name -> Text) -> Name -> WatchKind
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Text
Name.toText) (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 ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token Name)
forall v (m :: * -> *). Ord v => P v m (Token Name)
importWordyId)
  Text
guid <- Int -> P v m Text
forall (m :: * -> *) v. (Monad m, Var v) => Int -> P v m Text
uniqueName Int
10
  Maybe Name
op <- ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) Name
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Maybe Name)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Token Name -> Name
forall a. Token a -> a
L.payload (Token Name -> Name)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token Name)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token Name)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token Name)
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.lookAhead ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token Name)
forall v (m :: * -> *). Ord v => P v m (Token Name)
importSymbolyId)
  Bool -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Maybe Name
op Maybe Name -> Maybe Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> Maybe Name
forall a. a -> Maybe a
Just (NameSegment -> Name
Name.fromSegment NameSegment
NameSegment.watchSegment))
  Token Lexeme
tok <- P v m (Token Lexeme)
forall v (m :: * -> *). Ord v => P v m (Token Lexeme)
anyToken
  Bool -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) ())
-> Bool -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) ()
forall a b. (a -> b) -> a -> b
$ Bool
-> (Token WatchKind -> Bool) -> Maybe (Token WatchKind) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Token WatchKind -> Token Lexeme -> Bool
forall a b. Token a -> Token b -> Bool
`L.touches` Token Lexeme
tok) Maybe (Token WatchKind)
kind
  pure (WatchKind
-> (Token WatchKind -> WatchKind)
-> Maybe (Token WatchKind)
-> WatchKind
forall b a. b -> (a -> b) -> Maybe a -> b
maybe WatchKind
forall a. (Eq a, IsString a) => a
UF.RegularWatch Token WatchKind -> WatchKind
forall a. Token a -> a
L.payload Maybe (Token WatchKind)
kind, Text
guid, Ann -> (Token WatchKind -> Ann) -> Maybe (Token WatchKind) -> Ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Ann
forall a. Monoid a => a
mempty Token WatchKind -> Ann
forall a. Annotated a => a -> Ann
ann Maybe (Token WatchKind)
kind Ann -> Ann -> Ann
forall a. Semigroup a => a -> a -> a
<> Token Lexeme -> Ann
forall a. Annotated a => a -> Ann
ann Token Lexeme
tok)