-- | This module contains functionality that is common to the general idea of "updating" a term in Unison, which is when
-- we reassign a name from one hash to another and then see if all dependents still typecheck.
--
-- This occurs in the `pull`, `merge`, `update`, and `upgrade` commands.
module Unison.Cli.UpdateUtils
  ( -- * Getting dependents in a namespace
    getNamespaceDependentsOf,
    subtractDependents,

    -- * Hydrating definitions
    hydrateRefs,
    nameHydratedRefIds,

    -- * Unique type guids
    makeUniqueTypeGuids,

    -- * Parsing and typechecking
    parseAndTypecheck,
  )
where

import Control.Monad.Reader (ask)
import Data.Bitraversable (bitraverse)
import Data.Foldable qualified as Foldable
import Data.List qualified as List
import Data.Map.Strict qualified as Map
import Data.Set qualified as Set
import U.Codebase.Decl qualified as V2.Decl
import U.Codebase.Reference (Reference' (..), TermReferenceId, TypeReferenceId)
import U.Codebase.Sqlite.Operations qualified as Operations
import Unison.Cli.Monad (Cli, Env (..))
import Unison.Cli.Monad qualified as Cli
import Unison.Cli.TypeCheck (computeTypecheckingEnvironment)
import Unison.ConstructorReference (GConstructorReference (..))
import Unison.Debug qualified as Debug
import Unison.FileParsers qualified as FileParsers
import Unison.Hash (Hash)
import Unison.Name (Name)
import Unison.Parser.Ann (Ann)
import Unison.Parsers qualified as Parsers
import Unison.Prelude
import Unison.Reference (Reference, TypeReference)
import Unison.Reference qualified as Reference
import Unison.Referent (Referent)
import Unison.Referent qualified as Referent
import Unison.Result qualified as Result
import Unison.Sqlite (Transaction)
import Unison.Symbol (Symbol)
import Unison.Syntax.Parser qualified as Parser
import Unison.UnisonFile (TypecheckedUnisonFile)
import Unison.Util.BiMultimap (BiMultimap)
import Unison.Util.BiMultimap qualified as BiMultimap
import Unison.Util.Defns (Defns (..), DefnsF, zipDefnsWith)
import Unison.Util.Map qualified as Map (thenInsertPair)
import Unison.Util.Pretty (Pretty)
import Unison.Util.Pretty qualified as Pretty
import Unison.Util.Set qualified as Set
import Prelude hiding (unzip, zip, zipWith)

------------------------------------------------------------------------------------------------------------------------
-- Getting dependents in a namespace

-- | Given a namespace and a set of dependencies, return the subset of the namespace that consists of only the
-- (transitive) dependents of the dependencies.
getNamespaceDependentsOf ::
  Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name) ->
  Set Reference ->
  Transaction (DefnsF (Map Name) TermReferenceId TypeReferenceId)
getNamespaceDependentsOf :: Defns (BiMultimap Referent Name) (BiMultimap Reference Name)
-> Set Reference
-> Transaction (DefnsF (Map Name) TypeReferenceId TypeReferenceId)
getNamespaceDependentsOf Defns (BiMultimap Referent Name) (BiMultimap Reference Name)
defns Set Reference
dependencies = do
  let toTermScope :: BiMultimap Referent b -> Set TypeReferenceId
toTermScope = (Referent -> Maybe TypeReferenceId)
-> Set Referent -> Set TypeReferenceId
forall b a. Ord b => (a -> Maybe b) -> Set a -> Set b
Set.mapMaybe Referent -> Maybe TypeReferenceId
Referent.toReferenceId (Set Referent -> Set TypeReferenceId)
-> (BiMultimap Referent b -> Set Referent)
-> BiMultimap Referent b
-> Set TypeReferenceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BiMultimap Referent b -> Set Referent
forall a b. BiMultimap a b -> Set a
BiMultimap.dom
  let toTypeScope :: BiMultimap Reference b -> Set TypeReferenceId
toTypeScope = (Reference -> Maybe TypeReferenceId)
-> Set Reference -> Set TypeReferenceId
forall b a. Ord b => (a -> Maybe b) -> Set a -> Set b
Set.mapMaybe Reference -> Maybe TypeReferenceId
Reference.toId (Set Reference -> Set TypeReferenceId)
-> (BiMultimap Reference b -> Set Reference)
-> BiMultimap Reference b
-> Set TypeReferenceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BiMultimap Reference b -> Set Reference
forall a b. BiMultimap a b -> Set a
BiMultimap.dom
  let scope :: DefnsF Set TypeReferenceId TypeReferenceId
scope = (BiMultimap Referent Name -> Set TypeReferenceId)
-> (BiMultimap Reference Name -> Set TypeReferenceId)
-> Defns (BiMultimap Referent Name) (BiMultimap Reference Name)
-> DefnsF Set TypeReferenceId TypeReferenceId
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 BiMultimap Referent Name -> Set TypeReferenceId
forall {b}. BiMultimap Referent b -> Set TypeReferenceId
toTermScope BiMultimap Reference Name -> Set TypeReferenceId
forall {b}. BiMultimap Reference b -> Set TypeReferenceId
toTypeScope Defns (BiMultimap Referent Name) (BiMultimap Reference Name)
defns
  DefnsF Set TypeReferenceId TypeReferenceId
-> Set Reference
-> Transaction (DefnsF Set TypeReferenceId TypeReferenceId)
Operations.transitiveDependentsWithinScope DefnsF Set TypeReferenceId TypeReferenceId
scope Set Reference
dependencies
    Transaction (DefnsF Set TypeReferenceId TypeReferenceId)
-> (DefnsF Set TypeReferenceId TypeReferenceId
    -> DefnsF (Map Name) TypeReferenceId TypeReferenceId)
-> Transaction (DefnsF (Map Name) TypeReferenceId TypeReferenceId)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Set TypeReferenceId -> Map Name TypeReferenceId)
-> (Set TypeReferenceId -> Map Name TypeReferenceId)
-> DefnsF Set TypeReferenceId TypeReferenceId
-> DefnsF (Map Name) TypeReferenceId TypeReferenceId
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 ((Map Name TypeReferenceId
 -> TypeReferenceId -> Map Name TypeReferenceId)
-> Map Name TypeReferenceId
-> Set TypeReferenceId
-> Map Name TypeReferenceId
forall a b. (a -> b -> a) -> a -> Set b -> a
Set.foldl' Map Name TypeReferenceId
-> TypeReferenceId -> Map Name TypeReferenceId
addTerms Map Name TypeReferenceId
forall k a. Map k a
Map.empty) ((Map Name TypeReferenceId
 -> TypeReferenceId -> Map Name TypeReferenceId)
-> Map Name TypeReferenceId
-> Set TypeReferenceId
-> Map Name TypeReferenceId
forall a b. (a -> b -> a) -> a -> Set b -> a
Set.foldl' Map Name TypeReferenceId
-> TypeReferenceId -> Map Name TypeReferenceId
addTypes Map Name TypeReferenceId
forall k a. Map k a
Map.empty)
  where
    addTerms :: Map Name TermReferenceId -> TermReferenceId -> Map Name TermReferenceId
    addTerms :: Map Name TypeReferenceId
-> TypeReferenceId -> Map Name TypeReferenceId
addTerms Map Name TypeReferenceId
acc0 TypeReferenceId
ref =
      let names :: Set Name
names = Referent -> BiMultimap Referent Name -> Set Name
forall a b. Ord a => a -> BiMultimap a b -> Set b
BiMultimap.lookupDom (TypeReferenceId -> Referent
Referent.fromTermReferenceId TypeReferenceId
ref) Defns (BiMultimap Referent Name) (BiMultimap Reference Name)
defns.terms
       in (Map Name TypeReferenceId -> Name -> Map Name TypeReferenceId)
-> Map Name TypeReferenceId -> Set Name -> Map Name TypeReferenceId
forall a b. (a -> b -> a) -> a -> Set b -> a
Set.foldl' (\Map Name TypeReferenceId
acc Name
name -> Name
-> TypeReferenceId
-> Map Name TypeReferenceId
-> Map Name TypeReferenceId
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Name
name TypeReferenceId
ref Map Name TypeReferenceId
acc) Map Name TypeReferenceId
acc0 Set Name
names

    addTypes :: Map Name TypeReferenceId -> TypeReferenceId -> Map Name TypeReferenceId
    addTypes :: Map Name TypeReferenceId
-> TypeReferenceId -> Map Name TypeReferenceId
addTypes Map Name TypeReferenceId
acc0 TypeReferenceId
ref =
      let names :: Set Name
names = Reference -> BiMultimap Reference Name -> Set Name
forall a b. Ord a => a -> BiMultimap a b -> Set b
BiMultimap.lookupDom (TypeReferenceId -> Reference
Reference.fromId TypeReferenceId
ref) Defns (BiMultimap Referent Name) (BiMultimap Reference Name)
defns.types
       in (Map Name TypeReferenceId -> Name -> Map Name TypeReferenceId)
-> Map Name TypeReferenceId -> Set Name -> Map Name TypeReferenceId
forall a b. (a -> b -> a) -> a -> Set b -> a
Set.foldl' (\Map Name TypeReferenceId
acc Name
name -> Name
-> TypeReferenceId
-> Map Name TypeReferenceId
-> Map Name TypeReferenceId
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Name
name TypeReferenceId
ref Map Name TypeReferenceId
acc) Map Name TypeReferenceId
acc0 Set Name
names

subtractDependents ::
  DefnsF Set TermReferenceId TypeReferenceId ->
  DefnsF (Map Name) Referent TypeReference ->
  DefnsF (Map Name) Referent TypeReference
subtractDependents :: DefnsF Set TypeReferenceId TypeReferenceId
-> DefnsF (Map Name) Referent Reference
-> DefnsF (Map Name) Referent Reference
subtractDependents DefnsF Set TypeReferenceId TypeReferenceId
dependents =
  (Map Name Referent -> Map Name Referent)
-> (Map Name Reference -> Map Name Reference)
-> DefnsF (Map Name) Referent Reference
-> DefnsF (Map Name) Referent Reference
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 ((Referent -> Bool) -> Map Name Referent -> Map Name Referent
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter Referent -> Bool
keepTerm) ((Reference -> Bool) -> Map Name Reference -> Map Name Reference
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter Reference -> Bool
keepType)
  where
    keepType :: TypeReference -> Bool
    keepType :: Reference -> Bool
keepType = \case
      ReferenceBuiltin Text
_ -> Bool
True
      ReferenceDerived TypeReferenceId
refId -> Bool -> Bool
not (TypeReferenceId -> Set TypeReferenceId -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member TypeReferenceId
refId DefnsF Set TypeReferenceId TypeReferenceId
dependents.types)
    keepTerm :: Referent -> Bool
    keepTerm :: Referent -> Bool
keepTerm = \case
      Referent.Con (ConstructorReference Reference
ref ConstructorId
_) ConstructorType
_ -> Reference -> Bool
keepType Reference
ref
      Referent.Ref Reference
ref ->
        case Reference
ref of
          ReferenceBuiltin Text
_ -> Bool
True
          ReferenceDerived TypeReferenceId
refId -> Bool -> Bool
not (TypeReferenceId -> Set TypeReferenceId -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member TypeReferenceId
refId DefnsF Set TypeReferenceId TypeReferenceId
dependents.terms)

------------------------------------------------------------------------------------------------------------------------
-- Hydrating definitions

-- | Hydrate term/type references to actual terms/types.
hydrateRefs ::
  (Monad m) =>
  (Hash -> m [term]) ->
  (Hash -> m [typ]) ->
  DefnsF Set TermReferenceId TypeReferenceId ->
  m (Defns (Map TermReferenceId term) (Map TypeReferenceId typ))
hydrateRefs :: forall (m :: * -> *) term typ.
Monad m =>
(Hash -> m [term])
-> (Hash -> m [typ])
-> DefnsF Set TypeReferenceId TypeReferenceId
-> m (Defns (Map TypeReferenceId term) (Map TypeReferenceId typ))
hydrateRefs Hash -> m [term]
getTermComponent Hash -> m [typ]
getTypeComponent =
  (Set TypeReferenceId -> m (Map TypeReferenceId term))
-> (Set TypeReferenceId -> m (Map TypeReferenceId typ))
-> DefnsF Set TypeReferenceId TypeReferenceId
-> m (Defns (Map TypeReferenceId term) (Map TypeReferenceId typ))
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Defns a b -> f (Defns c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse ((Hash -> m [term])
-> Set TypeReferenceId -> m (Map TypeReferenceId term)
forall defn (m :: * -> *).
Monad m =>
(Hash -> m [defn])
-> Set TypeReferenceId -> m (Map TypeReferenceId defn)
hydrateRefs1 Hash -> m [term]
getTermComponent) ((Hash -> m [typ])
-> Set TypeReferenceId -> m (Map TypeReferenceId typ)
forall defn (m :: * -> *).
Monad m =>
(Hash -> m [defn])
-> Set TypeReferenceId -> m (Map TypeReferenceId defn)
hydrateRefs1 Hash -> m [typ]
getTypeComponent)

hydrateRefs1 ::
  forall defn m.
  (Monad m) =>
  (Hash -> m [defn]) ->
  Set Reference.Id ->
  m (Map Reference.Id defn)
hydrateRefs1 :: forall defn (m :: * -> *).
Monad m =>
(Hash -> m [defn])
-> Set TypeReferenceId -> m (Map TypeReferenceId defn)
hydrateRefs1 Hash -> m [defn]
getComponent =
  (Hash -> Map TypeReferenceId defn -> m (Map TypeReferenceId defn))
-> Map TypeReferenceId defn
-> Set Hash
-> m (Map TypeReferenceId defn)
forall (m :: * -> *) a b.
Monad m =>
(a -> b -> m b) -> b -> Set a -> m b
Set.foldCommutativeM Hash -> Map TypeReferenceId defn -> m (Map TypeReferenceId defn)
f Map TypeReferenceId defn
forall k a. Map k a
Map.empty (Set Hash -> m (Map TypeReferenceId defn))
-> (Set TypeReferenceId -> Set Hash)
-> Set TypeReferenceId
-> m (Map TypeReferenceId defn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TypeReferenceId -> Hash) -> Set TypeReferenceId -> Set Hash
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map TypeReferenceId -> Hash
Reference.idToHash
  where
    f :: Hash -> Map Reference.Id defn -> m (Map Reference.Id defn)
    f :: Hash -> Map TypeReferenceId defn -> m (Map TypeReferenceId defn)
f Hash
hash Map TypeReferenceId defn
acc =
      (Map TypeReferenceId defn
 -> (TypeReferenceId, defn) -> Map TypeReferenceId defn)
-> Map TypeReferenceId defn
-> [(TypeReferenceId, defn)]
-> Map TypeReferenceId defn
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' Map TypeReferenceId defn
-> (TypeReferenceId, defn) -> Map TypeReferenceId defn
forall k v. Ord k => Map k v -> (k, v) -> Map k v
Map.thenInsertPair Map TypeReferenceId defn
acc ([(TypeReferenceId, defn)] -> Map TypeReferenceId defn)
-> ([defn] -> [(TypeReferenceId, defn)])
-> [defn]
-> Map TypeReferenceId defn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash -> [defn] -> [(TypeReferenceId, defn)]
forall a. Hash -> [a] -> [(TypeReferenceId, a)]
Reference.componentFor Hash
hash ([defn] -> Map TypeReferenceId defn)
-> m [defn] -> m (Map TypeReferenceId defn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Hash -> m [defn]
getComponent Hash
hash

-- | Associate names with hydrated terms/types.
nameHydratedRefIds ::
  DefnsF (Map name) TermReferenceId TypeReferenceId ->
  Defns (Map TermReferenceId term) (Map TypeReferenceId typ) ->
  DefnsF (Map name) (TermReferenceId, term) (TypeReferenceId, typ)
nameHydratedRefIds :: forall name term typ.
DefnsF (Map name) TypeReferenceId TypeReferenceId
-> Defns (Map TypeReferenceId term) (Map TypeReferenceId typ)
-> DefnsF (Map name) (TypeReferenceId, term) (TypeReferenceId, typ)
nameHydratedRefIds =
  (Map name TypeReferenceId
 -> Map TypeReferenceId term -> Map name (TypeReferenceId, term))
-> (Map name TypeReferenceId
    -> Map TypeReferenceId typ -> Map name (TypeReferenceId, typ))
-> Defns (Map name TypeReferenceId) (Map name TypeReferenceId)
-> Defns (Map TypeReferenceId term) (Map TypeReferenceId typ)
-> Defns
     (Map name (TypeReferenceId, term))
     (Map name (TypeReferenceId, typ))
forall tm1 tm2 tm3 ty1 ty2 ty3.
(tm1 -> tm2 -> tm3)
-> (ty1 -> ty2 -> ty3)
-> Defns tm1 ty1
-> Defns tm2 ty2
-> Defns tm3 ty3
zipDefnsWith Map name TypeReferenceId
-> Map TypeReferenceId term -> Map name (TypeReferenceId, term)
forall name defn.
Map name TypeReferenceId
-> Map TypeReferenceId defn -> Map name (TypeReferenceId, defn)
f Map name TypeReferenceId
-> Map TypeReferenceId typ -> Map name (TypeReferenceId, typ)
forall name defn.
Map name TypeReferenceId
-> Map TypeReferenceId defn -> Map name (TypeReferenceId, defn)
f
  where
    f :: Map name Reference.Id -> Map Reference.Id defn -> Map name (Reference.Id, defn)
    f :: forall name defn.
Map name TypeReferenceId
-> Map TypeReferenceId defn -> Map name (TypeReferenceId, defn)
f Map name TypeReferenceId
nameToRef Map TypeReferenceId defn
refToDefn =
      (TypeReferenceId -> Maybe (TypeReferenceId, defn))
-> Map name TypeReferenceId -> Map name (TypeReferenceId, defn)
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe (\TypeReferenceId
ref -> (TypeReferenceId
ref,) (defn -> (TypeReferenceId, defn))
-> Maybe defn -> Maybe (TypeReferenceId, defn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeReferenceId -> Map TypeReferenceId defn -> Maybe defn
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TypeReferenceId
ref Map TypeReferenceId defn
refToDefn) Map name TypeReferenceId
nameToRef

------------------------------------------------------------------------------------------------------------------------
-- Unique type guids

-- Make a unique type name to guid mapping from definitions, by looking up each decl individually. Maybe there will be
-- a more efficient way to accomplish this some day, but this is how it works for now.
makeUniqueTypeGuids :: Map Name TypeReference -> Transaction (Map Name Text)
makeUniqueTypeGuids :: Map Name Reference -> Transaction (Map Name Text)
makeUniqueTypeGuids Map Name Reference
types = do
  let step :: Map TypeReferenceId Text -> TypeReferenceId -> Transaction (Map TypeReferenceId Text)
      step :: Map TypeReferenceId Text
-> TypeReferenceId -> Transaction (Map TypeReferenceId Text)
step Map TypeReferenceId Text
acc TypeReferenceId
refId = do
        Decl Symbol
decl <- TypeReferenceId -> Transaction (Decl Symbol)
Operations.expectDeclByReference TypeReferenceId
refId
        Map TypeReferenceId Text -> Transaction (Map TypeReferenceId Text)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure case Decl Symbol
decl.modifier of
          V2.Decl.Unique Text
guid -> TypeReferenceId
-> Text -> Map TypeReferenceId Text -> Map TypeReferenceId Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert TypeReferenceId
refId Text
guid Map TypeReferenceId Text
acc
          Modifier
V2.Decl.Structural -> Map TypeReferenceId Text
acc

  Map TypeReferenceId Text
uniqueTypeGuidsByRef <-
    (Map TypeReferenceId Text
 -> TypeReferenceId -> Transaction (Map TypeReferenceId Text))
-> Map TypeReferenceId Text
-> Set TypeReferenceId
-> Transaction (Map TypeReferenceId Text)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
Foldable.foldlM Map TypeReferenceId Text
-> TypeReferenceId -> Transaction (Map TypeReferenceId Text)
step Map TypeReferenceId Text
forall k a. Map k a
Map.empty ((Reference -> Set TypeReferenceId)
-> Map Name Reference -> Set TypeReferenceId
forall m a. Monoid m => (a -> m) -> Map Name a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Reference -> Set TypeReferenceId
toRefIds Map Name Reference
types)

  let refToUniqueTypeGuid :: TypeReference -> Maybe Text
      refToUniqueTypeGuid :: Reference -> Maybe Text
refToUniqueTypeGuid = \case
        ReferenceDerived TypeReferenceId
refId -> TypeReferenceId -> Map TypeReferenceId Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TypeReferenceId
refId Map TypeReferenceId Text
uniqueTypeGuidsByRef
        ReferenceBuiltin Text
_ -> Maybe Text
forall a. Maybe a
Nothing

  Map Name Text -> Transaction (Map Name Text)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Reference -> Maybe Text) -> Map Name Reference -> Map Name Text
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe Reference -> Maybe Text
refToUniqueTypeGuid Map Name Reference
types)
  where
    toRefIds :: TypeReference -> Set TypeReferenceId
    toRefIds :: Reference -> Set TypeReferenceId
toRefIds = \case
      ReferenceDerived TypeReferenceId
refId -> TypeReferenceId -> Set TypeReferenceId
forall a. a -> Set a
Set.singleton TypeReferenceId
refId
      ReferenceBuiltin Text
_ -> Set TypeReferenceId
forall a. Set a
Set.empty

------------------------------------------------------------------------------------------------------------------------
-- Parsing and typechecking

-- TODO: find a better module for this function, as it's used in a couple places
parseAndTypecheck ::
  Pretty Pretty.ColorText ->
  Parser.ParsingEnv Transaction ->
  Cli (Maybe (TypecheckedUnisonFile Symbol Ann))
parseAndTypecheck :: Pretty ColorText
-> ParsingEnv Transaction
-> Cli (Maybe (TypecheckedUnisonFile Symbol Ann))
parseAndTypecheck Pretty ColorText
prettyUf ParsingEnv Transaction
parsingEnv = do
  Env
env <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  let stringUf :: String
stringUf = Width -> Pretty ColorText -> String
Pretty.toPlain Width
80 Pretty ColorText
prettyUf
  DebugFlag -> Cli () -> Cli ()
forall (m :: * -> *). Monad m => DebugFlag -> m () -> m ()
Debug.whenDebug DebugFlag
Debug.Update do
    IO () -> Cli ()
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
      String -> IO ()
putStrLn String
"--- Scratch ---"
      String -> IO ()
putStrLn String
stringUf
  Transaction (Maybe (TypecheckedUnisonFile Symbol Ann))
-> Cli (Maybe (TypecheckedUnisonFile Symbol Ann))
forall a. Transaction a -> Cli a
Cli.runTransaction do
    String
-> String
-> ParsingEnv Transaction
-> Transaction (Either (Err Symbol) (UnisonFile Symbol Ann))
forall (m :: * -> *) v.
(Monad m, Var v) =>
String
-> String -> ParsingEnv m -> m (Either (Err v) (UnisonFile v Ann))
Parsers.parseFile String
"<update>" String
stringUf ParsingEnv Transaction
parsingEnv Transaction (Either (Err Symbol) (UnisonFile Symbol Ann))
-> (Either (Err Symbol) (UnisonFile Symbol Ann)
    -> Transaction (Maybe (TypecheckedUnisonFile Symbol Ann)))
-> Transaction (Maybe (TypecheckedUnisonFile Symbol Ann))
forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Left Err Symbol
_ -> Maybe (TypecheckedUnisonFile Symbol Ann)
-> Transaction (Maybe (TypecheckedUnisonFile Symbol Ann))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (TypecheckedUnisonFile Symbol Ann)
forall a. Maybe a
Nothing
      Right UnisonFile Symbol Ann
uf -> do
        Env Symbol Ann
typecheckingEnv <-
          ShouldUseTndr Transaction
-> Codebase IO Symbol Ann
-> [Type Symbol Ann]
-> UnisonFile Symbol Ann
-> Transaction (Env Symbol Ann)
computeTypecheckingEnvironment (ParsingEnv Transaction -> ShouldUseTndr Transaction
forall (m :: * -> *). ParsingEnv m -> ShouldUseTndr m
FileParsers.ShouldUseTndr'Yes ParsingEnv Transaction
parsingEnv) Env
env.codebase [] UnisonFile Symbol Ann
uf
        Maybe (TypecheckedUnisonFile Symbol Ann)
-> Transaction (Maybe (TypecheckedUnisonFile Symbol Ann))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result (Seq (Note Symbol Ann)) (TypecheckedUnisonFile Symbol Ann)
-> Maybe (TypecheckedUnisonFile Symbol Ann)
forall notes a. Result notes a -> Maybe a
Result.result (Env Symbol Ann
-> UnisonFile Symbol Ann
-> Result
     (Seq (Note Symbol Ann)) (TypecheckedUnisonFile Symbol Ann)
forall (m :: * -> *) v.
(Monad m, Var v) =>
Env v Ann
-> UnisonFile v
-> ResultT (Seq (Note v Ann)) m (TypecheckedUnisonFile v Ann)
FileParsers.synthesizeFile Env Symbol Ann
typecheckingEnv UnisonFile Symbol Ann
uf))