diff --git a/server/Scion/Server/Commands2.hs b/server/Scion/Server/Commands2.hs index 8280ece..ed00625 100644 --- a/server/Scion/Server/Commands2.hs +++ b/server/Scion/Server/Commands2.hs @@ -226,6 +226,7 @@ allCommands = , cmdListCabalComponents , cmdCurrentComponent , cmdForceUnload + , cmdBackgroundTypecheckFile ] instance Message ModuleName where @@ -377,3 +378,10 @@ cmdCurrentComponent = Cmd "current-component" $ noArgs $ getActiveComponent cmdForceUnload :: Cmd cmdForceUnload = Cmd "force-unload" $ noArgs $ unload +cmdBackgroundTypecheckFile :: Cmd +cmdBackgroundTypecheckFile = + Cmd "background-typecheck-file" $ reqArg "file" $ cmd + where cmd fname = do + either (Left . T.pack) Right <$> + backgroundTypecheckFile (T.unpack fname) + diff --git a/server/Scion/Server/Message.hs b/server/Scion/Server/Message.hs index b2c6473..945dbe0 100644 --- a/server/Scion/Server/Message.hs +++ b/server/Scion/Server/Message.hs @@ -224,7 +224,15 @@ instance Message a => Message (Maybe a) where fromMsg MsgNull = pure Nothing -- Masks 'Just ()' and 'Just Nothing' -- as 'Nothing' fromMsg x = Just <$> fromMsg x - + +instance (Message a, Message b) => Message (Either a b) where + toMsg (Right b) = mkMap [("ok", toMsg b)] + toMsg (Left a) = mkMap [("error", toMsg a)] + fromMsg m + | Ok a <- decodeKey m "error" = pure (Left a) + | Ok b <- decodeKey m "ok" = pure (Right b) + | otherwise = fail "Either" + ------------------------------------------------------------------------ -- * Sending and Receiving Messages ------------------------------------------------------------------------