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
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
(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
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)]
(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)
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
[
[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),
(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,
[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)
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
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)))
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
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 =
(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
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 :: ParsecT
(Error v) Input (ReaderT (ParsingEnv m) m) (Stanza v (Term v Ann))
binding = do
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)