module Unison.Codebase.Editor.HandleInput.Run
  ( handleRun,
  )
where

import Algebra.Graph.AdjacencyMap qualified as Graph
import Control.Lens ((.=), _1)
import Control.Monad.Except (Except)
import Control.Monad.Except qualified as Except
import Control.Monad.Reader (ask)
import Control.Monad.State.Strict (StateT)
import Control.Monad.State.Strict qualified as State
import Data.List qualified as List
import Data.Map.Merge.Strict qualified as Map
import Data.Map.Strict qualified as Map
import Data.Set qualified as Set
import Data.Set.Internal qualified as Set.Internal
import U.Codebase.Sqlite.Operations qualified as Operations
import Unison.ABT qualified as ABT
import Unison.Builtin qualified as Builtin
import Unison.Builtin.Decls qualified as DD
import Unison.Cli.Monad (Cli)
import Unison.Cli.Monad qualified as Cli
import Unison.Cli.MonadUtils qualified as Cli
import Unison.Cli.NamesUtils qualified as Cli
import Unison.Codebase qualified as Codebase
import Unison.Codebase.Branch qualified as Branch
import Unison.Codebase.Branch.Names qualified as Branch
import Unison.Codebase.Editor.HandleInput.Load (EvalMode (..), evalUnisonFile)
import Unison.Codebase.Editor.Output qualified as Output
import Unison.Codebase.MainTerm qualified as MainTerm
import Unison.Codebase.Runtime qualified as Runtime
import Unison.Codebase.Runtime.Profile (ProfileSpec (..))
import Unison.Hash qualified as Hash
import Unison.HashQualified qualified as HQ
import Unison.Name (Name)
import Unison.Parser.Ann (Ann (External))
import Unison.Prelude
import Unison.PrettyPrintEnv qualified as PPE
import Unison.PrettyPrintEnv.Names qualified as PPE
import Unison.PrettyPrintEnvDecl qualified as PPED
import Unison.Reference (Reference, TermReference, TermReferenceId, TypeReference, TypeReferenceId)
import Unison.Reference qualified as Reference
import Unison.Referent (Referent)
import Unison.Referent qualified as Referent
import Unison.Result qualified as Result
import Unison.Symbol (Symbol)
import Unison.Syntax.HashQualified qualified as HQ
import Unison.Syntax.Name qualified as Name
import Unison.Term (Term)
import Unison.Term qualified as Term
import Unison.Type (Type)
import Unison.Type qualified as Type
import Unison.Typechecker qualified as Typechecker
import Unison.Typechecker.TypeLookup (TypeLookup)
import Unison.Typechecker.TypeLookup qualified as TypeLookup
import Unison.Typechecker.Variance qualified as Variance
import Unison.UnisonFile (TypecheckedUnisonFile)
import Unison.UnisonFile qualified as UF
import Unison.UnisonFile.Names qualified as UF
import Unison.Util.Defn (Defn (..))
import Unison.Util.Defns (Defns (..), DefnsF, DefnsF2, defnsAreEmpty, zipDefnsWith)
import Unison.Util.Defns qualified as Defns
import Unison.Util.Map qualified as Map
import Unison.Util.Monoid qualified as Monoid
import Unison.Util.Recursion (cata)
import Unison.Util.Relation qualified as Relation
import Unison.Util.Set qualified as Set
import Unison.Var qualified as Var

handleRun :: ProfileSpec -> HQ.HashQualified Name -> [String] -> Cli ()
handleRun :: ProfileSpec -> HashQualified Name -> [String] -> Cli ()
handleRun ProfileSpec
prof HashQualified Name
main [String]
args = do
  (TypecheckedUnisonFile Symbol Ann
unisonFile, Type Symbol Ann
mainResType, Maybe TermReference
codebaseRef) <- do
    (Symbol
sym, Term Symbol Ann
term, Type Symbol Ann
typ, Type Symbol Ann
otyp, Maybe TermReference
codebaseRef) <- HashQualified Name
-> Cli
     (Symbol, Term Symbol Ann, Type Symbol Ann, Type Symbol Ann,
      Maybe TermReference)
getTerm HashQualified Name
main
    TypecheckedUnisonFile Symbol Ann
uf <- Symbol
-> Term Symbol Ann
-> Type Symbol Ann
-> Cli (TypecheckedUnisonFile Symbol Ann)
createWatcherFile Symbol
sym Term Symbol Ann
term Type Symbol Ann
typ
    (TypecheckedUnisonFile Symbol Ann, Type Symbol Ann,
 Maybe TermReference)
-> Cli
     (TypecheckedUnisonFile Symbol Ann, Type Symbol Ann,
      Maybe TermReference)
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypecheckedUnisonFile Symbol Ann
uf, Type Symbol Ann
otyp, Maybe TermReference
codebaseRef)

  HashQualified Name -> Maybe TermReference -> Cli ()
checkStale HashQualified Name
main Maybe TermReference
codebaseRef

  Names
names <- Cli Names
Cli.currentNames
  let namesWithFileDefinitions :: Names
namesWithFileDefinitions = TypecheckedUnisonFile Symbol Ann -> Names -> Names
forall v a. Var v => TypecheckedUnisonFile v a -> Names -> Names
UF.addNamesFromTypeCheckedUnisonFile TypecheckedUnisonFile Symbol Ann
unisonFile Names
names
  let pped :: PrettyPrintEnvDecl
pped = Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
10 Names
namesWithFileDefinitions) (Names -> Suffixifier
PPE.suffixifyByHash Names
namesWithFileDefinitions)
  let ppe :: PrettyPrintEnv
ppe = PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.suffixifiedPPE PrettyPrintEnvDecl
pped
  let mode :: EvalMode
mode = ProfileSpec -> EvalMode
Permissive ProfileSpec
prof

  ([(Symbol, Term Symbol ())]
_, Map Symbol (Ann, String, Id, Term Symbol (), Term Symbol (), Bool)
xs) <-
    EvalMode
-> PrettyPrintEnv
-> TypecheckedUnisonFile Symbol Ann
-> [String]
-> Cli
     (Either
        Error
        ([(Symbol, Term Symbol ())],
         Map
           Symbol (Ann, String, Id, Term Symbol (), Term Symbol (), Bool)))
evalUnisonFile EvalMode
mode PrettyPrintEnv
ppe TypecheckedUnisonFile Symbol Ann
unisonFile [String]
args Cli
  (Either
     Error
     ([(Symbol, Term Symbol ())],
      Map
        Symbol (Ann, String, Id, Term Symbol (), Term Symbol (), Bool)))
-> (Cli
      (Either
         Error
         ([(Symbol, Term Symbol ())],
          Map
            Symbol (Ann, String, Id, Term Symbol (), Term Symbol (), Bool)))
    -> Cli
         ([(Symbol, Term Symbol ())],
          Map
            Symbol (Ann, String, Id, Term Symbol (), Term Symbol (), Bool)))
-> Cli
     ([(Symbol, Term Symbol ())],
      Map Symbol (Ann, String, Id, Term Symbol (), Term Symbol (), Bool))
forall a b. a -> (a -> b) -> b
& (Error
 -> Cli
      ([(Symbol, Term Symbol ())],
       Map
         Symbol (Ann, String, Id, Term Symbol (), Term Symbol (), Bool)))
-> Cli
     (Either
        Error
        ([(Symbol, Term Symbol ())],
         Map
           Symbol (Ann, String, Id, Term Symbol (), Term Symbol (), Bool)))
-> Cli
     ([(Symbol, Term Symbol ())],
      Map Symbol (Ann, String, Id, Term Symbol (), Term Symbol (), Bool))
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> m (Either a b) -> m b
onLeftM \Error
err ->
      Output
-> Cli
     ([(Symbol, Term Symbol ())],
      Map Symbol (Ann, String, Id, Term Symbol (), Term Symbol (), Bool))
forall a. Output -> Cli a
Cli.returnEarly ((Pretty ColorText -> Pretty ColorText) -> Error -> Output
Output.EvaluationFailure Pretty ColorText -> Pretty ColorText
forall a. a -> a
id Error
err)

  Term Symbol ()
mainRes :: Term Symbol () <-
    case String -> [(String, Term Symbol ())] -> Maybe (Term Symbol ())
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
magicMainWatcherString (((Symbol, (Ann, String, Id, Term Symbol (), Term Symbol (), Bool))
 -> (String, Term Symbol ()))
-> [(Symbol,
     (Ann, String, Id, Term Symbol (), Term Symbol (), Bool))]
-> [(String, Term Symbol ())]
forall a b. (a -> b) -> [a] -> [b]
map (Symbol, (Ann, String, Id, Term Symbol (), Term Symbol (), Bool))
-> (String, Term Symbol ())
forall {a} {a} {a} {c} {d} {b} {f}.
(a, (a, a, c, d, b, f)) -> (a, b)
bonk (Map Symbol (Ann, String, Id, Term Symbol (), Term Symbol (), Bool)
-> [(Symbol,
     (Ann, String, Id, Term Symbol (), Term Symbol (), Bool))]
forall k a. Map k a -> [(k, a)]
Map.toList Map Symbol (Ann, String, Id, Term Symbol (), Term Symbol (), Bool)
xs)) of
      Maybe (Term Symbol ())
Nothing ->
        String -> Cli (Term Symbol ())
forall a. HasCallStack => String -> a
error
          ( String
"impossible: we manually added the watcher "
              String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
forall a. Show a => a -> String
show String
magicMainWatcherString
              String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" with 'createWatcherFile', but it isn't here."
          )
      Just Term Symbol ()
x -> Term Symbol () -> Cli (Term Symbol ())
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypecheckedUnisonFile Symbol Ann
-> Term Symbol () -> Term Symbol ()
forall a.
TypecheckedUnisonFile Symbol a -> Term Symbol () -> Term Symbol ()
stripUnisonFileReferences TypecheckedUnisonFile Symbol Ann
unisonFile Term Symbol ()
x)
  #lastRunResult .= Just (Term.amap (\() -> External) mainRes, mainResType, unisonFile)
  Output -> Cli ()
Cli.respond (PrettyPrintEnv -> Term Symbol () -> Output
Output.RunResult PrettyPrintEnv
ppe Term Symbol ()
mainRes)
  where
    bonk :: (a, (a, a, c, d, b, f)) -> (a, b)
bonk (a
_, (a
_ann, a
watchKind, c
_id, d
_term0, b
term1, f
_isCacheHit)) =
      (a
watchKind, b
term1)

data GetTermResult
  = NoTermWithThatName
  | TermHasBadType (Type Symbol Ann)
  | GetTermSuccess (Symbol, Term Symbol Ann, Type Symbol Ann, Type Symbol Ann, Maybe TermReference)

-- | Look up runnable term with the given name in the codebase or
-- latest typechecked unison file. Return its symbol, term, type, and
-- the type of the evaluated term, and whether it was found in the codebase (Just ref) or file (Nothing)
getTerm :: HQ.HashQualified Name -> Cli (Symbol, Term Symbol Ann, Type Symbol Ann, Type Symbol Ann, Maybe TermReference)
getTerm :: HashQualified Name
-> Cli
     (Symbol, Term Symbol Ann, Type Symbol Ann, Type Symbol Ann,
      Maybe TermReference)
getTerm HashQualified Name
main =
  HashQualified Name -> Cli GetTermResult
getTerm' HashQualified Name
main Cli GetTermResult
-> (GetTermResult
    -> Cli
         (Symbol, Term Symbol Ann, Type Symbol Ann, Type Symbol Ann,
          Maybe TermReference))
-> Cli
     (Symbol, Term Symbol Ann, Type Symbol Ann, Type Symbol Ann,
      Maybe TermReference)
forall a b. Cli a -> (a -> Cli b) -> Cli b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    GetTermResult
NoTermWithThatName -> do
      Type Symbol Ann
mainType <- Runtime Error DecompError Symbol -> Type Symbol Ann
forall e e' v. Runtime e e' v -> Type v Ann
Runtime.mainType (Runtime Error DecompError Symbol -> Type Symbol Ann)
-> Cli (Runtime Error DecompError Symbol) -> Cli (Type Symbol Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting
  (Runtime Error DecompError Symbol)
  Env
  (Runtime Error DecompError Symbol)
-> Cli (Runtime Error DecompError Symbol)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Runtime Error DecompError Symbol)
  Env
  (Runtime Error DecompError Symbol)
#runtime
      Names
names <- Cli Names
Cli.currentNames
      let pped :: PrettyPrintEnvDecl
pped = Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
10 Names
names) (Names -> Suffixifier
PPE.suffixifyByHash Names
names)
      let suffixifiedPPE :: PrettyPrintEnv
suffixifiedPPE = PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.suffixifiedPPE PrettyPrintEnvDecl
pped
      Output
-> Cli
     (Symbol, Term Symbol Ann, Type Symbol Ann, Type Symbol Ann,
      Maybe TermReference)
forall a. Output -> Cli a
Cli.returnEarly (Output
 -> Cli
      (Symbol, Term Symbol Ann, Type Symbol Ann, Type Symbol Ann,
       Maybe TermReference))
-> Output
-> Cli
     (Symbol, Term Symbol Ann, Type Symbol Ann, Type Symbol Ann,
      Maybe TermReference)
forall a b. (a -> b) -> a -> b
$ HashQualified Name -> PrettyPrintEnv -> [Type Symbol Ann] -> Output
Output.NoMainFunction HashQualified Name
main PrettyPrintEnv
suffixifiedPPE [Type Symbol Ann
mainType]
    TermHasBadType Type Symbol Ann
ty -> do
      Type Symbol Ann
mainType <- Runtime Error DecompError Symbol -> Type Symbol Ann
forall e e' v. Runtime e e' v -> Type v Ann
Runtime.mainType (Runtime Error DecompError Symbol -> Type Symbol Ann)
-> Cli (Runtime Error DecompError Symbol) -> Cli (Type Symbol Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting
  (Runtime Error DecompError Symbol)
  Env
  (Runtime Error DecompError Symbol)
-> Cli (Runtime Error DecompError Symbol)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Runtime Error DecompError Symbol)
  Env
  (Runtime Error DecompError Symbol)
#runtime
      Names
names <- Cli Names
Cli.currentNames
      let pped :: PrettyPrintEnvDecl
pped = Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
10 Names
names) (Names -> Suffixifier
PPE.suffixifyByHash Names
names)
      let suffixifiedPPE :: PrettyPrintEnv
suffixifiedPPE = PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.suffixifiedPPE PrettyPrintEnvDecl
pped
      Output
-> Cli
     (Symbol, Term Symbol Ann, Type Symbol Ann, Type Symbol Ann,
      Maybe TermReference)
forall a. Output -> Cli a
Cli.returnEarly (Output
 -> Cli
      (Symbol, Term Symbol Ann, Type Symbol Ann, Type Symbol Ann,
       Maybe TermReference))
-> Output
-> Cli
     (Symbol, Term Symbol Ann, Type Symbol Ann, Type Symbol Ann,
      Maybe TermReference)
forall a b. (a -> b) -> a -> b
$ Text
-> HashQualified Name
-> Type Symbol Ann
-> PrettyPrintEnv
-> [Type Symbol Ann]
-> Output
Output.BadMainFunction Text
"run" HashQualified Name
main Type Symbol Ann
ty PrettyPrintEnv
suffixifiedPPE [Type Symbol Ann
mainType]
    GetTermSuccess (Symbol, Term Symbol Ann, Type Symbol Ann, Type Symbol Ann,
 Maybe TermReference)
x -> (Symbol, Term Symbol Ann, Type Symbol Ann, Type Symbol Ann,
 Maybe TermReference)
-> Cli
     (Symbol, Term Symbol Ann, Type Symbol Ann, Type Symbol Ann,
      Maybe TermReference)
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Symbol, Term Symbol Ann, Type Symbol Ann, Type Symbol Ann,
 Maybe TermReference)
x

getTerm' :: HQ.HashQualified Name -> Cli GetTermResult
getTerm' :: HashQualified Name -> Cli GetTermResult
getTerm' HashQualified Name
mainName =
  let getFromCodebase :: Cli GetTermResult
getFromCodebase = do
        Cli.Env {Codebase IO Symbol Ann
codebase :: Codebase IO Symbol Ann
$sel:codebase:Env :: Env -> Codebase IO Symbol Ann
codebase, Runtime Error DecompError Symbol
runtime :: Runtime Error DecompError Symbol
$sel:runtime:Env :: Env -> Runtime Error DecompError Symbol
runtime} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
        Names
names <- Cli Names
Cli.currentNames
        let loadTypeOfTerm :: TermReference -> Cli (Maybe (Type Symbol Ann))
loadTypeOfTerm TermReference
ref = Transaction (Maybe (Type Symbol Ann))
-> Cli (Maybe (Type Symbol Ann))
forall a. Transaction a -> Cli a
Cli.runTransaction (Codebase IO Symbol Ann
-> TermReference -> Transaction (Maybe (Type Symbol Ann))
forall a (m :: * -> *).
BuiltinAnnotation a =>
Codebase m Symbol a
-> TermReference -> Transaction (Maybe (Type Symbol a))
Codebase.getTypeOfTerm Codebase IO Symbol Ann
codebase TermReference
ref)
        MainTerm Symbol -> Cli GetTermResult
mainToFile
          (MainTerm Symbol -> Cli GetTermResult)
-> Cli (MainTerm Symbol) -> Cli GetTermResult
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (TermReference -> Cli (Maybe (Type Symbol Ann)))
-> Names
-> HashQualified Name
-> Type Symbol Ann
-> Cli (MainTerm Symbol)
forall (m :: * -> *) v.
(Monad m, Var v) =>
(TermReference -> m (Maybe (Type v Ann)))
-> Names -> HashQualified Name -> Type v Ann -> m (MainTerm v)
MainTerm.getMainTerm TermReference -> Cli (Maybe (Type Symbol Ann))
loadTypeOfTerm Names
names HashQualified Name
mainName (Runtime Error DecompError Symbol -> Type Symbol Ann
forall e e' v. Runtime e e' v -> Type v Ann
Runtime.mainType Runtime Error DecompError Symbol
runtime)
        where
          mainToFile :: MainTerm Symbol -> Cli GetTermResult
mainToFile (MainTerm.NotFound HashQualified Name
_) = GetTermResult -> Cli GetTermResult
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GetTermResult
NoTermWithThatName
          mainToFile (MainTerm.BadType HashQualified Name
_ Maybe (Type Symbol Ann)
ty) = GetTermResult -> Cli GetTermResult
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GetTermResult -> Cli GetTermResult)
-> GetTermResult -> Cli GetTermResult
forall a b. (a -> b) -> a -> b
$ GetTermResult
-> (Type Symbol Ann -> GetTermResult)
-> Maybe (Type Symbol Ann)
-> GetTermResult
forall b a. b -> (a -> b) -> Maybe a -> b
maybe GetTermResult
NoTermWithThatName Type Symbol Ann -> GetTermResult
TermHasBadType Maybe (Type Symbol Ann)
ty
          mainToFile (MainTerm.Success HashQualified Name
hq TermReference
ref Term Symbol Ann
tm Type Symbol Ann
typ) =
            let v :: Symbol
v = Text -> Symbol
forall v. Var v => Text -> v
Var.named (HashQualified Name -> Text
HQ.toText HashQualified Name
hq)
             in Maybe (TypecheckedUnisonFile Symbol Ann)
-> Type Symbol Ann
-> (Type Symbol Ann -> Cli GetTermResult)
-> Cli GetTermResult
checkType Maybe (TypecheckedUnisonFile Symbol Ann)
forall a. Maybe a
Nothing Type Symbol Ann
typ \Type Symbol Ann
otyp ->
                  GetTermResult -> Cli GetTermResult
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Symbol, Term Symbol Ann, Type Symbol Ann, Type Symbol Ann,
 Maybe TermReference)
-> GetTermResult
GetTermSuccess (Symbol
v, Term Symbol Ann
tm, Type Symbol Ann
typ, Type Symbol Ann
otyp, TermReference -> Maybe TermReference
forall a. a -> Maybe a
Just TermReference
ref))

      getFromFile :: TypecheckedUnisonFile Symbol Ann -> Cli GetTermResult
getFromFile TypecheckedUnisonFile Symbol Ann
uf = do
        let components :: [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]
components = [[(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]]
-> [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]]
 -> [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])
-> [[(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]]
-> [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]
forall a b. (a -> b) -> a -> b
$ TypecheckedUnisonFile Symbol Ann
-> [[(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]]
forall v a.
TypecheckedUnisonFile v a -> [[(v, a, Term v a, Type v a)]]
UF.topLevelComponents TypecheckedUnisonFile Symbol Ann
uf
        -- __TODO__: We shouldn’t need to serialize mainName` for this check
        let mainComponent :: [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]
mainComponent = ((Symbol, Ann, Term Symbol Ann, Type Symbol Ann) -> Bool)
-> [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]
-> [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((\Symbol
v -> Symbol -> Text
forall v. Var v => v -> Text
Var.name Symbol
v Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== HashQualified Name -> Text
HQ.toText HashQualified Name
mainName) (Symbol -> Bool)
-> ((Symbol, Ann, Term Symbol Ann, Type Symbol Ann) -> Symbol)
-> (Symbol, Ann, Term Symbol Ann, Type Symbol Ann)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  Symbol (Symbol, Ann, Term Symbol Ann, Type Symbol Ann) Symbol
-> (Symbol, Ann, Term Symbol Ann, Type Symbol Ann) -> Symbol
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  Symbol (Symbol, Ann, Term Symbol Ann, Type Symbol Ann) Symbol
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (Symbol, Ann, Term Symbol Ann, Type Symbol Ann)
  (Symbol, Ann, Term Symbol Ann, Type Symbol Ann)
  Symbol
  Symbol
_1) [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]
components
        case [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]
mainComponent of
          [(Symbol
v, Ann
_, Term Symbol Ann
tm, Type Symbol Ann
ty)] ->
            Maybe (TypecheckedUnisonFile Symbol Ann)
-> Type Symbol Ann
-> (Type Symbol Ann -> Cli GetTermResult)
-> Cli GetTermResult
checkType (TypecheckedUnisonFile Symbol Ann
-> Maybe (TypecheckedUnisonFile Symbol Ann)
forall a. a -> Maybe a
Just TypecheckedUnisonFile Symbol Ann
uf) Type Symbol Ann
ty \Type Symbol Ann
otyp ->
              let runMain :: Term Symbol Ann
runMain = Ann -> Ann -> Term Symbol Ann -> Term Symbol Ann
forall v a. Var v => a -> a -> Term v a -> Term v a
DD.forceTerm Ann
a Ann
a (Ann -> Symbol -> Term Symbol Ann
forall a v vt at ap. a -> v -> Term2 vt at ap v a
Term.var Ann
a Symbol
v)
                  v2 :: Symbol
v2 = Set Symbol -> Symbol -> Symbol
forall v. Var v => Set v -> v -> v
Var.freshIn ([Symbol] -> Set Symbol
forall a. Ord a => [a] -> Set a
Set.fromList [Symbol
v]) Symbol
v
                  a :: Ann
a = Term Symbol Ann -> Ann
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term Symbol Ann
tm
               in GetTermResult -> Cli GetTermResult
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Symbol, Term Symbol Ann, Type Symbol Ann, Type Symbol Ann,
 Maybe TermReference)
-> GetTermResult
GetTermSuccess (Symbol
v2, Term Symbol Ann
runMain, Type Symbol Ann
ty, Type Symbol Ann
otyp, Maybe TermReference
forall a. Maybe a
Nothing))
          [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]
_ -> Cli GetTermResult
getFromCodebase

      checkType :: Maybe (TypecheckedUnisonFile Symbol Ann) -> Type Symbol Ann -> (Type Symbol Ann -> Cli GetTermResult) -> Cli GetTermResult
      checkType :: Maybe (TypecheckedUnisonFile Symbol Ann)
-> Type Symbol Ann
-> (Type Symbol Ann -> Cli GetTermResult)
-> Cli GetTermResult
checkType Maybe (TypecheckedUnisonFile Symbol Ann)
mayTuf Type Symbol Ann
ty Type Symbol Ann -> Cli GetTermResult
f = do
        Cli.Env {Codebase IO Symbol Ann
$sel:codebase:Env :: Env -> Codebase IO Symbol Ann
codebase :: Codebase IO Symbol Ann
codebase, Runtime Error DecompError Symbol
$sel:runtime:Env :: Env -> Runtime Error DecompError Symbol
runtime :: Runtime Error DecompError Symbol
runtime} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
        let ufDeps :: Set TermReference
ufDeps = Set TermReference
-> (TypecheckedUnisonFile Symbol Ann -> Set TermReference)
-> Maybe (TypecheckedUnisonFile Symbol Ann)
-> Set TermReference
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set TermReference
forall a. Monoid a => a
mempty TypecheckedUnisonFile Symbol Ann -> Set TermReference
forall v a. Ord v => TypecheckedUnisonFile v a -> Set TermReference
UF.externalTypeDependencies Maybe (TypecheckedUnisonFile Symbol Ann)
mayTuf
        case Type Symbol Ann -> Type Symbol Ann -> Bool
forall v loc. Var v => Type v loc -> Type v loc -> Bool
Typechecker.fitsScheme Type Symbol Ann
ty (Runtime Error DecompError Symbol -> Type Symbol Ann
forall e e' v. Runtime e e' v -> Type v Ann
Runtime.mainType Runtime Error DecompError Symbol
runtime) of
          Bool
True -> do
            TypeLookup Symbol Ann
tlCodebase <-
              Transaction (TypeLookup Symbol Ann) -> Cli (TypeLookup Symbol Ann)
forall a. Transaction a -> Cli a
Cli.runTransaction (Transaction (TypeLookup Symbol Ann)
 -> Cli (TypeLookup Symbol Ann))
-> Transaction (TypeLookup Symbol Ann)
-> Cli (TypeLookup Symbol Ann)
forall a b. (a -> b) -> a -> b
$
                Codebase IO Symbol Ann
-> DefnsF Set TermReference TermReference
-> Transaction (TypeLookup Symbol Ann)
Codebase.typeLookupForDependencies Codebase IO Symbol Ann
codebase Defns {$sel:terms:Defns :: Set TermReference
terms = Set TermReference
forall a. Set a
Set.empty, $sel:types:Defns :: Set TermReference
types = Type Symbol Ann -> Set TermReference
forall v a. Ord v => Type v a -> Set TermReference
Type.dependencies Type Symbol Ann
ty Set TermReference -> Set TermReference -> Set TermReference
forall a. Semigroup a => a -> a -> a
<> Set TermReference
ufDeps}
            let tlTuf :: TypeLookup Symbol Ann
tlTuf = Maybe (TypeLookup Symbol Ann) -> TypeLookup Symbol Ann
forall a. Monoid a => Maybe a -> a
Monoid.fromMaybe ((TypecheckedUnisonFile Symbol Ann -> TypeLookup Symbol Ann)
-> Maybe (TypecheckedUnisonFile Symbol Ann)
-> Maybe (TypeLookup Symbol Ann)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TypecheckedUnisonFile Symbol Ann -> TypeLookup Symbol Ann
forall v a. TypecheckedUnisonFile v a -> TypeLookup v a
UF.typecheckedToTypeLookup Maybe (TypecheckedUnisonFile Symbol Ann)
mayTuf)
            Type Symbol Ann -> Cli GetTermResult
f (Type Symbol Ann -> Cli GetTermResult)
-> Type Symbol Ann -> Cli GetTermResult
forall a b. (a -> b) -> a -> b
$! TypeLookup Symbol Ann -> Type Symbol Ann -> Type Symbol Ann
synthesizeForce (TypeLookup Symbol Ann
tlTuf TypeLookup Symbol Ann
-> TypeLookup Symbol Ann -> TypeLookup Symbol Ann
forall a. Semigroup a => a -> a -> a
<> TypeLookup Symbol Ann
tlCodebase) Type Symbol Ann
ty
          Bool
False -> GetTermResult -> Cli GetTermResult
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type Symbol Ann -> GetTermResult
TermHasBadType Type Symbol Ann
ty)
   in Cli (Maybe (TypecheckedUnisonFile Symbol Ann))
Cli.getLatestTypecheckedFile Cli (Maybe (TypecheckedUnisonFile Symbol Ann))
-> (Maybe (TypecheckedUnisonFile Symbol Ann) -> Cli GetTermResult)
-> Cli GetTermResult
forall a b. Cli a -> (a -> Cli b) -> Cli b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe (TypecheckedUnisonFile Symbol Ann)
Nothing -> Cli GetTermResult
getFromCodebase
        Just TypecheckedUnisonFile Symbol Ann
uf -> TypecheckedUnisonFile Symbol Ann -> Cli GetTermResult
getFromFile TypecheckedUnisonFile Symbol Ann
uf

-- | Produce a typechecked unison file where the given term is the
-- only watcher, with the watch type set to 'magicMainWatcherString'.
createWatcherFile :: Symbol -> Term Symbol Ann -> Type Symbol Ann -> Cli (TypecheckedUnisonFile Symbol Ann)
createWatcherFile :: Symbol
-> Term Symbol Ann
-> Type Symbol Ann
-> Cli (TypecheckedUnisonFile Symbol Ann)
createWatcherFile Symbol
v Term Symbol Ann
tm Type Symbol Ann
typ =
  Cli (Maybe (TypecheckedUnisonFile Symbol Ann))
Cli.getLatestTypecheckedFile Cli (Maybe (TypecheckedUnisonFile Symbol Ann))
-> (Maybe (TypecheckedUnisonFile Symbol Ann)
    -> Cli (TypecheckedUnisonFile Symbol Ann))
-> Cli (TypecheckedUnisonFile Symbol Ann)
forall a b. Cli a -> (a -> Cli b) -> Cli b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe (TypecheckedUnisonFile Symbol Ann)
Nothing -> TypecheckedUnisonFile Symbol Ann
-> Cli (TypecheckedUnisonFile Symbol Ann)
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map Symbol (Id, DataDeclaration Symbol Ann)
-> Map Symbol (Id, EffectDeclaration Symbol Ann)
-> [[(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]]
-> [(String, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])]
-> TypecheckedUnisonFile Symbol Ann
forall v a.
Var v =>
Map v (Id, DataDeclaration v a)
-> Map v (Id, EffectDeclaration v a)
-> [[(v, a, Term v a, Type v a)]]
-> [(String, [(v, a, Term v a, Type v a)])]
-> TypecheckedUnisonFile v a
UF.typecheckedUnisonFile Map Symbol (Id, DataDeclaration Symbol Ann)
forall a. Monoid a => a
mempty Map Symbol (Id, EffectDeclaration Symbol Ann)
forall a. Monoid a => a
mempty [[(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]]
forall a. Monoid a => a
mempty [(String
magicMainWatcherString, [(Symbol
v, Ann
External, Term Symbol Ann
tm, Type Symbol Ann
typ)])])
    Just TypecheckedUnisonFile Symbol Ann
uf ->
      let v2 :: Symbol
v2 = Set Symbol -> Symbol -> Symbol
forall v. Var v => Set v -> v -> v
Var.freshIn ([Symbol] -> Set Symbol
forall a. Ord a => [a] -> Set a
Set.fromList [Symbol
v]) Symbol
v
       in TypecheckedUnisonFile Symbol Ann
-> Cli (TypecheckedUnisonFile Symbol Ann)
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypecheckedUnisonFile Symbol Ann
 -> Cli (TypecheckedUnisonFile Symbol Ann))
-> TypecheckedUnisonFile Symbol Ann
-> Cli (TypecheckedUnisonFile Symbol Ann)
forall a b. (a -> b) -> a -> b
$
            Map Symbol (Id, DataDeclaration Symbol Ann)
-> Map Symbol (Id, EffectDeclaration Symbol Ann)
-> [[(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]]
-> [(String, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])]
-> TypecheckedUnisonFile Symbol Ann
forall v a.
Var v =>
Map v (Id, DataDeclaration v a)
-> Map v (Id, EffectDeclaration v a)
-> [[(v, a, Term v a, Type v a)]]
-> [(String, [(v, a, Term v a, Type v a)])]
-> TypecheckedUnisonFile v a
UF.typecheckedUnisonFile
              (TypecheckedUnisonFile Symbol Ann
-> Map Symbol (Id, DataDeclaration Symbol Ann)
forall v a.
TypecheckedUnisonFile v a -> Map v (Id, DataDeclaration v a)
UF.dataDeclarationsId' TypecheckedUnisonFile Symbol Ann
uf)
              (TypecheckedUnisonFile Symbol Ann
-> Map Symbol (Id, EffectDeclaration Symbol Ann)
forall v a.
TypecheckedUnisonFile v a -> Map v (Id, EffectDeclaration v a)
UF.effectDeclarationsId' TypecheckedUnisonFile Symbol Ann
uf)
              (TypecheckedUnisonFile Symbol Ann
-> [[(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]]
forall v a.
TypecheckedUnisonFile v a -> [[(v, a, Term v a, Type v a)]]
UF.topLevelComponents' TypecheckedUnisonFile Symbol Ann
uf)
              -- what about main's component? we have dropped them if they existed.
              [(String
magicMainWatcherString, [(Symbol
v2, Ann
External, Term Symbol Ann
tm, Type Symbol Ann
typ)])]

-- | synthesize the type of forcing a term
--
-- precondition: @fitsScheme typeOfFunc Runtime.mainType@ is satisfied
synthesizeForce :: TypeLookup Symbol Ann -> Type Symbol Ann -> Type Symbol Ann
synthesizeForce :: TypeLookup Symbol Ann -> Type Symbol Ann -> Type Symbol Ann
synthesizeForce TypeLookup Symbol Ann
tl Type Symbol Ann
typeOfFunc = do
  let term :: Term Symbol Ann
      term :: Term Symbol Ann
term = Ann -> TermReference -> Term Symbol Ann
forall v a vt at ap.
Ord v =>
a -> TermReference -> Term2 vt at ap v a
Term.ref Ann
External TermReference
forall {t}. Reference' t Hash
ref
      ref :: Reference' t Hash
ref = Id -> Reference' t Hash
forall h t. Id' h -> Reference' t h
Reference.DerivedId (Hash -> Pos -> Id
forall h. h -> Pos -> Id' h
Reference.Id (ByteString -> Hash
Hash.fromByteString ByteString
"deadbeef") Pos
0)
      env :: Env Symbol Ann
env =
        Typechecker.Env
          { $sel:ambientAbilities:Env :: [Type Symbol Ann]
ambientAbilities = [Ann -> Type Symbol Ann
forall v a. Ord v => a -> Type v a
DD.exceptionType Ann
External, Ann -> Type Symbol Ann
forall v a. Ord v => a -> Type v a
Type.builtinIO Ann
External],
            $sel:typeLookup:Env :: TypeLookup Symbol Ann
typeLookup = TypeLookup Symbol Ann
forall a. Monoid a => a
mempty {TypeLookup.typeOfTerms = Map.singleton ref typeOfFunc} TypeLookup Symbol Ann
-> TypeLookup Symbol Ann -> TypeLookup Symbol Ann
forall a. Semigroup a => a -> a -> a
<> TypeLookup Symbol Ann
tl,
            $sel:termsByShortname:Env :: Map Name [Either Name (NamedReference Symbol Ann)]
termsByShortname = Map Name [Either Name (NamedReference Symbol Ann)]
forall k a. Map k a
Map.empty,
            $sel:freeNameToFuzzyTermsByShortName:Env :: Map Name (Map Name [Either Name (NamedReference Symbol Ann)])
freeNameToFuzzyTermsByShortName = Map Name (Map Name [Either Name (NamedReference Symbol Ann)])
forall k a. Map k a
Map.empty,
            $sel:topLevelComponents:Env :: Map Name (NamedReference Symbol Ann)
topLevelComponents = Map Name (NamedReference Symbol Ann)
forall k a. Map k a
Map.empty,
            $sel:variances:Env :: Map TermReference [Variance]
variances = TypeLookup Symbol Ann -> Map TermReference [Variance]
forall v a.
(Var v, Show a) =>
TypeLookup v a -> Map TermReference [Variance]
Variance.fromTypeLookup TypeLookup Symbol Ann
tl
          }
  case ResultT (Notes Symbol Ann) Identity (Type Symbol Ann)
-> Identity (Maybe (Type Symbol Ann), Notes Symbol Ann)
forall notes (f :: * -> *) a.
ResultT notes f a -> f (Maybe a, notes)
Result.runResultT
    ( PrettyPrintEnv
-> PatternMatchCoverageCheckAndKindInferenceSwitch
-> Env Symbol Ann
-> Term Symbol Ann
-> ResultT (Notes Symbol Ann) Identity (Type Symbol Ann)
forall (f :: * -> *) v loc.
(Monad f, Var v, BuiltinAnnotation loc, Ord loc, Show loc,
 Semigroup loc) =>
PrettyPrintEnv
-> PatternMatchCoverageCheckAndKindInferenceSwitch
-> Env v loc
-> Term v loc
-> ResultT (Notes v loc) f (Type v loc)
Typechecker.synthesize
        PrettyPrintEnv
PPE.empty
        PatternMatchCoverageCheckAndKindInferenceSwitch
Typechecker.PatternMatchCoverageCheckAndKindInferenceSwitch'Enabled
        Env Symbol Ann
env
        (Ann -> Ann -> Term Symbol Ann -> Term Symbol Ann
forall v a. Var v => a -> a -> Term v a -> Term v a
DD.forceTerm Ann
External Ann
External Term Symbol Ann
term)
    ) of
    Identity (Maybe (Type Symbol Ann)
Nothing, Notes Symbol Ann
notes) ->
      String -> Type Symbol Ann
forall a. HasCallStack => String -> a
error
        ( [String] -> String
unlines
            [ String
"synthesizeForce fails although fitsScheme passed",
              String
"Input Type:",
              Type Symbol Ann -> String
forall a. Show a => a -> String
show Type Symbol Ann
typeOfFunc,
              String
"Notes:",
              Notes Symbol Ann -> String
forall a. Show a => a -> String
show Notes Symbol Ann
notes
            ]
        )
    Identity (Just Type Symbol Ann
typ, Notes Symbol Ann
_) -> Type Symbol Ann
typ

-- Hack alert
--
-- After we evaluate a term all vars are transformed into references,
-- but we want to feed this result into 'slurpFile' which won't add
-- dependencies that are referenced by hash. The hacky solution for
-- now is to convert all references that match a variable defined
-- within the unison file to variable references. This is hacky both
-- because we needlessly flip-flopping between var and reference
-- representations, and because we might unexpectedly add a term from
-- the local file if it has the same hash as a term in the codebase.
stripUnisonFileReferences :: TypecheckedUnisonFile Symbol a -> Term Symbol () -> Term Symbol ()
stripUnisonFileReferences :: forall a.
TypecheckedUnisonFile Symbol a -> Term Symbol () -> Term Symbol ()
stripUnisonFileReferences TypecheckedUnisonFile Symbol a
unisonFile Term Symbol ()
term =
  let refMap :: Map Reference.Id Symbol
      refMap :: Map Id Symbol
refMap = [(Id, Symbol)] -> Map Id Symbol
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Id, Symbol)] -> Map Id Symbol)
-> (TypecheckedUnisonFile Symbol a -> [(Id, Symbol)])
-> TypecheckedUnisonFile Symbol a
-> Map Id Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Symbol, (a, Id, Maybe String, Term Symbol a, Type Symbol a))
 -> (Id, Symbol))
-> [(Symbol, (a, Id, Maybe String, Term Symbol a, Type Symbol a))]
-> [(Id, Symbol)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Symbol
sym, (a
_, Id
refId, Maybe String
_, Term Symbol a
_, Type Symbol a
_)) -> (Id
refId, Symbol
sym)) ([(Symbol, (a, Id, Maybe String, Term Symbol a, Type Symbol a))]
 -> [(Id, Symbol)])
-> (TypecheckedUnisonFile Symbol a
    -> [(Symbol, (a, Id, Maybe String, Term Symbol a, Type Symbol a))])
-> TypecheckedUnisonFile Symbol a
-> [(Id, Symbol)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Symbol (a, Id, Maybe String, Term Symbol a, Type Symbol a)
-> [(Symbol, (a, Id, Maybe String, Term Symbol a, Type Symbol a))]
forall k a. Map k a -> [(k, a)]
Map.toList (Map Symbol (a, Id, Maybe String, Term Symbol a, Type Symbol a)
 -> [(Symbol, (a, Id, Maybe String, Term Symbol a, Type Symbol a))])
-> (TypecheckedUnisonFile Symbol a
    -> Map Symbol (a, Id, Maybe String, Term Symbol a, Type Symbol a))
-> TypecheckedUnisonFile Symbol a
-> [(Symbol, (a, Id, Maybe String, Term Symbol a, Type Symbol a))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypecheckedUnisonFile Symbol a
-> Map Symbol (a, Id, Maybe String, Term Symbol a, Type Symbol a)
forall v a.
TypecheckedUnisonFile v a
-> Map v (a, Id, Maybe String, Term v a, Type v a)
UF.hashTermsId (TypecheckedUnisonFile Symbol a -> Map Id Symbol)
-> TypecheckedUnisonFile Symbol a -> Map Id Symbol
forall a b. (a -> b) -> a -> b
$ TypecheckedUnisonFile Symbol a
unisonFile
      alg :: Term'
  (F typeVar typeAnn patternAnn)
  Symbol
  ()
  (Term (F typeVar typeAnn patternAnn) Symbol ())
-> Term (F typeVar typeAnn patternAnn) Symbol ()
alg (ABT.Term' Set Symbol
_ () ABT
  (F typeVar typeAnn patternAnn)
  Symbol
  (Term (F typeVar typeAnn patternAnn) Symbol ())
abt) = case ABT
  (F typeVar typeAnn patternAnn)
  Symbol
  (Term (F typeVar typeAnn patternAnn) Symbol ())
abt of
        ABT.Var Symbol
x -> Symbol -> Term (F typeVar typeAnn patternAnn) Symbol ()
forall v (f :: * -> *). v -> Term f v ()
ABT.var Symbol
x
        ABT.Cycle Term (F typeVar typeAnn patternAnn) Symbol ()
x -> Term (F typeVar typeAnn patternAnn) Symbol ()
-> Term (F typeVar typeAnn patternAnn) Symbol ()
forall (f :: * -> *) v. Term f v () -> Term f v ()
ABT.cycle Term (F typeVar typeAnn patternAnn) Symbol ()
x
        ABT.Abs Symbol
v Term (F typeVar typeAnn patternAnn) Symbol ()
x -> Symbol
-> Term (F typeVar typeAnn patternAnn) Symbol ()
-> Term (F typeVar typeAnn patternAnn) Symbol ()
forall v (f :: * -> *). Ord v => v -> Term f v () -> Term f v ()
ABT.abs Symbol
v Term (F typeVar typeAnn patternAnn) Symbol ()
x
        ABT.Tm F typeVar
  typeAnn
  patternAnn
  (Term (F typeVar typeAnn patternAnn) Symbol ())
t -> case F typeVar
  typeAnn
  patternAnn
  (Term (F typeVar typeAnn patternAnn) Symbol ())
t of
          Term.Ref TermReference
ref
            | Just Symbol
var <- (\Id
k -> Id -> Map Id Symbol -> Maybe Symbol
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Id
k Map Id Symbol
refMap) (Id -> Maybe Symbol) -> Maybe Id -> Maybe Symbol
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TermReference -> Maybe Id
Reference.toId TermReference
ref -> Symbol -> Term (F typeVar typeAnn patternAnn) Symbol ()
forall v (f :: * -> *). v -> Term f v ()
ABT.var Symbol
var
          F typeVar
  typeAnn
  patternAnn
  (Term (F typeVar typeAnn patternAnn) Symbol ())
x -> F typeVar
  typeAnn
  patternAnn
  (Term (F typeVar typeAnn patternAnn) Symbol ())
-> Term (F typeVar typeAnn patternAnn) Symbol ()
forall (f :: * -> *) v.
(Foldable f, Ord v) =>
f (Term f v ()) -> Term f v ()
ABT.tm F typeVar
  typeAnn
  patternAnn
  (Term (F typeVar typeAnn patternAnn) Symbol ())
x
   in Algebra (Term' (F Symbol () ()) Symbol ()) (Term Symbol ())
-> Term Symbol () -> Term Symbol ()
forall a.
Algebra (Term' (F Symbol () ()) Symbol ()) a -> Term Symbol () -> a
forall t (f :: * -> *) a. Recursive t f => Algebra f a -> t -> a
cata Algebra (Term' (F Symbol () ()) Symbol ()) (Term Symbol ())
forall {typeVar} {typeAnn} {patternAnn}.
Term'
  (F typeVar typeAnn patternAnn)
  Symbol
  ()
  (Term (F typeVar typeAnn patternAnn) Symbol ())
-> Term (F typeVar typeAnn patternAnn) Symbol ()
alg Term Symbol ()
term

magicMainWatcherString :: String
magicMainWatcherString :: String
magicMainWatcherString = String
"main"

checkStale :: HQ.HashQualified Name -> Maybe TermReference -> Cli ()
checkStale :: HashQualified Name -> Maybe TermReference -> Cli ()
checkStale HashQualified Name
hqMain Maybe TermReference
maybeCodebaseRef = do
  Maybe Name -> (Name -> Cli ()) -> Cli ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust (HashQualified Name -> Maybe Name
forall n. HashQualified n -> Maybe n
HQ.asNameOnly HashQualified Name
hqMain) \Name
main -> do
    Cli (Maybe (TypecheckedUnisonFile Symbol Ann))
-> (TypecheckedUnisonFile Symbol Ann -> Cli ()) -> Cli ()
forall (m :: * -> *) a.
Monad m =>
m (Maybe a) -> (a -> m ()) -> m ()
whenJustM Cli (Maybe (TypecheckedUnisonFile Symbol Ann))
Cli.getLatestTypecheckedFile \TypecheckedUnisonFile Symbol Ann
unisonFile -> do
      Branch0 IO
namespace <- Cli (Branch0 IO)
Cli.getCurrentBranch0

      let beingUpdated :: DefnsF Set TermReference TypeReference
          beingUpdated :: DefnsF Set TermReference TermReference
beingUpdated =
            DefnsF2 (Map Name) Set Referent TermReference
-> DefnsF (Map Name) Id Id
-> DefnsF Set TermReference TermReference
keepBeingUpdated
              ((Relation Referent Name -> Map Name (Set Referent))
-> (Relation TermReference Name -> Map Name (Set TermReference))
-> Defns (Relation Referent Name) (Relation TermReference Name)
-> DefnsF2 (Map Name) Set Referent TermReference
forall a b c d. (a -> b) -> (c -> d) -> Defns a c -> Defns b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Relation Referent Name -> Map Name (Set Referent)
forall a b. Relation a b -> Map b (Set a)
Relation.range Relation TermReference Name -> Map Name (Set TermReference)
forall a b. Relation a b -> Map b (Set a)
Relation.range (Branch0 IO
-> Defns (Relation Referent Name) (Relation TermReference Name)
forall (m :: * -> *).
Branch0 m
-> Defns (Relation Referent Name) (Relation TermReference Name)
Branch.deepDefns Branch0 IO
namespace))
              (TypecheckedUnisonFile Symbol Ann -> DefnsF (Map Name) Id Id
forall a v.
Var v =>
TypecheckedUnisonFile v a -> DefnsF (Map Name) Id Id
UF.toDefnsIdsByName TypecheckedUnisonFile Symbol Ann
unisonFile)

      Bool -> Cli () -> Cli ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (DefnsF Set TermReference TermReference -> Bool
forall (f :: * -> *) (g :: * -> *) a b.
(Foldable f, Foldable g) =>
Defns (f a) (g b) -> Bool
defnsAreEmpty DefnsF Set TermReference TermReference
beingUpdated)) do
        [DependencyEdge]
edges :: [Operations.DependencyEdge] <-
          Transaction [DependencyEdge] -> Cli [DependencyEdge]
forall a. Transaction a -> Cli a
Cli.runTransaction (Transaction [DependencyEdge] -> Cli [DependencyEdge])
-> Transaction [DependencyEdge] -> Cli [DependencyEdge]
forall a b. (a -> b) -> a -> b
$
            (TermReference -> Bool)
-> DefnsF Set Id Id
-> DefnsF Set TermReference TermReference
-> Transaction [DependencyEdge]
Operations.transitiveDependentsGraphWithinScope
              TermReference -> Bool
Builtin.isBuiltinType
              (Branch0 IO -> DefnsF Set Id Id
forall (m :: * -> *). Branch0 m -> DefnsF Set Id Id
Branch.deepDefnsIds (Branch0 IO -> Branch0 IO
forall (m :: * -> *). Branch0 m -> Branch0 m
Branch.deleteLibdeps Branch0 IO
namespace))
              DefnsF Set TermReference TermReference
beingUpdated

        let graph :: Graph.AdjacencyMap (Defn TermReference TypeReference)
            graph :: AdjacencyMap (Defn TermReference TermReference)
graph =
              (AdjacencyMap (Defn TermReference TermReference)
 -> DependencyEdge
 -> AdjacencyMap (Defn TermReference TermReference))
-> AdjacencyMap (Defn TermReference TermReference)
-> [DependencyEdge]
-> AdjacencyMap (Defn TermReference TermReference)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl
                ( \AdjacencyMap (Defn TermReference TermReference)
acc DependencyEdge
edge ->
                    AdjacencyMap (Defn TermReference TermReference)
-> AdjacencyMap (Defn TermReference TermReference)
-> AdjacencyMap (Defn TermReference TermReference)
forall a.
Ord a =>
AdjacencyMap a -> AdjacencyMap a -> AdjacencyMap a
Graph.overlay AdjacencyMap (Defn TermReference TermReference)
acc case DependencyEdge
edge of
                      Operations.TermDependsOnTerm Id
dependent TermReference
dependency ->
                        Defn TermReference TermReference
-> Defn TermReference TermReference
-> AdjacencyMap (Defn TermReference TermReference)
forall a. Ord a => a -> a -> AdjacencyMap a
Graph.edge (TermReference -> Defn TermReference TermReference
forall term typ. term -> Defn term typ
TermDefn (Id -> TermReference
Reference.fromId Id
dependent)) (TermReference -> Defn TermReference TermReference
forall term typ. term -> Defn term typ
TermDefn TermReference
dependency)
                      Operations.TermDependsOnType Id
dependent TermReference
dependency ->
                        Defn TermReference TermReference
-> Defn TermReference TermReference
-> AdjacencyMap (Defn TermReference TermReference)
forall a. Ord a => a -> a -> AdjacencyMap a
Graph.edge (TermReference -> Defn TermReference TermReference
forall term typ. term -> Defn term typ
TermDefn (Id -> TermReference
Reference.fromId Id
dependent)) (TermReference -> Defn TermReference TermReference
forall term typ. typ -> Defn term typ
TypeDefn TermReference
dependency)
                      Operations.TypeDependsOnType Id
dependent TermReference
dependency ->
                        Defn TermReference TermReference
-> Defn TermReference TermReference
-> AdjacencyMap (Defn TermReference TermReference)
forall a. Ord a => a -> a -> AdjacencyMap a
Graph.edge (TermReference -> Defn TermReference TermReference
forall term typ. typ -> Defn term typ
TypeDefn (Id -> TermReference
Reference.fromId Id
dependent)) (TermReference -> Defn TermReference TermReference
forall term typ. typ -> Defn term typ
TypeDefn TermReference
dependency)
                )
                AdjacencyMap (Defn TermReference TermReference)
forall a. AdjacencyMap a
Graph.empty
                [DependencyEdge]
edges

        let dependencies :: DefnsF Set TermReference TypeReference
            dependencies :: DefnsF Set TermReference TermReference
dependencies =
              case Maybe TermReference
maybeCodebaseRef of
                Maybe TermReference
Nothing ->
                  let (Ann
_, Id
_, Maybe String
_, Term Symbol Ann
term, Type Symbol Ann
_) = Symbol
-> Map
     Symbol (Ann, Id, Maybe String, Term Symbol Ann, Type Symbol Ann)
-> (Ann, Id, Maybe String, Term Symbol Ann, Type Symbol Ann)
forall k v. (Ord k, Show k) => k -> Map k v -> v
Map.lookupJust (Name -> Symbol
forall v. Var v => Name -> v
Name.toVar Name
main) (TypecheckedUnisonFile Symbol Ann
-> Map
     Symbol (Ann, Id, Maybe String, Term Symbol Ann, Type Symbol Ann)
forall v a.
TypecheckedUnisonFile v a
-> Map v (a, Id, Maybe String, Term v a, Type v a)
UF.hashTermsId TypecheckedUnisonFile Symbol Ann
unisonFile)
                   in Term Symbol Ann -> DefnsF Set TermReference TermReference
forall v vt at ap a.
(Ord v, Ord vt) =>
Term2 vt at ap v a -> DefnsF Set TermReference TermReference
Term.dependencies Term Symbol Ann
term
                Just TermReference
codebaseRef -> Set TermReference -> DefnsF Set TermReference TermReference
forall types terms. Monoid types => terms -> Defns terms types
Defns.fromTerms (TermReference -> Set TermReference
forall a. a -> Set a
Set.singleton TermReference
codebaseRef)

        Either [Defn TermReference TermReference] ()
-> ([Defn TermReference TermReference] -> Cli ()) -> Cli ()
forall (m :: * -> *) a b.
Applicative m =>
Either a b -> (a -> m b) -> m b
whenLeft
          ( Map
  (Defn TermReference TermReference)
  (Set (Defn TermReference TermReference))
-> Set (Defn TermReference TermReference)
-> Set (Defn TermReference TermReference)
-> Either [Defn TermReference TermReference] ()
searchDependencyToBeingUpdated
              (AdjacencyMap (Defn TermReference TermReference)
-> Map
     (Defn TermReference TermReference)
     (Set (Defn TermReference TermReference))
forall a. AdjacencyMap a -> Map a (Set a)
Graph.adjacencyMap AdjacencyMap (Defn TermReference TermReference)
graph)
              (DefnsF Set TermReference TermReference
-> Set (Defn TermReference TermReference)
forall term typ.
(Ord term, Ord typ) =>
DefnsF Set term typ -> Set (Defn term typ)
taggedDefns DefnsF Set TermReference TermReference
beingUpdated)
              (DefnsF Set TermReference TermReference
-> Set (Defn TermReference TermReference)
forall term typ.
(Ord term, Ord typ) =>
DefnsF Set term typ -> Set (Defn term typ)
taggedDefns DefnsF Set TermReference TermReference
dependencies)
          )
          \[Defn TermReference TermReference]
path -> do
            let ppe :: PrettyPrintEnv
ppe =
                  (Int -> Branch0 IO -> PrettyPrintEnvDecl
forall (m :: * -> *). Int -> Branch0 m -> PrettyPrintEnvDecl
Branch.toPrettyPrintEnvDecl Int
10 Branch0 IO
namespace).suffixifiedPPE

            Output -> Cli ()
forall a. Output -> Cli a
Cli.returnEarly (PrettyPrintEnv
-> Name -> [Defn TermReference TermReference] -> Bool -> Output
Output.StaleRun PrettyPrintEnv
ppe Name
main [Defn TermReference TermReference]
path (Maybe TermReference -> Bool
forall a. Maybe a -> Bool
isNothing Maybe TermReference
maybeCodebaseRef))

keepBeingUpdated ::
  DefnsF2 (Map Name) Set Referent TypeReference ->
  DefnsF (Map Name) TermReferenceId TypeReferenceId ->
  DefnsF Set TermReference TypeReference
keepBeingUpdated :: DefnsF2 (Map Name) Set Referent TermReference
-> DefnsF (Map Name) Id Id
-> DefnsF Set TermReference TermReference
keepBeingUpdated =
  (Map Name (Set Referent) -> Map Name Id -> Set TermReference)
-> (Map Name (Set TermReference)
    -> Map Name Id -> Set TermReference)
-> DefnsF2 (Map Name) Set Referent TermReference
-> DefnsF (Map Name) Id Id
-> DefnsF Set TermReference TermReference
forall tm1 tm2 tm3 ty1 ty2 ty3.
(tm1 -> tm2 -> tm3)
-> (ty1 -> ty2 -> ty3)
-> Defns tm1 ty1
-> Defns tm2 ty2
-> Defns tm3 ty3
zipDefnsWith ((Set Referent -> Set TermReference)
-> Map Name (Set Referent) -> Map Name Id -> Set TermReference
forall ref.
Eq ref =>
(Set ref -> Set TermReference)
-> Map Name (Set ref) -> Map Name Id -> Set TermReference
f ((Referent -> Maybe TermReference)
-> Set Referent -> Set TermReference
forall b a. Ord b => (a -> Maybe b) -> Set a -> Set b
Set.mapMaybe Referent -> Maybe TermReference
forall r. Referent' r -> Maybe r
Referent.toTermReference)) ((Set TermReference -> Set TermReference)
-> Map Name (Set TermReference) -> Map Name Id -> Set TermReference
forall ref.
Eq ref =>
(Set ref -> Set TermReference)
-> Map Name (Set ref) -> Map Name Id -> Set TermReference
f Set TermReference -> Set TermReference
forall a. a -> a
id)
  where
    f ::
      (Eq ref) =>
      (Set ref -> Set Reference) ->
      Map Name (Set ref) ->
      Map Name Reference.Id ->
      Set Reference
    f :: forall ref.
Eq ref =>
(Set ref -> Set TermReference)
-> Map Name (Set ref) -> Map Name Id -> Set TermReference
f Set ref -> Set TermReference
g Map Name (Set ref)
namespace Map Name Id
file =
      Const (Set TermReference) (Map Name Any) -> Set TermReference
forall {k} a (b :: k). Const a b -> a
getConst (Const (Set TermReference) (Map Name Any) -> Set TermReference)
-> Const (Set TermReference) (Map Name Any) -> Set TermReference
forall a b. (a -> b) -> a -> b
$
        WhenMissing (Const (Set TermReference)) Name (Set ref) Any
-> WhenMissing (Const (Set TermReference)) Name Id Any
-> WhenMatched (Const (Set TermReference)) Name (Set ref) Id Any
-> Map Name (Set ref)
-> Map Name Id
-> Const (Set TermReference) (Map Name Any)
forall (f :: * -> *) k a c b.
(Applicative f, Ord k) =>
WhenMissing f k a c
-> WhenMissing f k b c
-> WhenMatched f k a b c
-> Map k a
-> Map k b
-> f (Map k c)
Map.mergeA
          WhenMissing (Const (Set TermReference)) Name (Set ref) Any
forall (f :: * -> *) k x y. Applicative f => WhenMissing f k x y
Map.dropMissing
          WhenMissing (Const (Set TermReference)) Name Id Any
forall (f :: * -> *) k x y. Applicative f => WhenMissing f k x y
Map.dropMissing
          ( (Name -> Set ref -> Id -> Const (Set TermReference) Any)
-> WhenMatched (Const (Set TermReference)) Name (Set ref) Id Any
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> f z) -> WhenMatched f k x y z
Map.zipWithAMatched \Name
_ Set ref
codebaseRefs Id
fileRefId ->
              Set TermReference -> Const (Set TermReference) Any
forall {k} a (b :: k). a -> Const a b
Const (TermReference -> Set TermReference -> Set TermReference
forall a. Ord a => a -> Set a -> Set a
Set.delete (Id -> TermReference
Reference.fromId Id
fileRefId) (Set ref -> Set TermReference
g Set ref
codebaseRefs))
          )
          Map Name (Set ref)
namespace
          Map Name Id
file

searchDependencyToBeingUpdated ::
  Map (Defn TermReference TypeReference) (Set (Defn TermReference TypeReference)) ->
  Set (Defn TermReference TypeReference) ->
  Set (Defn TermReference TypeReference) ->
  Either [Defn TermReference TypeReference] ()
searchDependencyToBeingUpdated :: Map
  (Defn TermReference TermReference)
  (Set (Defn TermReference TermReference))
-> Set (Defn TermReference TermReference)
-> Set (Defn TermReference TermReference)
-> Either [Defn TermReference TermReference] ()
searchDependencyToBeingUpdated Map
  (Defn TermReference TermReference)
  (Set (Defn TermReference TermReference))
adjacency Set (Defn TermReference TermReference)
beingUpdated Set (Defn TermReference TermReference)
dependencies =
  case Set (Defn TermReference TermReference)
-> Maybe (Defn TermReference TermReference)
forall a. Set a -> Maybe a
randomSetElem (Set (Defn TermReference TermReference)
-> Set (Defn TermReference TermReference)
-> Set (Defn TermReference TermReference)
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection Set (Defn TermReference TermReference)
dependencies Set (Defn TermReference TermReference)
beingUpdated) of
    Just Defn TermReference TermReference
ref -> [Defn TermReference TermReference]
-> Either [Defn TermReference TermReference] ()
forall a b. a -> Either a b
Left [Defn TermReference TermReference
ref]
    Maybe (Defn TermReference TermReference)
Nothing ->
      Except [Defn TermReference TermReference] ()
-> Either [Defn TermReference TermReference] ()
forall e a. Except e a -> Either e a
Except.runExcept (Except [Defn TermReference TermReference] ()
 -> Either [Defn TermReference TermReference] ())
-> Except [Defn TermReference TermReference] ()
-> Either [Defn TermReference TermReference] ()
forall a b. (a -> b) -> a -> b
$
        StateT
  (Set (Defn TermReference TermReference))
  (Except [Defn TermReference TermReference])
  ()
-> Set (Defn TermReference TermReference)
-> Except [Defn TermReference TermReference] ()
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
State.evalStateT
          (Map
  (Defn TermReference TermReference)
  (Set (Defn TermReference TermReference))
-> Set (Defn TermReference TermReference)
-> [Defn TermReference TermReference]
-> [Defn TermReference TermReference]
-> StateT
     (Set (Defn TermReference TermReference))
     (Except [Defn TermReference TermReference])
     ()
searchDependencyToBeingUpdated1 Map
  (Defn TermReference TermReference)
  (Set (Defn TermReference TermReference))
adjacency Set (Defn TermReference TermReference)
beingUpdated [] (Set (Defn TermReference TermReference)
-> [Defn TermReference TermReference]
forall a. Set a -> [a]
Set.toList Set (Defn TermReference TermReference)
dependencies))
          Set (Defn TermReference TermReference)
forall a. Set a
Set.empty

searchDependencyToBeingUpdated1 ::
  Map (Defn TermReference TypeReference) (Set (Defn TermReference TypeReference)) ->
  Set (Defn TermReference TypeReference) ->
  [Defn TermReference TypeReference] ->
  [Defn TermReference TypeReference] ->
  StateT (Set (Defn TermReference TypeReference)) (Except [Defn TermReference TypeReference]) ()
searchDependencyToBeingUpdated1 :: Map
  (Defn TermReference TermReference)
  (Set (Defn TermReference TermReference))
-> Set (Defn TermReference TermReference)
-> [Defn TermReference TermReference]
-> [Defn TermReference TermReference]
-> StateT
     (Set (Defn TermReference TermReference))
     (Except [Defn TermReference TermReference])
     ()
searchDependencyToBeingUpdated1 Map
  (Defn TermReference TermReference)
  (Set (Defn TermReference TermReference))
adjacency Set (Defn TermReference TermReference)
beingUpdated =
  [Defn TermReference TermReference]
-> [Defn TermReference TermReference]
-> StateT
     (Set (Defn TermReference TermReference))
     (Except [Defn TermReference TermReference])
     ()
search
  where
    search ::
      [Defn TermReference TypeReference] ->
      [Defn TermReference TypeReference] ->
      StateT (Set (Defn TermReference TypeReference)) (Except [Defn TermReference TypeReference]) ()
    search :: [Defn TermReference TermReference]
-> [Defn TermReference TermReference]
-> StateT
     (Set (Defn TermReference TermReference))
     (Except [Defn TermReference TermReference])
     ()
search [Defn TermReference TermReference]
path = \case
      [] -> ()
-> StateT
     (Set (Defn TermReference TermReference))
     (Except [Defn TermReference TermReference])
     ()
forall a.
a
-> StateT
     (Set (Defn TermReference TermReference))
     (Except [Defn TermReference TermReference])
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Defn TermReference TermReference
node : [Defn TermReference TermReference]
nodes -> do
        Set (Defn TermReference TermReference)
seen <- StateT
  (Set (Defn TermReference TermReference))
  (Except [Defn TermReference TermReference])
  (Set (Defn TermReference TermReference))
forall s (m :: * -> *). MonadState s m => m s
State.get
        if Defn TermReference TermReference
-> Set (Defn TermReference TermReference) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Defn TermReference TermReference
node Set (Defn TermReference TermReference)
seen
          then [Defn TermReference TermReference]
-> [Defn TermReference TermReference]
-> StateT
     (Set (Defn TermReference TermReference))
     (Except [Defn TermReference TermReference])
     ()
search [Defn TermReference TermReference]
path [Defn TermReference TermReference]
nodes
          else do
            let adjacent :: Set (Defn TermReference TermReference)
adjacent = Set (Defn TermReference TermReference)
-> Set (Defn TermReference TermReference)
-> Set (Defn TermReference TermReference)
forall a. Ord a => Set a -> Set a -> Set a
Set.difference (Set (Defn TermReference TermReference)
-> Defn TermReference TermReference
-> Map
     (Defn TermReference TermReference)
     (Set (Defn TermReference TermReference))
-> Set (Defn TermReference TermReference)
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Set (Defn TermReference TermReference)
forall a. Set a
Set.empty Defn TermReference TermReference
node Map
  (Defn TermReference TermReference)
  (Set (Defn TermReference TermReference))
adjacency) Set (Defn TermReference TermReference)
seen
            case Set (Defn TermReference TermReference)
-> Maybe (Defn TermReference TermReference)
forall a. Set a -> Maybe a
randomSetElem (Set (Defn TermReference TermReference)
-> Set (Defn TermReference TermReference)
-> Set (Defn TermReference TermReference)
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection Set (Defn TermReference TermReference)
adjacent Set (Defn TermReference TermReference)
beingUpdated) of
              Just Defn TermReference TermReference
ref -> [Defn TermReference TermReference]
-> StateT
     (Set (Defn TermReference TermReference))
     (Except [Defn TermReference TermReference])
     ()
forall a.
[Defn TermReference TermReference]
-> StateT
     (Set (Defn TermReference TermReference))
     (Except [Defn TermReference TermReference])
     a
forall e (m :: * -> *) a. MonadError e m => e -> m a
Except.throwError (Defn TermReference TermReference
ref Defn TermReference TermReference
-> [Defn TermReference TermReference]
-> [Defn TermReference TermReference]
forall a. a -> [a] -> [a]
: Defn TermReference TermReference
node Defn TermReference TermReference
-> [Defn TermReference TermReference]
-> [Defn TermReference TermReference]
forall a. a -> [a] -> [a]
: [Defn TermReference TermReference]
path)
              Maybe (Defn TermReference TermReference)
Nothing -> do
                Set (Defn TermReference TermReference)
-> StateT
     (Set (Defn TermReference TermReference))
     (Except [Defn TermReference TermReference])
     ()
forall s (m :: * -> *). MonadState s m => s -> m ()
State.put (Set (Defn TermReference TermReference)
 -> StateT
      (Set (Defn TermReference TermReference))
      (Except [Defn TermReference TermReference])
      ())
-> Set (Defn TermReference TermReference)
-> StateT
     (Set (Defn TermReference TermReference))
     (Except [Defn TermReference TermReference])
     ()
forall a b. (a -> b) -> a -> b
$! Defn TermReference TermReference
-> Set (Defn TermReference TermReference)
-> Set (Defn TermReference TermReference)
forall a. Ord a => a -> Set a -> Set a
Set.insert Defn TermReference TermReference
node Set (Defn TermReference TermReference)
seen
                [Defn TermReference TermReference]
-> [Defn TermReference TermReference]
-> StateT
     (Set (Defn TermReference TermReference))
     (Except [Defn TermReference TermReference])
     ()
search (Defn TermReference TermReference
node Defn TermReference TermReference
-> [Defn TermReference TermReference]
-> [Defn TermReference TermReference]
forall a. a -> [a] -> [a]
: [Defn TermReference TermReference]
path) (Set (Defn TermReference TermReference)
-> [Defn TermReference TermReference]
forall a. Set a -> [a]
Set.toList Set (Defn TermReference TermReference)
adjacent)
                [Defn TermReference TermReference]
-> [Defn TermReference TermReference]
-> StateT
     (Set (Defn TermReference TermReference))
     (Except [Defn TermReference TermReference])
     ()
search [Defn TermReference TermReference]
path [Defn TermReference TermReference]
nodes

taggedDefns :: (Ord term, Ord typ) => DefnsF Set term typ -> Set (Defn term typ)
taggedDefns :: forall term typ.
(Ord term, Ord typ) =>
DefnsF Set term typ -> Set (Defn term typ)
taggedDefns DefnsF Set term typ
defns =
  Set (Defn term typ) -> Set (Defn term typ) -> Set (Defn term typ)
forall a. Ord a => Set a -> Set a -> Set a
Set.union ((term -> Defn term typ) -> Set term -> Set (Defn term typ)
forall a b. (a -> b) -> Set a -> Set b
Set.mapMonotonic term -> Defn term typ
forall term typ. term -> Defn term typ
TermDefn DefnsF Set term typ
defns.terms) ((typ -> Defn term typ) -> Set typ -> Set (Defn term typ)
forall a b. (a -> b) -> Set a -> Set b
Set.mapMonotonic typ -> Defn term typ
forall term typ. typ -> Defn term typ
TypeDefn DefnsF Set term typ
defns.types)

randomSetElem :: Set a -> Maybe a
randomSetElem :: forall a. Set a -> Maybe a
randomSetElem = \case
  Set.Internal.Bin Int
_ a
x Set a
_ Set a
_ -> a -> Maybe a
forall a. a -> Maybe a
Just a
x
  Set a
Set.Internal.Tip -> Maybe a
forall a. Maybe a
Nothing