module Unison.Syntax.FileParser
  ( file,
  )
where

import Control.Lens
import Control.Monad.Reader (asks, local)
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 DD
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 (declarations)
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
_ -> Name -> Maybe Name
forall a. a -> Maybe a
Just (Name -> Maybe Name)
-> (Token Name -> Name) -> Token Name -> Maybe Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token Name -> Name
forall a. Token a -> a
L.payload (Token Name -> Maybe Name)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token Name)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Maybe Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> 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)
-> 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
-> 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 Name)
forall v (m :: * -> *). Ord v => P v m (Token Name)
importSymbolyId)
  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
  (Map v (DataDeclaration v Ann)
dataDecls, Map v (EffectDeclaration v Ann)
effectDecls, Accessors v
parsedAccessors) <- P v
  m
  (Map v (DataDeclaration v Ann), Map v (EffectDeclaration v Ann),
   Accessors v)
forall (m :: * -> *) v.
(Monad m, Var v) =>
P v
  m
  (Map v (DataDeclaration v Ann), Map v (EffectDeclaration v Ann),
   Accessors v)
declarations

  Env v Ann
env <-
    let applyNamespaceToDecls :: forall decl. Iso' decl (DataDeclaration v Ann) -> Map v decl -> Map v decl
        applyNamespaceToDecls :: forall decl.
Iso' decl (DataDeclaration v Ann) -> Map v decl -> Map v decl
applyNamespaceToDecls Iso' decl (DataDeclaration v Ann)
dataDeclL =
          case Maybe v
maybeNamespaceVar of
            Maybe v
Nothing -> Map v decl -> Map v decl
forall a. a -> a
id
            Just v
namespace -> [(v, decl)] -> Map v decl
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(v, decl)] -> Map v decl)
-> (Map v decl -> [(v, decl)]) -> Map v decl -> Map v decl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((v, decl) -> (v, decl)) -> [(v, decl)] -> [(v, decl)]
forall a b. (a -> b) -> [a] -> [b]
map (v, decl) -> (v, decl)
f ([(v, decl)] -> [(v, decl)])
-> (Map v decl -> [(v, decl)]) -> Map v decl -> [(v, decl)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map v decl -> [(v, decl)]
forall k a. Map k a -> [(k, a)]
Map.toList
              where
                f :: (v, decl) -> (v, decl)
                f :: (v, decl) -> (v, decl)
f (v
declName, decl
decl) =
                  ( v -> v -> v
forall v. Var v => v -> v -> v
Var.namespaced2 v
namespace v
declName,
                    AReview decl (DataDeclaration v Ann)
-> DataDeclaration v Ann -> decl
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview decl (DataDeclaration v Ann)
Iso' decl (DataDeclaration v Ann)
dataDeclL (v -> Set v -> DataDeclaration v Ann -> DataDeclaration v Ann
forall a v.
Var v =>
v -> Set v -> DataDeclaration v a -> DataDeclaration v a
applyNamespaceToDataDecl v
namespace Set v
unNamespacedTypeNames (Getting (DataDeclaration v Ann) decl (DataDeclaration v Ann)
-> decl -> DataDeclaration v Ann
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (DataDeclaration v Ann) decl (DataDeclaration v Ann)
Iso' decl (DataDeclaration v Ann)
dataDeclL decl
decl))
                  )

                unNamespacedTypeNames :: Set v
                unNamespacedTypeNames :: Set v
unNamespacedTypeNames =
                  Set v -> Set v -> Set v
forall a. Ord a => Set a -> Set a -> Set a
Set.union (Map v (DataDeclaration v Ann) -> Set v
forall k a. Map k a -> Set k
Map.keysSet Map v (DataDeclaration v Ann)
dataDecls) (Map v (EffectDeclaration v Ann) -> Set v
forall k a. Map k a -> Set k
Map.keysSet Map v (EffectDeclaration v Ann)
effectDecls)

        dataDecls1 :: Map v (DataDeclaration v Ann)
dataDecls1 = Iso' (DataDeclaration v Ann) (DataDeclaration v Ann)
-> Map v (DataDeclaration v Ann) -> Map v (DataDeclaration v Ann)
forall decl.
Iso' decl (DataDeclaration v Ann) -> Map v decl -> Map v decl
applyNamespaceToDecls p (DataDeclaration v Ann) (f (DataDeclaration v Ann))
-> p (DataDeclaration v Ann) (f (DataDeclaration v Ann))
forall a. a -> a
Iso' (DataDeclaration v Ann) (DataDeclaration v Ann)
id Map v (DataDeclaration v Ann)
dataDecls
        effectDecls1 :: Map v (EffectDeclaration v Ann)
effectDecls1 = Iso' (EffectDeclaration v Ann) (DataDeclaration v Ann)
-> Map v (EffectDeclaration v Ann)
-> Map v (EffectDeclaration v Ann)
forall decl.
Iso' decl (DataDeclaration v Ann) -> Map v decl -> Map v decl
applyNamespaceToDecls p (DataDeclaration v Ann) (f (DataDeclaration v Ann))
-> p (EffectDeclaration v Ann) (f (EffectDeclaration v Ann))
forall v a (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (DataDeclaration v a) (f (DataDeclaration v a))
-> p (EffectDeclaration v a) (f (EffectDeclaration v a))
Iso' (EffectDeclaration v Ann) (DataDeclaration v Ann)
DataDeclaration.asDataDecl_ Map v (EffectDeclaration v Ann)
effectDecls
     in case 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)
dataDecls1 Map v (EffectDeclaration v Ann)
effectDecls1 of
          Right (Right Env v Ann
env) -> Env v Ann
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Env v Ann)
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Env v Ann
env
          Right (Left [Error v Ann]
es) -> 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
 -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Env v Ann))
-> Error v
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Env v Ann)
forall a b. (a -> b) -> a -> b
$ [Error v Ann] -> Error v
forall v. [Error v Ann] -> Error v
TypeDeclarationErrors [Error v Ann]
es
          Left Seq (ResolutionFailure Ann)
es -> [ResolutionFailure Ann]
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (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)
es)
  let unNamespacedAccessors :: [(v, Ann, Term v Ann)]
      unNamespacedAccessors :: [(v, Ann, Term v Ann)]
unNamespacedAccessors = do
        (Token v
typ, [(Token v, Type v Ann)]
fields) <- Accessors v
parsedAccessors
        -- The parsed accessor has an un-namespaced type, so apply the namespace directive (if necessary) before
        -- looking up in the environment computed by `environmentFor`.
        let typ1 :: v
typ1 = (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 (Token v -> v
forall a. Token a -> a
L.payload Token v
typ)
        Just (Reference
r, 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
typ1 (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)]
        -- Generate the record accessors with *un-namespaced* names (passing `typ` rather than `typ1`) 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).
        (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}. Annotated a => (Token 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) (Token v -> v
forall a. Token a -> a
L.payload Token v
typ) Reference
r
        where
          toPair :: (Token a, a) -> (a, Ann)
toPair (Token a
tok, a
typ) = (Token a -> a
forall a. Token a -> a
L.payload Token a
tok, Token a -> Ann
forall a. Annotated a => a -> Ann
ann Token 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)
                        (DataDeclaration v Ann -> Set v)
-> Map v (DataDeclaration v Ann) -> Set v
forall m a. Monoid m => (a -> m) -> Map v 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)
-> (DataDeclaration v Ann -> [v]) -> DataDeclaration v Ann -> Set v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataDeclaration v Ann -> [v]
forall v a. DataDeclaration v a -> [v]
DataDeclaration.constructorVars) Map v (DataDeclaration v Ann)
dataDecls,
                        (EffectDeclaration v Ann -> Set v)
-> Map v (EffectDeclaration v Ann) -> Set v
forall m a. Monoid m => (a -> m) -> Map v 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)
-> (EffectDeclaration v Ann -> [v])
-> EffectDeclaration v Ann
-> Set v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataDeclaration v Ann -> [v]
forall v a. DataDeclaration v a -> [v]
DataDeclaration.constructorVars (DataDeclaration v Ann -> [v])
-> (EffectDeclaration v Ann -> DataDeclaration v Ann)
-> EffectDeclaration v Ann
-> [v]
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
DataDeclaration.toDataDecl) Map v (EffectDeclaration v Ann)
effectDecls,
                        -- 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)

applyNamespaceToDataDecl :: forall a v. (Var v) => v -> Set v -> DataDeclaration v a -> DataDeclaration v a
applyNamespaceToDataDecl :: forall a v.
Var v =>
v -> Set v -> DataDeclaration v a -> DataDeclaration v a
applyNamespaceToDataDecl v
namespace Set v
locallyBoundTypes =
  ASetter
  (DataDeclaration v a)
  (DataDeclaration v a)
  (a, v, Type v a)
  (a, v, Type v a)
-> ((a, v, Type v a) -> (a, v, Type v a))
-> DataDeclaration v a
-> DataDeclaration v a
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (([(a, v, Type v a)] -> Identity [(a, v, Type v a)])
-> DataDeclaration v a -> Identity (DataDeclaration v a)
forall v a (f :: * -> *).
Functor f =>
([(a, v, Type v a)] -> f [(a, v, Type v a)])
-> DataDeclaration v a -> f (DataDeclaration v a)
DataDeclaration.constructors_ (([(a, v, Type v a)] -> Identity [(a, v, Type v a)])
 -> DataDeclaration v a -> Identity (DataDeclaration v a))
-> (((a, v, Type v a) -> Identity (a, v, Type v a))
    -> [(a, v, Type v a)] -> Identity [(a, v, Type v a)])
-> ASetter
     (DataDeclaration v a)
     (DataDeclaration v a)
     (a, v, Type v a)
     (a, v, Type v a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, v, Type v a) -> Identity (a, v, Type v a))
-> [(a, v, Type v a)] -> Identity [(a, v, Type v a)]
Setter
  [(a, v, Type v a)]
  [(a, v, Type v a)]
  (a, v, Type v a)
  (a, v, Type v a)
forall (f :: * -> *) a b. Functor f => Setter (f a) (f b) a b
mapped) \(a
ann, v
conName, Type v a
conTy) ->
    (a
ann, v -> v -> v
forall v. Var v => v -> v -> v
Var.namespaced2 v
namespace v
conName, [(v, Term F v ())] -> Type v a -> Type 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 ())]
replacements Type v a
conTy)
  where
    -- Replace var "Foo" with var "namespace.Foo"
    replacements :: [(v, Type v ())]
    replacements :: [(v, Term F v ())]
replacements =
      Set v
locallyBoundTypes
        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)))

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
DD.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)]
DD.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)