feat!: Add typedef parameter kind actions to "available actions" API

Signed-off-by: George Thomas <[email protected]>
hackworthltd · Aug 7, 2023 · 161fc4e · 161fc4e
1 parent 7791589
commit 161fc4e
Show file tree

Hide file tree

Showing 4 changed files with 56 additions and 5 deletions.
diff --git a/primer-service/test/outputs/OpenAPI/openapi.json b/primer-service/test/outputs/OpenAPI/openapi.json
@@ -318,7 +318,10 @@
                     "DeleteCon",
                     "AddConField",
                     "DeleteConField",
-                    "DeleteTypeParam"
+                    "DeleteTypeParam",
+                    "MakeKType",
+                    "MakeKFun",
+                    "DeleteKind"
                 ],
                 "type": "string"
             },

diff --git a/primer/src/Primer/Action.hs b/primer/src/Primer/Action.hs
@@ -1158,6 +1158,12 @@ toProgActionNoInput defs def0 sel0 = \case
   Available.DeleteTypeParam -> do
     (t, p) <- typeParamSel
     pure [DeleteTypeParam t p.param]
+  Available.MakeKType -> do
+    toProgAction [ConstructKType]
+  Available.MakeKFun -> do
+    toProgAction [ConstructKFun]
+  Available.DeleteKind -> do
+    toProgAction [Delete]
   where
     termSel = case sel0 of
       SelectionDef s -> pure s
@@ -1179,15 +1185,24 @@ toProgActionNoInput defs def0 sel0 = \case
       typeNodeSel >>= \case
         (s0, TypeDefParamNodeSelection s) -> pure (s0, s)
         _ -> Left NeedTypeDefParamSelection
+    typeParamKindSel =
+      typeParamSel >>= \case
+        (t, TypeDefParamSelection p (Just id)) -> pure (t, p, id)
+        _ -> Left NeedTypeDefParamKindSelection
     conFieldSel = do
       (ty, s) <- conSel
       maybe (Left NeedTypeDefConsFieldSelection) (pure . (ty,s.con,)) s.field
     toProgAction actions = do
       case sel0 of
         SelectionDef sel -> toProg' actions sel.def <$> maybeToEither NoNodeSelection sel.node
-        SelectionTypeDef _ -> do
-          (t, c, f) <- conFieldSel
-          pure [ConFieldAction t c f.index $ SetCursor f.meta : actions]
+        SelectionTypeDef sel -> case sel.node of
+          Just (TypeDefParamNodeSelection _) -> do
+            (t, p, id) <- typeParamKindSel
+            pure [ParamKindAction t p id actions]
+          Just (TypeDefConsNodeSelection _) -> do
+            (t, c, f) <- conFieldSel
+            pure [ConFieldAction t c f.index $ SetCursor f.meta : actions]
+          Nothing -> Left NeedTypeDefNodeSelection
     termDef = first (const NeedTermDef) def0
     typeDef = either Right (Left . const NeedTypeDef) def0
 

diff --git a/primer/src/Primer/Action/Available.hs b/primer/src/Primer/Action/Available.hs
@@ -70,6 +70,7 @@ import Primer.Core (
   GlobalName (baseName, qualifiedModule),
   HasID (_id),
   ID,
+  Kind' (..),
   KindMeta,
   ModuleName (unModuleName),
   Pattern (PatCon, PatPrim),
@@ -163,6 +164,9 @@ data NoInputAction
   | AddConField
   | DeleteConField
   | DeleteTypeParam
+  | MakeKType
+  | MakeKFun
+  | DeleteKind
   deriving stock (Eq, Ord, Show, Read, Enum, Bounded, Generic)
   deriving (ToJSON, FromJSON) via PrimerJSON NoInputAction
 
@@ -409,7 +413,23 @@ forTypeDefParamKindNode ::
   TyConName ->
   ASTTypeDef TypeMeta KindMeta ->
   [Action]
-forTypeDefParamKindNode _ _ _ _ _ _ _ _ = mempty
+forTypeDefParamKindNode _ _ _ NonEditable _ _ _ _ = mempty
+forTypeDefParamKindNode paramName id l Editable tydefs defs tdName td =
+  sortByPriority
+    l
+    $ mwhen (not $ typeInUse tdName td tydefs defs)
+    $ [NoInput MakeKFun] <> case findKind id . snd =<< find ((== paramName) . fst) (astTypeDefParameters td) of
+      Nothing -> []
+      Just (KHole _) -> [NoInput MakeKType]
+      Just _ -> [NoInput DeleteKind]
+  where
+    findKind i k =
+      if getID k == i
+        then Just k
+        else case k of
+          KHole _ -> Nothing
+          KType _ -> Nothing
+          KFun _ k1 k2 -> findKind i k1 <|> findKind i k2
 
 forTypeDefConsNode ::
   Level ->
@@ -713,6 +733,9 @@ sortByPriority l =
         AddConField -> P.addConField
         DeleteConField -> P.delete
         DeleteTypeParam -> P.delete
+        MakeKType -> P.ktype
+        MakeKFun -> P.kfun
+        DeleteKind -> P.delete
       Input a -> case a of
         MakeCon -> P.useSaturatedValueCon
         MakeInt -> P.makeInt

diff --git a/primer/src/Primer/Action/Priorities.hs b/primer/src/Primer/Action/Priorities.hs
@@ -57,6 +57,10 @@ module Primer.Action.Priorities (
   constructTypeApp,
   constructForall,
 
+  -- * Kind actions.
+  ktype,
+  kfun,
+
   -- * Type def actions.
   addCon,
   addTypeParam,
@@ -168,3 +172,9 @@ addTypeParam _ = 8
 
 addConField :: Level -> Int
 addConField _ = 10
+
+ktype :: Level -> Int
+ktype _ = 10
+
+kfun :: Level -> Int
+kfun _ = 20