fix: work around an OpenAPI 3.0 spec issue regarding nullable results

This fixes an issue where the OpenAPI schema check failed when
`setSelection` returns `Nothing`. This should never happen in theory
and is just a quirk of our typechecker implementation, but our OpenAPI
adapter can't properly handle this scenario, and the OpenAPI 3.0 spec
isn't clear how to do so, either.

To work around this, we add a wrapped version of `setSelection` that
converts `Nothing` results to an API error.

Signed-off-by: Drew Hess <src@drewhess.com>

primer-service/src/Primer/Servant/OpenAPI.hs

@@ -104,7 +104,7 @@ data SessionAPI mode = SessionAPI
           :> Summary "Set the current selection, and obtain the type of the selected node"
           :> OperationId "setSelection"
           :> ReqBody '[JSON] Selection
-          :> Post '[JSON] (Maybe TypeOrKind)
+          :> Post '[JSON] TypeOrKind
   , createDefinition ::
       mode
         :- "def"

primer-service/src/Primer/Server.hs

@@ -180,7 +180,7 @@ openAPISessionServer sid =
     , OpenAPI.getProgram = API.getProgram' sid
     , OpenAPI.getSessionName = API.getSessionName sid
     , OpenAPI.setSessionName = renameSession sid
-    , OpenAPI.setSelection = API.setSelection sid
+    , OpenAPI.setSelection = API.setSelection' sid
     , OpenAPI.createDefinition = createDefinition sid
     , OpenAPI.typeDef = openAPITypeDefServer sid
     , OpenAPI.actions = openAPIActionServer sid
@@ -427,5 +427,6 @@ serve ss q v port origins logger = do
         UndoError pe -> err500{errBody = "Undo failed: " <> show pe}
         RedoError pe -> err500{errBody = "Redo failed: " <> show pe}
         SetSelectionError sel pe -> err400{errBody = "Error while setting selection (" <> show sel <> "): " <> show pe}
+        SetSelectionNothing sel -> err400{errBody = "Error while setting selection (" <> show sel <> "): setSelection returned Nothing"}
       where
         encode = LT.encodeUtf8 . LT.fromStrict

primer/src/Primer/API.hs

@@ -72,6 +72,7 @@ module Primer.API (
   Name (..),
   TypeOrKind (..),
   setSelection,
+  setSelection',
 ) where
 
 import Foreword
@@ -272,6 +273,7 @@ data PrimerErr
   | UndoError ProgError
   | RedoError ProgError
   | SetSelectionError Selection ProgError
+  | SetSelectionNothing Selection
   deriving stock (Show)
 
 instance Exception PrimerErr
@@ -1246,3 +1248,20 @@ setSelection = curry $ logAPI (noError SetSelection) $ \(sid, sel) ->
     viewTypeKind = Kind . fromMaybe trivialTree . viewTypeKind'
     viewTypeKind' :: TypeMeta -> Maybe Tree
     viewTypeKind' = preview $ _type % _Just % to viewTreeKind
+
+-- | Strip 'Maybe' off of 'setSelection''s return type.
+--
+-- For technical reasons owing to our typechecker's design,
+-- 'setSelection' returns a 'Maybe TypeOrKind', but that curently
+-- causes problems with our OpenAPI adapter due to the OpenAPI 3.0
+-- specification not properly supporting nullable results. To work
+-- around this, we strip 'setSelection''s return type down to
+-- 'TypeOrKind' in normal operation, and throw an error otherwise. In
+-- practice, this error should never occur (though 'setSelection' may
+-- of course fail for other reasons; e.g., the client attempts to
+-- select invalid ID).
+--
+-- When we can update to OpenAPI 3.1, or our adapter otherwise adds
+-- support for nullable results, we may drop this method.
+setSelection' :: (MonadIO m, MonadThrow m, MonadAPILog l m) => SessionId -> Selection -> PrimerM m TypeOrKind
+setSelection' sid sel = setSelection sid sel >>= maybe (throwM $ SetSelectionNothing sel) pure