[Discussion] IO Watch Expressions

codebase2/codebase-sqlite/U/Codebase/Sqlite/Orphans.hs

@@ -60,12 +60,14 @@ instance ToField WatchKind where
   toField = \case
     WatchKind.RegularWatch -> SQLInteger 0
     WatchKind.TestWatch -> SQLInteger 1
+    WatchKind.IOWatch -> SQLInteger 2
 
 instance FromField WatchKind where
   fromField =
     fromField @Int8 <&> fmap \case
       0 -> WatchKind.RegularWatch
       1 -> WatchKind.TestWatch
+      2 -> WatchKind.IOWatch
       tag -> error $ "Unknown WatchKind id " ++ show tag
 
 instance ToRow NamespaceStats where

codebase2/codebase/U/Codebase/WatchKind.hs

@@ -1,3 +1,7 @@
 module U.Codebase.WatchKind where
 
-data WatchKind = RegularWatch | TestWatch deriving (Eq, Ord, Show)
+data WatchKind
+  = RegularWatch
+  | TestWatch
+  | IOWatch
+  deriving (Eq, Ord, Show)

parser-typechecker/src/Unison/Codebase/Runtime.hs

@@ -6,6 +6,7 @@ module Unison.Codebase.Runtime where
 import Data.Map qualified as Map
 import Unison.ABT qualified as ABT
 import Unison.Builtin.Decls (tupleTerm, pattern TupleTerm')
+import Unison.Builtin.Decls qualified as DD
 import Unison.Codebase.CodeLookup qualified as CL
 import Unison.Codebase.CodeLookup.Util qualified as CL
 import Unison.Hashing.V2.Convert qualified as Hashing
@@ -16,6 +17,7 @@ import Unison.Reference (Reference)
 import Unison.Reference qualified as Reference
 import Unison.Term qualified as Term
 import Unison.Type (Type)
+import Unison.Typechecker qualified as Typechecker
 import Unison.UnisonFile (TypecheckedUnisonFile)
 import Unison.UnisonFile qualified as UF
 import Unison.Util.Pretty qualified as P
@@ -69,33 +71,42 @@ type WatchResults v a =
 -- `evaluationCache`. If that returns a result, evaluation of that definition
 -- can be skipped.
 evaluateWatches ::
-  forall v a.
+  forall v.
   (Var v) =>
-  CL.CodeLookup v IO a ->
+  CL.CodeLookup v IO Ann ->
   PPE.PrettyPrintEnv ->
   (Reference.Id -> IO (Maybe (Term v))) ->
   Runtime v ->
-  TypecheckedUnisonFile v a ->
-  IO (WatchResults v a)
+  TypecheckedUnisonFile v Ann ->
+  IO (WatchResults v Ann)
 evaluateWatches code ppe evaluationCache rt tuf = do
   -- 1. compute hashes for everything in the file
-  let m :: Map v (Reference.Id, Term.Term v a)
-      m = fmap (\(_a, id, _wk, tm, _tp) -> (id, tm)) (UF.hashTermsId tuf)
+  let m :: Map v (Reference.Id, Maybe WatchKind, Term.Term v Ann)
+      m =
+        UF.hashTermsId tuf
+          <&> \case
+            -- Add a force to IOWatch'es which match the 'mainType'
+            (a, id, wk@(Just WK.IOWatch), tm, typ)
+              | Typechecker.fitsScheme typ (mainType rt) ->
+                  (id, wk, DD.forceTerm a a tm)
+            (_a, id, wk, tm, _tp) -> (id, wk, tm)
       watches :: Set v = Map.keysSet watchKinds
       watchKinds :: Map v WatchKind
       watchKinds =
         Map.fromList
           [(v, k) | (k, ws) <- UF.watchComponents tuf, (v, _a, _tm, _tp) <- ws]
       unann = Term.amap (const ())
   -- 2. use the cache to lookup things already computed
-  m' <- fmap Map.fromList . for (Map.toList m) $ \(v, (r, t)) -> do
-    o <- evaluationCache r
+  m' <- fmap Map.fromList . for (Map.toList m) $ \(v, (r, mayWK, t)) -> do
+    o <- case mayWK of
+      Just WK.IOWatch -> pure Nothing
+      _ -> evaluationCache r
     case o of
       Nothing -> pure (v, (r, ABT.annotation t, unann t, False))
       Just t' -> pure (v, (r, ABT.annotation t, t', True))
   -- 3. create a big ol' let rec whose body is a big tuple of all watches
   let rv :: Map Reference.Id v
-      rv = Map.fromList [(r, v) | (v, (r, _)) <- Map.toList m]
+      rv = Map.fromList [(r, v) | (v, (r, _mayWK, _)) <- Map.toList m]
       bindings :: [(v, (), Term v)]
       bindings = [(v, (), unref rv b) | (v, (_, _, b, _)) <- Map.toList m']
       watchVars = [Term.var () v | v <- toList watches]
@@ -136,12 +147,12 @@ evaluateWatches code ppe evaluationCache rt tuf = do
         go _ = Nothing
 
 evaluateTerm' ::
-  (Var v, Monoid a) =>
-  CL.CodeLookup v IO a ->
+  (Var v) =>
+  CL.CodeLookup v IO Ann ->
   (Reference.Id -> IO (Maybe (Term v))) ->
   PPE.PrettyPrintEnv ->
   Runtime v ->
-  Term.Term v a ->
+  Term.Term v Ann ->
   IO (Either Error (Term v))
 evaluateTerm' codeLookup cache ppe rt tm = do
   result <- cache (Hashing.hashClosedTerm tm)
@@ -154,18 +165,18 @@ evaluateTerm' codeLookup cache ppe rt tm = do
               mempty
               mempty
               [(WK.RegularWatch, [(Var.nameds "result", mempty, tm, mempty <$> mainType rt)])]
-      r <- evaluateWatches (void codeLookup) ppe cache rt (void tuf)
+      r <- evaluateWatches (codeLookup) ppe cache rt (tuf)
       pure $
         r <&> \(_, map) ->
           case Map.elems map of
             [(_loc, _kind, _hash, _src, value, _isHit)] -> value
             _ -> error "evaluateTerm': Pattern mismatch on watch results"
 
 evaluateTerm ::
-  (Var v, Monoid a) =>
-  CL.CodeLookup v IO a ->
+  (Var v) =>
+  CL.CodeLookup v IO Ann ->
   PPE.PrettyPrintEnv ->
   Runtime v ->
-  Term.Term v a ->
+  Term.Term v Ann ->
   IO (Either Error (Term v))
 evaluateTerm codeLookup = evaluateTerm' codeLookup noCache

parser-typechecker/src/Unison/Codebase/SqliteCodebase/Conversions.hs

@@ -72,12 +72,14 @@ watchKind1to2 :: V1.WK.WatchKind -> V2.WatchKind
 watchKind1to2 = \case
   V1.WK.RegularWatch -> V2.WatchKind.RegularWatch
   V1.WK.TestWatch -> V2.WatchKind.TestWatch
+  V1.WK.IOWatch -> V2.WatchKind.IOWatch
   other -> error $ "What kind of watchkind is " ++ other ++ "?"
 
 watchKind2to1 :: V2.WatchKind -> V1.WK.WatchKind
 watchKind2to1 = \case
   V2.WatchKind.RegularWatch -> V1.WK.RegularWatch
   V2.WatchKind.TestWatch -> V1.WK.TestWatch
+  V2.WatchKind.IOWatch -> V1.WK.IOWatch
 
 term1to2 :: Hash -> V1.Term.Term V1.Symbol Ann -> V2.Term.Term V2.Symbol
 term1to2 h =

unison-core/src/Unison/WatchKind.hs

@@ -22,3 +22,15 @@ pattern RegularWatch = ""
 -- Note: currently test watches don't need to be named by the user, but that "feature" will be removed soon.
 pattern TestWatch :: (Eq a, IsString a) => a
 pattern TestWatch = "test"
+
+-- | A watch expression which runs an expression of type @@'{IO, Exception} a@@, such as
+--
+-- @
+-- io> do
+--   x = readFile "foo.txt"
+--   length x
+-- @
+--
+-- Note: currently test watches don't need to be named by the user, but that "feature" will be removed soon.
+pattern IOWatch :: (Eq a, IsString a) => a
+pattern IOWatch = "io"