feat: multiple editable modules

primer-rel8/test/TestUtils.hs

@@ -363,10 +363,11 @@ testApp =
     testProg =
       newEmptyProg
         { progImports = [builtinModule, primitiveModule]
-        , progModule =
-            Module
-              { moduleName = ModuleName $ "TestModule" :| []
-              , moduleTypes = mempty
-              , moduleDefs = Map.singleton (baseName $ astDefName testASTDef) (DefAST testASTDef)
-              }
+        , progModules =
+            [ Module
+                { moduleName = ModuleName $ "TestModule" :| []
+                , moduleTypes = mempty
+                , moduleDefs = Map.singleton (baseName $ astDefName testASTDef) (DefAST testASTDef)
+                }
+            ]
         }

primer-service/src/Primer/OpenAPI.hs

@@ -9,9 +9,9 @@ module Primer.OpenAPI (
 import Data.OpenApi (ToSchema)
 import Data.Text (Text)
 import Data.Typeable (Typeable)
-import Primer.API (Def, Prog, Tree)
+import Primer.API (Def, Module, Prog, Tree)
 import Primer.App (InitialApp)
-import Primer.Core (GlobalName, ID (..), LVarName)
+import Primer.Core (GlobalName, ID (..), LVarName, ModuleName)
 import Primer.Database (Session, SessionName)
 import Primer.Name (Name)
 
@@ -40,4 +40,6 @@ deriving via Name instance Typeable k => ToSchema (GlobalName k)
 deriving via Name instance (ToSchema LVarName)
 instance ToSchema Tree
 instance ToSchema Def
+instance ToSchema ModuleName
+instance ToSchema Module
 instance ToSchema Prog

primer/src/Primer/API.hs

@@ -21,6 +21,7 @@ module Primer.API (
   getVersion,
   Tree,
   Prog,
+  Module,
   Def,
   getProgram,
   getSessionName,
@@ -70,7 +71,8 @@ import Primer.App (
   handleMutationRequest,
   handleQuestion,
   initialApp,
-  progModule,
+  progImports,
+  progModules,
   runEditAppM,
   runQueryAppM,
  )
@@ -83,6 +85,7 @@ import Primer.Core (
   ID,
   Kind,
   LVarName,
+  ModuleName,
   PrimCon (..),
   TmVarRef (GlobalVarRef, LocalVarRef),
   TyConName,
@@ -123,7 +126,7 @@ import qualified Primer.Database as Database (
     Success
   ),
  )
-import Primer.Module (Module (moduleDefs, moduleTypes))
+import Primer.Module (moduleDefs, moduleName, moduleTypes)
 import Primer.Name (Name, unName)
 import qualified StmContainers.Map as StmMap
 
@@ -301,8 +304,19 @@ instance ToJSON Tree
 
 -- | This type is the API's view of a 'App.Prog'
 -- (this is expected to evolve as we flesh out the API)
-data Prog = Prog
-  { types :: [TyConName]
+newtype Prog = Prog
+  { modules :: [Module]
+  }
+  deriving (Generic)
+
+instance ToJSON Prog
+
+-- | This type is the API's view of a 'Module.Module'
+-- (this is expected to evolve as we flesh out the API)
+data Module = Module
+  { modname :: ModuleName
+  , editable :: Bool
+  , types :: [TyConName]
   , -- We don't use Map Name Def as it is rather redundant since each
     -- Def carries a name field, and it is difficult to enforce that
     -- "the keys of this object match the name field of the
@@ -311,7 +325,7 @@ data Prog = Prog
   }
   deriving (Generic)
 
-instance ToJSON Prog
+instance ToJSON Module
 
 -- | This type is the api's view of a 'Primer.Core.Def'
 -- (this is expected to evolve as we flesh out the API)
@@ -327,18 +341,23 @@ instance ToJSON Def
 
 viewProg :: App.Prog -> Prog
 viewProg p =
-  Prog
-    { types = typeDefName <$> Map.elems (moduleTypes $ progModule p)
-    , defs =
-        ( \d ->
-            Def
-              { name = defName d
-              , type_ = viewTreeType $ defType d
-              , term = viewTreeExpr . astDefExpr <$> defAST d
-              }
-        )
-          <$> Map.elems (moduleDefs $ progModule p)
-    }
+  Prog{modules = map (viewModule True) (progModules p) <> map (viewModule False) (progImports p)}
+  where
+    viewModule e m =
+      Module
+        { modname = moduleName m
+        , editable = e
+        , types = typeDefName <$> Map.elems (moduleTypes m)
+        , defs =
+            ( \d ->
+                Def
+                  { name = defName d
+                  , type_ = viewTreeType $ defType d
+                  , term = viewTreeExpr . astDefExpr <$> defAST d
+                  }
+            )
+              <$> Map.elems (moduleDefs m)
+        }
 
 -- | A simple method to extract 'Tree's from 'Expr's. This is injective.
 -- Currently it is designed to be simple and just enough to enable

primer/src/Primer/Action.hs

@@ -387,7 +387,7 @@ data ProgAction
   | -- | Rename the definition with the given (base) Name
     RenameDef GVarName Text
   | -- | Create a new definition
-    CreateDef (Maybe Text)
+    CreateDef ModuleName (Maybe Text)
   | -- | Delete a new definition
     DeleteDef GVarName
   | -- | Add a new type definition
@@ -422,8 +422,8 @@ data ProgAction
     --   At the start of the actions, the cursor starts at the root of the definition's type/expression
     CopyPasteSig (GVarName, ID) [Action]
   | CopyPasteBody (GVarName, ID) [Action]
-  | -- | Renames the sole editable module
-    RenameModule (NonEmpty Text)
+  | -- | Renames an editable module (will return an error if asked to rename an imported module)
+    RenameModule ModuleName (NonEmpty Text)
   deriving (Eq, Show, Generic)
   deriving (FromJSON, ToJSON) via VJSON ProgAction
 
@@ -439,24 +439,26 @@ type ActionM m =
 -- | Apply a sequence of actions to the type signature of a definition
 -- We apply the actions to the type, then typecheck the body of the definition against the new type.
 -- We must then typecheck the whole program to check any uses of the definition.
--- Note that this may introduce new holes when using SmartHoles, and thus we return a whole module
--- as well as the one definition we wanted to change.
+-- Note that this may introduce new holes when using SmartHoles, and thus we
+-- return a whole set of modules as well as the one definition we wanted to
+-- change.
 applyActionsToTypeSig ::
   (MonadFresh ID m, MonadFresh NameCounter m) =>
   SmartHoles ->
   [Module] ->
-  Module ->
+  -- | The @Module@ we are focused on, and all the other editable modules
+  (Module, [Module]) ->
   -- | This must be one of the definitions in the @Module@
   ASTDef ->
   [Action] ->
-  m (Either ActionError (ASTDef, Module, TypeZ))
-applyActionsToTypeSig smartHoles imports mod def actions =
+  m (Either ActionError (ASTDef, [Module], TypeZ))
+applyActionsToTypeSig smartHoles imports (mod, mods) def actions =
   runReaderT
     go
-    (buildTypingContextFromModules (mod : imports) smartHoles)
+    (buildTypingContextFromModules (mod : mods <> imports) smartHoles)
     & runExceptT
   where
-    go :: ActionM m => m (ASTDef, Module, TypeZ)
+    go :: ActionM m => m (ASTDef, [Module], TypeZ)
     go = do
       zt <- withWrappedType (astDefType def) (\zt -> foldM (flip applyActionAndSynth) (InType zt) actions)
       let t = target (top zt)
@@ -469,10 +471,8 @@ applyActionsToTypeSig smartHoles imports mod def actions =
       -- We make sure that the updated type is present in the global context.
       -- Here we just check the whole of the mutable prog, excluding imports.
       -- (for efficiency, we need not check the type definitions, but we do not implement this optimisation)
-      checkEverything smartHoles (CheckEverything{trusted = imports, toCheck = [mod']}) >>= \case
-        [checkedMod] -> pure (def', checkedMod, zt)
-        -- This internal error will go away when we allow Progs to contain multiple mutable modules
-        _ -> throwError $ CustomFailure NoOp "Internal error: checkEverything returned a different number of module as were passed in"
+      checkEverything smartHoles (CheckEverything{trusted = imports, toCheck = mod' : mods})
+        >>= \checkedMods -> pure (def', checkedMods, zt)
     -- Actions expect that all ASTs have a top-level expression of some sort.
     -- Signatures don't have this: they're just a type.
     -- We fake it by wrapping the type in a top-level annotation node, then unwrapping afterwards.

primer/src/Primer/Action/Available.hs

@@ -100,7 +100,7 @@ actionsForDef l defs def =
               qn = astDefName def
               copyName = uniquifyDefName (qualifiedModule qn) (unName (baseName qn) <> "Copy") defs
            in NoInputRequired
-                [ CreateDef (Just copyName)
+                [ CreateDef (qualifiedModule $ astDefName def) (Just copyName)
                 , CopyPasteSig (astDefName def, sigID) []
                 , CopyPasteBody (astDefName def, bodyID) []
                 ]