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

import Control.Lens ((.=), _1)
import Control.Monad.Reader (ask)
import Data.Map.Strict qualified as Map
import Data.Set qualified as Set
import Unison.ABT qualified as ABT
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.Editor.HandleInput.Load (EvalMode (Native, Permissive), 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.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.PrettyPrintEnvDecl.Names qualified as PPED
import Unison.Reference qualified as Reference
import Unison.Result qualified as Result
import Unison.Symbol (Symbol)
import Unison.Syntax.HashQualified qualified as HQ
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.UnisonFile (TypecheckedUnisonFile)
import Unison.UnisonFile qualified as UF
import Unison.UnisonFile.Names qualified as UF
import Unison.Util.Defns (Defns (..))
import Unison.Util.Recursion
import Unison.Var qualified as Var

handleRun :: Bool -> HQ.HashQualified Name -> [String] -> Cli ()
handleRun :: Bool -> HashQualified Name -> [String] -> Cli ()
handleRun Bool
native HashQualified Name
main [String]
args = do
  (TypecheckedUnisonFile Symbol Ann
unisonFile, Type Symbol Ann
mainResType) <- do
    (Symbol
sym, Term Symbol Ann
term, Type Symbol Ann
typ, Type Symbol Ann
otyp) <- HashQualified Name
-> Cli (Symbol, Term Symbol Ann, Type Symbol Ann, Type Symbol Ann)
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
    pure (TypecheckedUnisonFile Symbol Ann
uf, Type Symbol Ann
otyp)
  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 suffixifiedPPE :: PrettyPrintEnv
suffixifiedPPE = PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.suffixifiedPPE PrettyPrintEnvDecl
pped
  let mode :: EvalMode
mode | Bool
native = EvalMode
Native | Bool
otherwise = EvalMode
Permissive
  ([(Symbol, Term Symbol ())]
_, Map Symbol (Ann, String, Id, Term Symbol (), Term Symbol (), Bool)
xs) <- EvalMode
-> PrettyPrintEnv
-> TypecheckedUnisonFile Symbol Ann
-> [String]
-> Cli
     ([(Symbol, Term Symbol ())],
      Map Symbol (Ann, String, Id, Term Symbol (), Term Symbol (), Bool))
evalUnisonFile EvalMode
mode PrettyPrintEnv
suffixifiedPPE TypecheckedUnisonFile Symbol Ann
unisonFile [String]
args
  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
suffixifiedPPE 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)

-- | 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.
getTerm :: HQ.HashQualified Name -> Cli (Symbol, Term Symbol Ann, Type Symbol Ann, Type Symbol Ann)
getTerm :: HashQualified Name
-> Cli (Symbol, Term Symbol Ann, Type Symbol Ann, Type Symbol Ann)
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))
-> Cli (Symbol, Term Symbol Ann, Type Symbol Ann, Type 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
    GetTermResult
NoTermWithThatName -> do
      Type Symbol Ann
mainType <- Runtime Symbol -> Type Symbol Ann
forall v. Runtime v -> Type v Ann
Runtime.mainType (Runtime Symbol -> Type Symbol Ann)
-> Cli (Runtime Symbol) -> Cli (Type Symbol Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting (Runtime Symbol) Env (Runtime Symbol)
-> Cli (Runtime Symbol)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Runtime Symbol) Env (Runtime 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)
forall a. Output -> Cli a
Cli.returnEarly (Output
 -> Cli (Symbol, Term Symbol Ann, Type Symbol Ann, Type Symbol Ann))
-> Output
-> Cli (Symbol, Term Symbol Ann, Type Symbol Ann, Type Symbol Ann)
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 Symbol -> Type Symbol Ann
forall v. Runtime v -> Type v Ann
Runtime.mainType (Runtime Symbol -> Type Symbol Ann)
-> Cli (Runtime Symbol) -> Cli (Type Symbol Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting (Runtime Symbol) Env (Runtime Symbol)
-> Cli (Runtime Symbol)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Runtime Symbol) Env (Runtime 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)
forall a. Output -> Cli a
Cli.returnEarly (Output
 -> Cli (Symbol, Term Symbol Ann, Type Symbol Ann, Type Symbol Ann))
-> Output
-> Cli (Symbol, Term Symbol Ann, Type Symbol Ann, Type Symbol Ann)
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)
x -> (Symbol, Term Symbol Ann, Type Symbol Ann, Type Symbol Ann)
-> Cli (Symbol, Term Symbol Ann, Type Symbol Ann, Type Symbol Ann)
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Symbol, Term Symbol Ann, Type Symbol Ann, Type Symbol Ann)
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 Symbol
runtime :: Runtime Symbol
$sel:runtime:Env :: Env -> Runtime Symbol
runtime} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
        Names
names <- Cli Names
Cli.currentNames
        let loadTypeOfTerm :: Reference -> Cli (Maybe (Type Symbol Ann))
loadTypeOfTerm Reference
ref = Transaction (Maybe (Type Symbol Ann))
-> Cli (Maybe (Type Symbol Ann))
forall a. Transaction a -> Cli a
Cli.runTransaction (Codebase IO Symbol Ann
-> Reference -> Transaction (Maybe (Type Symbol Ann))
forall a (m :: * -> *).
BuiltinAnnotation a =>
Codebase m Symbol a
-> Reference -> Transaction (Maybe (Type Symbol a))
Codebase.getTypeOfTerm Codebase IO Symbol Ann
codebase Reference
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
=<< (Reference -> Cli (Maybe (Type Symbol Ann)))
-> Names
-> HashQualified Name
-> Type Symbol Ann
-> Cli (MainTerm Symbol)
forall (m :: * -> *) v.
(Monad m, Var v) =>
(Reference -> m (Maybe (Type v Ann)))
-> Names -> HashQualified Name -> Type v Ann -> m (MainTerm v)
MainTerm.getMainTerm Reference -> Cli (Maybe (Type Symbol Ann))
loadTypeOfTerm Names
names HashQualified Name
mainName (Runtime Symbol -> Type Symbol Ann
forall v. Runtime v -> Type v Ann
Runtime.mainType Runtime 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 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 Type Symbol Ann
-> (Type Symbol Ann -> Cli GetTermResult) -> Cli GetTermResult
checkType 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)
-> GetTermResult
GetTermSuccess (Symbol
v, Term Symbol Ann
tm, Type Symbol Ann
typ, Type Symbol Ann
otyp))
      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)] ->
            Type Symbol Ann
-> (Type Symbol Ann -> Cli GetTermResult) -> Cli GetTermResult
checkType 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)
-> GetTermResult
GetTermSuccess (Symbol
v2, Term Symbol Ann
runMain, Type Symbol Ann
ty, Type Symbol Ann
otyp))
          [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]
_ -> Cli GetTermResult
getFromCodebase
      checkType :: Type Symbol Ann -> (Type Symbol Ann -> Cli GetTermResult) -> Cli GetTermResult
      checkType :: Type Symbol Ann
-> (Type Symbol Ann -> Cli GetTermResult) -> Cli GetTermResult
checkType 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 Symbol
$sel:runtime:Env :: Env -> Runtime Symbol
runtime :: Runtime Symbol
runtime} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
        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 Symbol -> Type Symbol Ann
forall v. Runtime v -> Type v Ann
Runtime.mainType Runtime Symbol
runtime) of
          Bool
True -> do
            TypeLookup Symbol Ann
typeLookup <-
              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 Reference Reference
-> Transaction (TypeLookup Symbol Ann)
Codebase.typeLookupForDependencies Codebase IO Symbol Ann
codebase Defns {$sel:terms:Defns :: Set Reference
terms = Set Reference
forall a. Set a
Set.empty, $sel:types:Defns :: Set Reference
types = Type Symbol Ann -> Set Reference
forall v a. Ord v => Type v a -> Set Reference
Type.dependencies Type Symbol Ann
ty}
            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
typeLookup 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 -> Reference -> Term Symbol Ann
forall v a vt at ap. Ord v => a -> Reference -> Term2 vt at ap v a
Term.ref Ann
External Reference
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 [NamedReference Symbol Ann]
termsByShortname = Map Name [NamedReference Symbol Ann]
forall k a. Map k a
Map.empty
          }
  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) =>
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 Reference
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
=<< Reference -> Maybe Id
Reference.toId Reference
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"