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.List.NonEmpty qualified as List (NonEmpty)
import Data.List.NonEmpty qualified as List.NonEmpty
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.HandleInput.TermResolution (resolveMainRef)
import Unison.Codebase.Editor.Output qualified as Output
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
  (unisonFile, mainResType, codebaseRef) <- do
    (sym, term, typ, otyp, codebaseRef) <- HashQualified Name
-> Cli
     (Symbol, Term Symbol Ann, Type Symbol Ann, Type Symbol Ann,
      Maybe TermReference)
getTerm HashQualified Name
main
    uf <- createWatcherFile sym term typ
    pure (uf, otyp, codebaseRef)

  checkStale main codebaseRef

  names <- Cli.currentNames
  let 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 = Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
10 Names
namesWithFileDefinitions) (Names -> Suffixifier
PPE.suffixifyByHash Names
namesWithFileDefinitions)
  let ppe = PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.suffixifiedPPE PrettyPrintEnvDecl
pped
  let mode = ProfileSpec -> EvalMode
Permissive ProfileSpec
prof

  (_, xs) <-
    evalUnisonFile mode ppe unisonFile args & 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)

  mainRes :: Term Symbol () <-
    case lookup magicMainWatcherString (map bonk (Map.toList 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)
  Cli.respond (Output.RunResult ppe 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)

-- | 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
mainName =
  let getFromCodebase :: Cli
  (Symbol, Term Symbol Ann, Type Symbol Ann, Type Symbol Ann,
   Maybe TermReference)
getFromCodebase = do
        (hq, ref, tm, typ) <- Text
-> HashQualified Name
-> Cli
     (HashQualified Name, TermReference, Term Symbol Ann,
      Type Symbol Ann)
resolveMainRef Text
"run" HashQualified Name
mainName
        let v = Text -> Symbol
forall v. Var v => Text -> v
Var.named (HashQualified Name -> Text
HQ.toText HashQualified Name
hq)
        otyp <- doSynthesizeForce Nothing typ
        pure (v, tm, typ, otyp, Just ref)

      getFromFile :: TypecheckedUnisonFile Symbol Ann
-> Cli
     (Symbol, Term Symbol Ann, Type Symbol Ann, Type Symbol Ann,
      Maybe TermReference)
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)] -> do
            env <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
            let mainType = Runtime Error DecompError Symbol -> Type Symbol Ann
forall e e' v. Runtime e e' v -> Type v Ann
Runtime.mainType Env
env.runtime
            when (not (Typechecker.fitsScheme ty (Runtime.mainType env.runtime))) do
              names <- Cli.currentNames
              let pped = Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
10 Names
names) (Names -> Suffixifier
PPE.suffixifyByHash Names
names)
              let ppe = PrettyPrintEnvDecl
pped.suffixifiedPPE
              Cli.returnEarly $
                Output.BadMainFunction
                  "run"
                  [(mainName, ty)]
                  ppe
                  [mainType]
            otyp <- doSynthesizeForce (Just uf) ty
            let 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 = 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 = Term Symbol Ann -> Ann
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term Symbol Ann
tm
            pure (v2, runMain, ty, otyp, Nothing)
          [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]
_ -> Cli
  (Symbol, Term Symbol Ann, Type Symbol Ann, Type Symbol Ann,
   Maybe TermReference)
getFromCodebase

      doSynthesizeForce :: Maybe (TypecheckedUnisonFile Symbol Ann) -> Type Symbol Ann -> Cli (Type Symbol Ann)
      doSynthesizeForce :: Maybe (TypecheckedUnisonFile Symbol Ann)
-> Type Symbol Ann -> Cli (Type Symbol Ann)
doSynthesizeForce Maybe (TypecheckedUnisonFile Symbol Ann)
mayTuf Type Symbol Ann
ty = do
        env <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
        let 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
        tlCodebase <-
          Cli.runTransaction $
            Codebase.typeLookupForDependencies env.codebase Defns {terms = Set.empty, types = Type.dependencies ty <> ufDeps}
        let 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)
        pure (synthesizeForce (tlTuf <> tlCodebase) ty)
   in Cli (Maybe (TypecheckedUnisonFile Symbol Ann))
Cli.getLatestTypecheckedFile Cli (Maybe (TypecheckedUnisonFile Symbol Ann))
-> (Maybe (TypecheckedUnisonFile Symbol Ann)
    -> 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
        Maybe (TypecheckedUnisonFile Symbol Ann)
Nothing -> Cli
  (Symbol, Term Symbol Ann, Type Symbol Ann, Type Symbol Ann,
   Maybe TermReference)
getFromCodebase
        Just TypecheckedUnisonFile Symbol Ann
uf -> TypecheckedUnisonFile Symbol Ann
-> Cli
     (Symbol, Term Symbol Ann, Type Symbol Ann, Type Symbol Ann,
      Maybe TermReference)
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, HasCallStack) =>
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, HasCallStack) =>
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
          { ambientAbilities :: [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],
            typeLookup :: 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,
            termsByShortname :: Map Name [Either Name (NamedReference Symbol Ann)]
termsByShortname = Map Name [Either Name (NamedReference Symbol Ann)]
forall k a. Map k a
Map.empty,
            freeNameToFuzzyTermsByShortName :: 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,
            topLevelComponents :: Map Name (NamedReference Symbol Ann)
topLevelComponents = Map Name (NamedReference Symbol Ann)
forall k a. Map k a
Map.empty,
            variances :: 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
      namespace <- Cli (Branch0 IO)
Cli.getCurrentBranch0

      -- Whittle down the namespace to just the definitions that are "shadowed" by a different hash with the same name,
      -- defined in the latest typechecked Unison file. These are the "being updated" things.
      let beingUpdated :: DefnsF Set TermReference TypeReference
          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)

      when (not (defnsAreEmpty beingUpdated)) do
        edges :: [Operations.DependencyEdge] <-
          Cli.runTransaction $
            Operations.transitiveDependentsGraphWithinScope
              Builtin.isBuiltinType
              (Branch.deepDefnsIds (Branch.deleteLibdeps namespace))
              beingUpdated

        let graph :: Graph.AdjacencyMap (Defn TermReference TypeReference)
            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 =
              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)

        whenLeft
          ( searchDependencyToBeingUpdated
              (Graph.adjacencyMap graph)
              (taggedDefns beingUpdated)
              (taggedDefns dependencies)
          )
          \NonEmpty (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
-> NonEmpty (Defn TermReference TermReference)
-> Bool
-> Output
Output.StaleRun PrettyPrintEnv
ppe Name
main NonEmpty (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 (ZonkAny 0))
-> Set TermReference
forall {k} a (b :: k). Const a b -> a
getConst (Const (Set TermReference) (Map Name (ZonkAny 0))
 -> Set TermReference)
-> Const (Set TermReference) (Map Name (ZonkAny 0))
-> Set TermReference
forall a b. (a -> b) -> a -> b
$
        WhenMissing (Const (Set TermReference)) Name (Set ref) (ZonkAny 0)
-> WhenMissing (Const (Set TermReference)) Name Id (ZonkAny 0)
-> WhenMatched
     (Const (Set TermReference)) Name (Set ref) Id (ZonkAny 0)
-> Map Name (Set ref)
-> Map Name Id
-> Const (Set TermReference) (Map Name (ZonkAny 0))
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) (ZonkAny 0)
forall (f :: * -> *) k x y. Applicative f => WhenMissing f k x y
Map.dropMissing
          WhenMissing (Const (Set TermReference)) Name Id (ZonkAny 0)
forall (f :: * -> *) k x y. Applicative f => WhenMissing f k x y
Map.dropMissing
          ( (Name -> Set ref -> Id -> Const (Set TermReference) (ZonkAny 0))
-> WhenMatched
     (Const (Set TermReference)) Name (Set ref) Id (ZonkAny 0)
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) (ZonkAny 0)
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 (List.NonEmpty (Defn TermReference TypeReference)) ()
searchDependencyToBeingUpdated :: Map
  (Defn TermReference TermReference)
  (Set (Defn TermReference TermReference))
-> Set (Defn TermReference TermReference)
-> Set (Defn TermReference TermReference)
-> Either (NonEmpty (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 -> NonEmpty (Defn TermReference TermReference)
-> Either (NonEmpty (Defn TermReference TermReference)) ()
forall a b. a -> Either a b
Left (Defn TermReference TermReference
-> NonEmpty (Defn TermReference TermReference)
forall a. a -> NonEmpty a
List.NonEmpty.singleton Defn TermReference TermReference
ref)
    Maybe (Defn TermReference TermReference)
Nothing ->
      Except (NonEmpty (Defn TermReference TermReference)) ()
-> Either (NonEmpty (Defn TermReference TermReference)) ()
forall e a. Except e a -> Either e a
Except.runExcept (Except (NonEmpty (Defn TermReference TermReference)) ()
 -> Either (NonEmpty (Defn TermReference TermReference)) ())
-> Except (NonEmpty (Defn TermReference TermReference)) ()
-> Either (NonEmpty (Defn TermReference TermReference)) ()
forall a b. (a -> b) -> a -> b
$
        StateT
  (Set (Defn TermReference TermReference))
  (Except (NonEmpty (Defn TermReference TermReference)))
  ()
-> Set (Defn TermReference TermReference)
-> Except (NonEmpty (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 (NonEmpty (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 (List.NonEmpty (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 (NonEmpty (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 (NonEmpty (Defn TermReference TermReference)))
     ()
search
  where
    search ::
      [Defn TermReference TypeReference] ->
      [Defn TermReference TypeReference] ->
      StateT (Set (Defn TermReference TypeReference)) (Except (List.NonEmpty (Defn TermReference TypeReference))) ()
    search :: [Defn TermReference TermReference]
-> [Defn TermReference TermReference]
-> StateT
     (Set (Defn TermReference TermReference))
     (Except (NonEmpty (Defn TermReference TermReference)))
     ()
search [Defn TermReference TermReference]
path = \case
      [] -> ()
-> StateT
     (Set (Defn TermReference TermReference))
     (Except (NonEmpty (Defn TermReference TermReference)))
     ()
forall a.
a
-> StateT
     (Set (Defn TermReference TermReference))
     (Except (NonEmpty (Defn TermReference TermReference)))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Defn TermReference TermReference
node : [Defn TermReference TermReference]
nodes -> do
        seen <- StateT
  (Set (Defn TermReference TermReference))
  (Except (NonEmpty (Defn TermReference TermReference)))
  (Set (Defn TermReference TermReference))
forall s (m :: * -> *). MonadState s m => m s
State.get
        if Set.member node seen
          then search path nodes
          else do
            let 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 randomSetElem (Set.intersection adjacent beingUpdated) of
              Just Defn TermReference TermReference
ref -> NonEmpty (Defn TermReference TermReference)
-> StateT
     (Set (Defn TermReference TermReference))
     (Except (NonEmpty (Defn TermReference TermReference)))
     ()
forall a.
NonEmpty (Defn TermReference TermReference)
-> StateT
     (Set (Defn TermReference TermReference))
     (Except (NonEmpty (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]
-> NonEmpty (Defn TermReference TermReference)
forall a. a -> [a] -> NonEmpty a
List.NonEmpty.:| 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 (NonEmpty (Defn TermReference TermReference)))
     ()
forall s (m :: * -> *). MonadState s m => s -> m ()
State.put (Set (Defn TermReference TermReference)
 -> StateT
      (Set (Defn TermReference TermReference))
      (Except (NonEmpty (Defn TermReference TermReference)))
      ())
-> Set (Defn TermReference TermReference)
-> StateT
     (Set (Defn TermReference TermReference))
     (Except (NonEmpty (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 (NonEmpty (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 (NonEmpty (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