module Unison.Syntax.FileParser
( file,
)
where
import Control.Lens
import Control.Monad.Reader (asks, local)
import Data.Foldable (foldlM)
import Data.List qualified as List
import Data.Map qualified as Map
import Data.Set qualified as Set
import Data.Text qualified as Text
import Text.Megaparsec qualified as P
import Unison.ABT qualified as ABT
import Unison.DataDeclaration (DataDeclaration (..), EffectDeclaration)
import Unison.DataDeclaration qualified as DataDeclaration
import Unison.DataDeclaration.Records (generateRecordAccessors)
import Unison.Name qualified as Name
import Unison.NameSegment qualified as NameSegment
import Unison.Names qualified as Names
import Unison.Names.ResolutionResult qualified as Names
import Unison.Parser.Ann (Ann)
import Unison.Parser.Ann qualified as Ann
import Unison.Prelude
import Unison.Reference (TypeReferenceId)
import Unison.Syntax.DeclParser (SynDataDecl (..), SynDecl (..), SynEffectDecl (..), synDeclConstructors, synDeclName, synDeclsP)
import Unison.Syntax.Lexer qualified as L
import Unison.Syntax.Name qualified as Name (toText, toVar, unsafeParseVar)
import Unison.Syntax.Parser
import Unison.Syntax.TermParser qualified as TermParser
import Unison.Syntax.Var qualified as Var (namespaced, namespaced2)
import Unison.Term (Term, Term2)
import Unison.Term qualified as Term
import Unison.Type (Type)
import Unison.Type qualified as Type
import Unison.UnisonFile (UnisonFile (..))
import Unison.UnisonFile.Env qualified as UF
import Unison.UnisonFile.Names qualified as UFN
import Unison.Util.List qualified as List
import Unison.Var (Var)
import Unison.Var qualified as Var
import Unison.WatchKind (WatchKind)
import Unison.WatchKind qualified as UF
import Prelude hiding (readFile)
resolutionFailures :: (Ord v) => [Names.ResolutionFailure Ann] -> P v m x
resolutionFailures :: forall v (m :: * -> *) x.
Ord v =>
[ResolutionFailure Ann] -> P v m x
resolutionFailures [ResolutionFailure Ann]
es = Error v -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) x
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
P.customFailure ([ResolutionFailure Ann] -> Error v
forall v. [ResolutionFailure Ann] -> Error v
ResolutionFailures [ResolutionFailure Ann]
es)
file :: forall m v. (Monad m, Var v) => P v m (UnisonFile v Ann)
file :: forall (m :: * -> *) v.
(Monad m, Var v) =>
P v m (UnisonFile v Ann)
file = do
Token WatchKind
_ <- P v m (Token WatchKind)
forall v (m :: * -> *). Ord v => P v m (Token WatchKind)
openBlock
Maybe Name
maybeNamespace :: Maybe Name.Name <-
P v m (Token WatchKind)
-> ParsecT
(Error v)
Input
(ReaderT (ParsingEnv m) m)
(Maybe (Token WatchKind))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (WatchKind -> P v m (Token WatchKind)
forall v (m :: * -> *).
Ord v =>
WatchKind -> P v m (Token WatchKind)
reserved WatchKind
"namespace") ParsecT
(Error v)
Input
(ReaderT (ParsingEnv m) m)
(Maybe (Token WatchKind))
-> (Maybe (Token WatchKind)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Maybe Name))
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Maybe Name)
forall a b.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> (a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe (Token WatchKind)
Nothing -> Maybe Name
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Maybe Name)
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Name
forall a. Maybe a
Nothing
Just Token WatchKind
_ -> do
Token Name
namespace <- P v m (Token Name)
forall v (m :: * -> *). Ord v => P v m (Token Name)
importWordyId P v m (Token Name) -> P v m (Token Name) -> P v m (Token Name)
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P v m (Token Name)
forall v (m :: * -> *). Ord v => P v m (Token Name)
importSymbolyId
ParsecT
(Error v) Input (ReaderT (ParsingEnv m) m) (Maybe (Token ()))
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
-> ParsecT
(Error v) Input (ReaderT (ParsingEnv m) m) (Maybe (Token ()))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
forall v (m :: * -> *). Ord v => P v m (Token ())
semi)
pure (Name -> Maybe Name
forall a. a -> Maybe a
Just Token Name
namespace.payload)
let maybeNamespaceVar :: Maybe v
maybeNamespaceVar = Name -> v
forall v. Var v => Name -> v
Name.toVar (Name -> v) -> Maybe Name -> Maybe v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Name
maybeNamespace
(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
[SynDecl v]
unNamespacedSynDecls <- (ParsingEnv m -> ParsingEnv m)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) [SynDecl v]
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) [SynDecl v]
forall a.
(ParsingEnv m -> ParsingEnv m)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\ParsingEnv m
e -> ParsingEnv m
e {maybeNamespace}) ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) [SynDecl v]
forall (m :: * -> *) v. (Monad m, Var v) => P v m [SynDecl v]
synDeclsP
[SynDecl v]
unNamespacedSynDecls
[SynDecl v]
-> ([SynDecl v] -> [(v, SynDecl v)]) -> [(v, SynDecl v)]
forall a b. a -> (a -> b) -> b
& (SynDecl v -> (v, SynDecl v)) -> [SynDecl v] -> [(v, SynDecl v)]
forall a b. (a -> b) -> [a] -> [b]
List.map (\SynDecl v
decl -> (Token v -> v
forall a. Token a -> a
L.payload (SynDecl v -> Token v
forall v. SynDecl v -> Token v
synDeclName SynDecl v
decl), SynDecl v
decl))
[(v, SynDecl v)]
-> ([(v, SynDecl v)] -> Map v [SynDecl v]) -> Map v [SynDecl v]
forall a b. a -> (a -> b) -> b
& [(v, SynDecl v)] -> Map v [SynDecl v]
forall (f :: * -> *) k v.
(Foldable f, Ord k) =>
f (k, v) -> Map k [v]
List.multimap
Map v [SynDecl v]
-> (Map v [SynDecl v] -> [(v, [SynDecl v])]) -> [(v, [SynDecl v])]
forall a b. a -> (a -> b) -> b
& Map v [SynDecl v] -> [(v, [SynDecl v])]
forall k a. Map k a -> [(k, a)]
Map.toList
[(v, [SynDecl v])]
-> ([(v, [SynDecl v])] -> [(v, [Ann])]) -> [(v, [Ann])]
forall a b. a -> (a -> b) -> b
& ((v, [SynDecl v]) -> Maybe (v, [Ann]))
-> [(v, [SynDecl v])] -> [(v, [Ann])]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe \case
(v
name, decls :: [SynDecl v]
decls@(SynDecl v
_ : SynDecl v
_ : [SynDecl v]
_)) -> (v, [Ann]) -> Maybe (v, [Ann])
forall a. a -> Maybe a
Just (v
name, (SynDecl v -> Ann) -> [SynDecl v] -> [Ann]
forall a b. (a -> b) -> [a] -> [b]
map SynDecl v -> Ann
forall a. Annotated a => a -> Ann
ann [SynDecl v]
decls)
(v, [SynDecl v])
_ -> Maybe (v, [Ann])
forall a. Maybe a
Nothing
[(v, [Ann])]
-> ([(v, [Ann])]
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) ())
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) ()
forall a b. a -> (a -> b) -> b
& \case
[] -> () -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) ()
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
[(v, [Ann])]
dupes -> Error v -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) ()
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
P.customFailure ([(v, [Ann])] -> Error v
forall v. [(v, [Ann])] -> Error v
DuplicateTypeNames [(v, [Ann])]
dupes)
let synDecls :: [SynDecl v]
synDecls = ([SynDecl v] -> [SynDecl v])
-> (v -> [SynDecl v] -> [SynDecl v])
-> Maybe v
-> [SynDecl v]
-> [SynDecl v]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [SynDecl v] -> [SynDecl v]
forall a. a -> a
id v -> [SynDecl v] -> [SynDecl v]
forall v. Var v => v -> [SynDecl v] -> [SynDecl v]
applyNamespaceToSynDecls Maybe v
maybeNamespaceVar [SynDecl v]
unNamespacedSynDecls
Env v Ann
env <- do
(Map v (DataDeclaration v Ann)
dataDecls, Map v (EffectDeclaration v Ann)
effectDecls) <- [SynDecl v]
-> P v
m
(Map v (DataDeclaration v Ann), Map v (EffectDeclaration v Ann))
forall (m :: * -> *) v.
(Monad m, Var v) =>
[SynDecl v]
-> P v
m
(Map v (DataDeclaration v Ann), Map v (EffectDeclaration v Ann))
synDeclsToDecls [SynDecl v]
synDecls
Either [Error v Ann] (Env v Ann)
result <- Names
-> Map v (DataDeclaration v Ann)
-> Map v (EffectDeclaration v Ann)
-> ResolutionResult Ann (Either [Error v Ann] (Env v Ann))
forall v a.
Var v =>
Names
-> Map v (DataDeclaration v a)
-> Map v (EffectDeclaration v a)
-> ResolutionResult a (Either [Error v a] (Env v a))
UFN.environmentFor Names
namesStart Map v (DataDeclaration v Ann)
dataDecls Map v (EffectDeclaration v Ann)
effectDecls ResolutionResult Ann (Either [Error v Ann] (Env v Ann))
-> (ResolutionResult Ann (Either [Error v Ann] (Env v Ann))
-> ParsecT
(Error v)
Input
(ReaderT (ParsingEnv m) m)
(Either [Error v Ann] (Env v Ann)))
-> ParsecT
(Error v)
Input
(ReaderT (ParsingEnv m) m)
(Either [Error v Ann] (Env v Ann))
forall a b. a -> (a -> b) -> b
& (Seq (ResolutionFailure Ann)
-> ParsecT
(Error v)
Input
(ReaderT (ParsingEnv m) m)
(Either [Error v Ann] (Env v Ann)))
-> ResolutionResult Ann (Either [Error v Ann] (Env v Ann))
-> ParsecT
(Error v)
Input
(ReaderT (ParsingEnv m) m)
(Either [Error v Ann] (Env v Ann))
forall (m :: * -> *) a b.
Applicative m =>
(a -> m b) -> Either a b -> m b
onLeft \Seq (ResolutionFailure Ann)
errs -> [ResolutionFailure Ann]
-> ParsecT
(Error v)
Input
(ReaderT (ParsingEnv m) m)
(Either [Error v Ann] (Env v Ann))
forall v (m :: * -> *) x.
Ord v =>
[ResolutionFailure Ann] -> P v m x
resolutionFailures (Seq (ResolutionFailure Ann) -> [ResolutionFailure Ann]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (ResolutionFailure Ann)
errs)
Either [Error v Ann] (Env v Ann)
result Either [Error v Ann] (Env v Ann)
-> (Either [Error v Ann] (Env v Ann)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Env v Ann))
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Env v Ann)
forall a b. a -> (a -> b) -> b
& ([Error v Ann]
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Env v Ann))
-> Either [Error v Ann] (Env v Ann)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Env v Ann)
forall (m :: * -> *) a b.
Applicative m =>
(a -> m b) -> Either a b -> m b
onLeft \[Error v Ann]
errs -> Error v
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Env v Ann)
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
P.customFailure ([Error v Ann] -> Error v
forall v. [Error v Ann] -> Error v
TypeDeclarationErrors [Error v Ann]
errs)
let unNamespacedAccessors :: [(v, Ann, Term v Ann)]
unNamespacedAccessors :: [(v, Ann, Term v Ann)]
unNamespacedAccessors =
(SynDecl v -> [(v, Ann, Term v Ann)])
-> [SynDecl v] -> [(v, Ann, Term v Ann)]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
( \case
SynDecl'Data SynDataDecl v
decl
| Just [(Token v, Type v Ann)]
fields <- SynDataDecl v
decl.fields,
Just (Reference
ref, DataDeclaration v Ann
_) <-
v
-> Map v (Reference, DataDeclaration v Ann)
-> Maybe (Reference, DataDeclaration v Ann)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ((v -> v) -> (v -> v -> v) -> Maybe v -> v -> v
forall b a. b -> (a -> b) -> Maybe a -> b
maybe v -> v
forall a. a -> a
id v -> v -> v
forall v. Var v => v -> v -> v
Var.namespaced2 Maybe v
maybeNamespaceVar SynDataDecl v
decl.name.payload) (Env v Ann -> Map v (Reference, DataDeclaration v Ann)
forall v a. Env v a -> Map v (Reference, DataDeclaration v a)
UF.datas Env v Ann
env) ->
(NonEmpty v -> v)
-> (Ann -> Ann)
-> [(v, Ann)]
-> v
-> Reference
-> [(v, Ann, Term v Ann)]
forall a v.
(Semigroup a, Var v) =>
(NonEmpty v -> v)
-> (a -> a) -> [(v, a)] -> v -> Reference -> [(v, a, Term v a)]
generateRecordAccessors
NonEmpty v -> v
forall v. Var v => NonEmpty v -> v
Var.namespaced
Ann -> Ann
Ann.GeneratedFrom
((Token v, Type v Ann) -> (v, Ann)
forall {a} {a} {a}.
(HasField "payload" a a, Annotated a, Annotated a) =>
(a, a) -> (a, Ann)
toPair ((Token v, Type v Ann) -> (v, Ann))
-> [(Token v, Type v Ann)] -> [(v, Ann)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Token v, Type v Ann)]
fields)
SynDataDecl v
decl.name.payload
Reference
ref
SynDecl v
_ -> []
)
[SynDecl v]
unNamespacedSynDecls
where
toPair :: (a, a) -> (a, Ann)
toPair (a
tok, a
typ) = (a
tok.payload, a -> Ann
forall a. Annotated a => a -> Ann
ann a
tok Ann -> Ann -> Ann
forall a. Semigroup a => a -> a -> a
<> a -> Ann
forall a. Annotated a => a -> Ann
ann a
typ)
let accessors :: [(v, Ann, Term v Ann)]
accessors :: [(v, Ann, Term v Ann)]
accessors =
[(v, Ann, Term v Ann)]
unNamespacedAccessors
[(v, Ann, Term v Ann)]
-> ([(v, Ann, Term v Ann)] -> [(v, Ann, Term v Ann)])
-> [(v, Ann, Term v Ann)]
forall a b. a -> (a -> b) -> b
& case Maybe v
maybeNamespaceVar of
Maybe v
Nothing -> [(v, Ann, Term v Ann)] -> [(v, Ann, Term v Ann)]
forall a. a -> a
id
Just v
namespace -> ASetter [(v, Ann, Term v Ann)] [(v, Ann, Term v Ann)] v v
-> (v -> v) -> [(v, Ann, Term v Ann)] -> [(v, Ann, Term v Ann)]
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (((v, Ann, Term v Ann) -> Identity (v, Ann, Term v Ann))
-> [(v, Ann, Term v Ann)] -> Identity [(v, Ann, Term v Ann)]
Setter
[(v, Ann, Term v Ann)]
[(v, Ann, Term v Ann)]
(v, Ann, Term v Ann)
(v, Ann, Term v Ann)
forall (f :: * -> *) a b. Functor f => Setter (f a) (f b) a b
mapped (((v, Ann, Term v Ann) -> Identity (v, Ann, Term v Ann))
-> [(v, Ann, Term v Ann)] -> Identity [(v, Ann, Term v Ann)])
-> ((v -> Identity v)
-> (v, Ann, Term v Ann) -> Identity (v, Ann, Term v Ann))
-> ASetter [(v, Ann, Term v Ann)] [(v, Ann, Term v Ann)] v v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v -> Identity v)
-> (v, Ann, Term v Ann) -> Identity (v, Ann, Term v Ann)
forall s t a b. Field1 s t a b => Lens s t a b
Lens (v, Ann, Term v Ann) (v, Ann, Term v Ann) v v
_1) (v -> v -> v
forall v. Var v => v -> v -> v
Var.namespaced2 v
namespace)
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),
(SynDecl v -> Set v) -> [SynDecl v] -> Set v
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ([v] -> Set v
forall a. Ord a => [a] -> Set a
Set.fromList ([v] -> Set v) -> (SynDecl v -> [v]) -> SynDecl v -> Set v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ann, v, Type v Ann) -> v) -> [(Ann, v, Type v Ann)] -> [v]
forall a b. (a -> b) -> [a] -> [b]
map (Getting v (Ann, v, Type v Ann) v -> (Ann, v, Type v Ann) -> v
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting v (Ann, v, Type v Ann) v
forall s t a b. Field2 s t a b => Lens s t a b
Lens (Ann, v, Type v Ann) (Ann, v, Type v Ann) v v
_2) ([(Ann, v, Type v Ann)] -> [v])
-> (SynDecl v -> [(Ann, v, Type v Ann)]) -> SynDecl v -> [v]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SynDecl v -> [(Ann, v, Type v Ann)]
forall v. SynDecl v -> [(Ann, v, Type v Ann)]
synDeclConstructors) [SynDecl v]
unNamespacedSynDecls,
[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)
applyNamespaceToSynDecls :: forall v. (Var v) => v -> [SynDecl v] -> [SynDecl v]
applyNamespaceToSynDecls :: forall v. Var v => v -> [SynDecl v] -> [SynDecl v]
applyNamespaceToSynDecls v
namespace [SynDecl v]
decls =
(SynDecl v -> SynDecl v) -> [SynDecl v] -> [SynDecl v]
forall a b. (a -> b) -> [a] -> [b]
map
( \case
SynDecl'Data SynDataDecl v
decl ->
SynDataDecl v -> SynDecl v
forall v. SynDataDecl v -> SynDecl v
SynDecl'Data
( SynDataDecl v
decl
SynDataDecl v -> (SynDataDecl v -> SynDataDecl v) -> SynDataDecl v
forall a b. a -> (a -> b) -> b
& ASetter
(SynDataDecl v)
(SynDataDecl v)
(Ann, v, Type v Ann)
(Ann, v, Type v Ann)
-> ((Ann, v, Type v Ann) -> (Ann, v, Type v Ann))
-> SynDataDecl v
-> SynDataDecl v
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (([(Ann, v, Type v Ann)] -> Identity [(Ann, v, Type v Ann)])
-> SynDataDecl v -> Identity (SynDataDecl v)
#constructors (([(Ann, v, Type v Ann)] -> Identity [(Ann, v, Type v Ann)])
-> SynDataDecl v -> Identity (SynDataDecl v))
-> (((Ann, v, Type v Ann) -> Identity (Ann, v, Type v Ann))
-> [(Ann, v, Type v Ann)] -> Identity [(Ann, v, Type v Ann)])
-> ASetter
(SynDataDecl v)
(SynDataDecl v)
(Ann, v, Type v Ann)
(Ann, v, Type v Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ann, v, Type v Ann) -> Identity (Ann, v, Type v Ann))
-> [(Ann, v, Type v Ann)] -> Identity [(Ann, v, Type v Ann)]
Setter
[(Ann, v, Type v Ann)]
[(Ann, v, Type v Ann)]
(Ann, v, Type v Ann)
(Ann, v, Type v Ann)
forall (f :: * -> *) a b. Functor f => Setter (f a) (f b) a b
mapped) (Ann, v, Type v Ann) -> (Ann, v, Type v Ann)
applyToConstructor
SynDataDecl v -> (SynDataDecl v -> SynDataDecl v) -> SynDataDecl v
forall a b. a -> (a -> b) -> b
& ASetter (SynDataDecl v) (SynDataDecl v) v v
-> (v -> v) -> SynDataDecl v -> SynDataDecl v
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ((Token v -> Identity (Token v))
-> SynDataDecl v -> Identity (SynDataDecl v)
#name ((Token v -> Identity (Token v))
-> SynDataDecl v -> Identity (SynDataDecl v))
-> ((v -> Identity v) -> Token v -> Identity (Token v))
-> ASetter (SynDataDecl v) (SynDataDecl v) v v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v -> Identity v) -> Token v -> Identity (Token v)
Setter (Token v) (Token v) v v
forall (f :: * -> *) a b. Functor f => Setter (f a) (f b) a b
mapped) (v -> v -> v
forall v. Var v => v -> v -> v
Var.namespaced2 v
namespace)
)
SynDecl'Effect SynEffectDecl v
decl ->
SynEffectDecl v -> SynDecl v
forall v. SynEffectDecl v -> SynDecl v
SynDecl'Effect
( SynEffectDecl v
decl
SynEffectDecl v
-> (SynEffectDecl v -> SynEffectDecl v) -> SynEffectDecl v
forall a b. a -> (a -> b) -> b
& ASetter
(SynEffectDecl v)
(SynEffectDecl v)
(Ann, v, Type v Ann)
(Ann, v, Type v Ann)
-> ((Ann, v, Type v Ann) -> (Ann, v, Type v Ann))
-> SynEffectDecl v
-> SynEffectDecl v
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (([(Ann, v, Type v Ann)] -> Identity [(Ann, v, Type v Ann)])
-> SynEffectDecl v -> Identity (SynEffectDecl v)
#constructors (([(Ann, v, Type v Ann)] -> Identity [(Ann, v, Type v Ann)])
-> SynEffectDecl v -> Identity (SynEffectDecl v))
-> (((Ann, v, Type v Ann) -> Identity (Ann, v, Type v Ann))
-> [(Ann, v, Type v Ann)] -> Identity [(Ann, v, Type v Ann)])
-> ASetter
(SynEffectDecl v)
(SynEffectDecl v)
(Ann, v, Type v Ann)
(Ann, v, Type v Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ann, v, Type v Ann) -> Identity (Ann, v, Type v Ann))
-> [(Ann, v, Type v Ann)] -> Identity [(Ann, v, Type v Ann)]
Setter
[(Ann, v, Type v Ann)]
[(Ann, v, Type v Ann)]
(Ann, v, Type v Ann)
(Ann, v, Type v Ann)
forall (f :: * -> *) a b. Functor f => Setter (f a) (f b) a b
mapped) (Ann, v, Type v Ann) -> (Ann, v, Type v Ann)
applyToConstructor
SynEffectDecl v
-> (SynEffectDecl v -> SynEffectDecl v) -> SynEffectDecl v
forall a b. a -> (a -> b) -> b
& ASetter (SynEffectDecl v) (SynEffectDecl v) v v
-> (v -> v) -> SynEffectDecl v -> SynEffectDecl v
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ((Token v -> Identity (Token v))
-> SynEffectDecl v -> Identity (SynEffectDecl v)
#name ((Token v -> Identity (Token v))
-> SynEffectDecl v -> Identity (SynEffectDecl v))
-> ((v -> Identity v) -> Token v -> Identity (Token v))
-> ASetter (SynEffectDecl v) (SynEffectDecl v) v v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v -> Identity v) -> Token v -> Identity (Token v)
Setter (Token v) (Token v) v v
forall (f :: * -> *) a b. Functor f => Setter (f a) (f b) a b
mapped) (v -> v -> v
forall v. Var v => v -> v -> v
Var.namespaced2 v
namespace)
)
)
[SynDecl v]
decls
where
applyToConstructor :: (Ann, v, Type v Ann) -> (Ann, v, Type v Ann)
applyToConstructor :: (Ann, v, Type v Ann) -> (Ann, v, Type v Ann)
applyToConstructor (Ann
ann, v
name, Type v Ann
typ) =
( Ann
ann,
v -> v -> v
forall v. Var v => v -> v -> v
Var.namespaced2 v
namespace v
name,
[(v, Term F v ())] -> Type v Ann -> Type v Ann
forall (f :: * -> *) v b a.
(Foldable f, Functor f, Var v) =>
[(v, Term f v b)] -> Term f v a -> Term f v a
ABT.substsInheritAnnotation [(v, Term F v ())]
typeReplacements Type v Ann
typ
)
typeReplacements :: [(v, Type v ())]
typeReplacements :: [(v, Term F v ())]
typeReplacements =
[SynDecl v]
decls
[SynDecl v] -> ([SynDecl v] -> Set v) -> Set v
forall a b. a -> (a -> b) -> b
& (Set v -> SynDecl v -> Set v) -> Set v -> [SynDecl v] -> Set v
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (\Set v
acc SynDecl v
decl -> v -> Set v -> Set v
forall a. Ord a => a -> Set a -> Set a
Set.insert (Token v -> v
forall a. Token a -> a
L.payload (SynDecl v -> Token v
forall v. SynDecl v -> Token v
synDeclName SynDecl v
decl)) Set v
acc) Set v
forall a. Set a
Set.empty
Set v -> (Set v -> [v]) -> [v]
forall a b. a -> (a -> b) -> b
& Set v -> [v]
forall a. Set a -> [a]
Set.toList
[v] -> ([v] -> [(v, Term F v ())]) -> [(v, Term F v ())]
forall a b. a -> (a -> b) -> b
& (v -> (v, Term F v ())) -> [v] -> [(v, Term F v ())]
forall a b. (a -> b) -> [a] -> [b]
map (\v
v -> (v
v, () -> v -> Term F v ()
forall v a. Ord v => a -> v -> Type v a
Type.var () (v -> v -> v
forall v. Var v => v -> v -> v
Var.namespaced2 v
namespace v
v)))
synDeclsToDecls :: (Monad m, Var v) => [SynDecl v] -> P v m (Map v (DataDeclaration v Ann), Map v (EffectDeclaration v Ann))
synDeclsToDecls :: forall (m :: * -> *) v.
(Monad m, Var v) =>
[SynDecl v]
-> P v
m
(Map v (DataDeclaration v Ann), Map v (EffectDeclaration v Ann))
synDeclsToDecls = do
((Map v (DataDeclaration v Ann), Map v (EffectDeclaration v Ann))
-> SynDecl v
-> P v
m
(Map v (DataDeclaration v Ann), Map v (EffectDeclaration v Ann)))
-> (Map v (DataDeclaration v Ann), Map v (EffectDeclaration v Ann))
-> [SynDecl v]
-> P v
m
(Map v (DataDeclaration v Ann), Map v (EffectDeclaration v Ann))
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM
( \(Map v (DataDeclaration v Ann)
datas, Map v (EffectDeclaration v Ann)
effects) -> \case
SynDecl'Data SynDataDecl v
decl -> do
let decl1 :: DataDeclaration v Ann
decl1 = Modifier
-> Ann -> [v] -> [(Ann, v, Type v Ann)] -> DataDeclaration v Ann
forall v a.
Modifier -> a -> [v] -> [(a, v, Type v a)] -> DataDeclaration v a
DataDeclaration SynDataDecl v
decl.modifier SynDataDecl v
decl.annotation SynDataDecl v
decl.tyvars SynDataDecl v
decl.constructors
let !datas1 :: Map v (DataDeclaration v Ann)
datas1 = v
-> DataDeclaration v Ann
-> Map v (DataDeclaration v Ann)
-> Map v (DataDeclaration v Ann)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert SynDataDecl v
decl.name.payload DataDeclaration v Ann
decl1 Map v (DataDeclaration v Ann)
datas
(Map v (DataDeclaration v Ann), Map v (EffectDeclaration v Ann))
-> P v
m
(Map v (DataDeclaration v Ann), Map v (EffectDeclaration v Ann))
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map v (DataDeclaration v Ann)
datas1, Map v (EffectDeclaration v Ann)
effects)
SynDecl'Effect SynEffectDecl v
decl -> do
let decl1 :: EffectDeclaration v Ann
decl1 = Modifier
-> Ann -> [v] -> [(Ann, v, Type v Ann)] -> EffectDeclaration v Ann
forall a v.
Modifier -> a -> [v] -> [(a, v, Type v a)] -> EffectDeclaration v a
DataDeclaration.mkEffectDecl' SynEffectDecl v
decl.modifier SynEffectDecl v
decl.annotation SynEffectDecl v
decl.tyvars SynEffectDecl v
decl.constructors
let !effects1 :: Map v (EffectDeclaration v Ann)
effects1 = v
-> EffectDeclaration v Ann
-> Map v (EffectDeclaration v Ann)
-> Map v (EffectDeclaration v Ann)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert SynEffectDecl v
decl.name.payload EffectDeclaration v Ann
decl1 Map v (EffectDeclaration v Ann)
effects
(Map v (DataDeclaration v Ann), Map v (EffectDeclaration v Ann))
-> P v
m
(Map v (DataDeclaration v Ann), Map v (EffectDeclaration v Ann))
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map v (DataDeclaration v Ann)
datas, Map v (EffectDeclaration v Ann)
effects1)
)
(Map v (DataDeclaration v Ann)
forall k a. Map k a
Map.empty, Map v (EffectDeclaration v Ann)
forall k a. Map k a
Map.empty)
applyNamespaceToStanza ::
forall a v.
(Var v) =>
v ->
Set v ->
Stanza v (Term v a) ->
Stanza v (Term v a)
applyNamespaceToStanza :: forall a v.
Var v =>
v -> Set v -> Stanza v (Term v a) -> Stanza v (Term v a)
applyNamespaceToStanza v
namespace Set v
locallyBoundTerms = \case
Binding ((Ann, v), Term v a)
x -> ((Ann, v), Term v a) -> Stanza v (Term v a)
forall v term. ((Ann, v), term) -> Stanza v term
Binding (((Ann, v), Term v a) -> ((Ann, v), Term v a)
goBinding ((Ann, v), Term v a)
x)
Bindings [((Ann, v), Term v a)]
xs -> [((Ann, v), Term v a)] -> Stanza v (Term v a)
forall v term. [((Ann, v), term)] -> Stanza v term
Bindings ((((Ann, v), Term v a) -> ((Ann, v), Term v a))
-> [((Ann, v), Term v a)] -> [((Ann, v), Term v a)]
forall a b. (a -> b) -> [a] -> [b]
map ((Ann, v), Term v a) -> ((Ann, v), Term v a)
goBinding [((Ann, v), Term v a)]
xs)
WatchBinding WatchKind
wk Ann
ann ((Ann, v), Term v a)
x -> WatchKind -> Ann -> ((Ann, v), Term v a) -> Stanza v (Term v a)
forall v term.
WatchKind -> Ann -> ((Ann, v), term) -> Stanza v term
WatchBinding WatchKind
wk Ann
ann (((Ann, v), Term v a) -> ((Ann, v), Term v a)
goBinding ((Ann, v), Term v a)
x)
WatchExpression WatchKind
wk Text
guid Ann
ann Term v a
term -> WatchKind -> Text -> Ann -> Term v a -> Stanza v (Term v a)
forall v term. WatchKind -> Text -> Ann -> term -> Stanza v term
WatchExpression WatchKind
wk Text
guid Ann
ann (Term v a -> Term v a
goTerm Term v a
term)
where
goBinding :: ((Ann, v), Term v a) -> ((Ann, v), Term v a)
goBinding :: ((Ann, v), Term v a) -> ((Ann, v), Term v a)
goBinding ((Ann
ann, v
name), Term v a
term) =
((Ann
ann, v -> v -> v
forall v. Var v => v -> v -> v
Var.namespaced2 v
namespace v
name), Term v a -> Term v a
goTerm Term v a
term)
goTerm :: Term v a -> Term v a
goTerm :: Term v a -> Term v a
goTerm =
[(v, Term (F v a a) v ())] -> Term v a -> Term v a
forall (f :: * -> *) v b a.
(Foldable f, Functor f, Var v) =>
[(v, Term f v b)] -> Term f v a -> Term f v a
ABT.substsInheritAnnotation [(v, Term (F v a a) v ())]
replacements
replacements :: [(v, Term2 v a a v ())]
replacements :: [(v, Term (F v a a) v ())]
replacements =
Set v
locallyBoundTerms
Set v -> (Set v -> [v]) -> [v]
forall a b. a -> (a -> b) -> b
& Set v -> [v]
forall a. Set a -> [a]
Set.toList
[v]
-> ([v] -> [(v, Term (F v a a) v ())])
-> [(v, Term (F v a a) v ())]
forall a b. a -> (a -> b) -> b
& (v -> (v, Term (F v a a) v ()))
-> [v] -> [(v, Term (F v a a) v ())]
forall a b. (a -> b) -> [a] -> [b]
map (\v
v -> (v
v, () -> v -> Term (F v a a) v ()
forall a v vt at ap. a -> v -> Term2 vt at ap v a
Term.var () (v -> v -> v
forall v. Var v => v -> v -> v
Var.namespaced2 v
namespace v
v)))
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
DataDeclaration.toDataDecl (EffectDeclaration v Ann -> DataDeclaration v Ann)
-> ((TypeReferenceId, EffectDeclaration v Ann)
-> EffectDeclaration v Ann)
-> (TypeReferenceId, EffectDeclaration v Ann)
-> DataDeclaration v Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TypeReferenceId, EffectDeclaration v Ann)
-> EffectDeclaration v Ann
forall a b. (a, b) -> b
snd) (Map v (TypeReferenceId, EffectDeclaration v Ann)
-> [DataDeclaration v Ann])
-> Map v (TypeReferenceId, EffectDeclaration v Ann)
-> [DataDeclaration v Ann]
forall a b. (a -> b) -> a -> b
$ Map v (TypeReferenceId, EffectDeclaration v Ann)
effects
dataDecls :: [DataDeclaration v Ann]
dataDecls :: [DataDeclaration v Ann]
dataDecls = ((TypeReferenceId, DataDeclaration v Ann) -> DataDeclaration v Ann)
-> [(TypeReferenceId, DataDeclaration v Ann)]
-> [DataDeclaration v Ann]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TypeReferenceId, DataDeclaration v Ann) -> DataDeclaration v Ann
forall a b. (a, b) -> b
snd ([(TypeReferenceId, DataDeclaration v Ann)]
-> [DataDeclaration v Ann])
-> [(TypeReferenceId, DataDeclaration v Ann)]
-> [DataDeclaration v Ann]
forall a b. (a -> b) -> a -> b
$ Map v (TypeReferenceId, DataDeclaration v Ann)
-> [(TypeReferenceId, DataDeclaration v Ann)]
forall k a. Map k a -> [a]
Map.elems Map v (TypeReferenceId, DataDeclaration v Ann)
datas
allConstructors :: [(v, Ann)]
allConstructors :: [(v, Ann)]
allConstructors =
([DataDeclaration v Ann]
dataDecls [DataDeclaration v Ann]
-> [DataDeclaration v Ann] -> [DataDeclaration v Ann]
forall a. Semigroup a => a -> a -> a
<> [DataDeclaration v Ann]
effectDecls)
[DataDeclaration v Ann]
-> ([DataDeclaration v Ann] -> [(Ann, v, Type v Ann)])
-> [(Ann, v, Type v Ann)]
forall a b. a -> (a -> b) -> b
& (DataDeclaration v Ann -> [(Ann, v, Type v Ann)])
-> [DataDeclaration v Ann] -> [(Ann, v, Type v Ann)]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap DataDeclaration v Ann -> [(Ann, v, Type v Ann)]
forall v a. DataDeclaration v a -> [(a, v, Type v a)]
DataDeclaration.constructors'
[(Ann, v, Type v Ann)]
-> ([(Ann, v, Type v Ann)] -> [(v, Ann)]) -> [(v, Ann)]
forall a b. a -> (a -> b) -> b
& ((Ann, v, Type v Ann) -> (v, Ann))
-> [(Ann, v, Type v Ann)] -> [(v, Ann)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Ann
ann, v
v, Type v Ann
_typ) -> (v
v, Ann
ann))
allTerms :: [(v, Ann)]
allTerms :: [(v, Ann)]
allTerms =
((v, Ann, Term v Ann) -> (v, Ann))
-> [(v, Ann, Term v Ann)] -> [(v, Ann)]
forall a b. (a -> b) -> [a] -> [b]
map (\(v
v, Ann
ann, Term v Ann
_term) -> (v
v, Ann
ann)) [(v, Ann, Term v Ann)]
terms
mergedTerms :: Map v (Set Ann)
mergedTerms :: Map v (Set Ann)
mergedTerms =
([(v, Ann)]
allConstructors [(v, Ann)] -> [(v, Ann)] -> [(v, Ann)]
forall a. Semigroup a => a -> a -> a
<> [(v, Ann)]
allTerms)
[(v, Ann)] -> ([(v, Ann)] -> [(v, Set Ann)]) -> [(v, Set Ann)]
forall a b. a -> (a -> b) -> b
& (((v, Ann) -> (v, Set Ann)) -> [(v, Ann)] -> [(v, Set Ann)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((v, Ann) -> (v, Set Ann)) -> [(v, Ann)] -> [(v, Set Ann)])
-> ((Ann -> Set Ann) -> (v, Ann) -> (v, Set Ann))
-> (Ann -> Set Ann)
-> [(v, Ann)]
-> [(v, Set Ann)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ann -> Set Ann) -> (v, Ann) -> (v, Set Ann)
forall a b. (a -> b) -> (v, a) -> (v, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) Ann -> Set Ann
forall a. a -> Set a
Set.singleton
[(v, Set Ann)]
-> ([(v, Set Ann)] -> Map v (Set Ann)) -> Map v (Set Ann)
forall a b. a -> (a -> b) -> b
& (Set Ann -> Set Ann -> Set Ann)
-> [(v, Set Ann)] -> Map v (Set Ann)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Set Ann -> Set Ann -> Set Ann
forall a. Ord a => Set a -> Set a -> Set a
Set.union
duplicates :: Map v (Set Ann)
duplicates :: Map v (Set Ann)
duplicates =
(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)