Skip to content

Commit

Permalink
cleanup: Fix some warnings; add a suppression.
Browse files Browse the repository at this point in the history
The suppressed warning is actually useful and should be fixed, but not
right now.
iphydf committed Sep 4, 2023

Verified

This commit was signed with the committer’s verified signature. The key has expired.
holiman Martin HS
1 parent a6cadae commit e7d9312
Showing 3 changed files with 9 additions and 6 deletions.
9 changes: 5 additions & 4 deletions src/Network/MessagePack/Interface.hs
Original file line number Diff line number Diff line change
@@ -25,6 +25,7 @@ module Network.MessagePack.Interface

import Control.Monad.Catch (MonadThrow)
import Control.Monad.Trans (MonadIO)
import Data.Kind (Type)
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Typeable (Typeable)
@@ -42,7 +43,7 @@ data Interface f = Interface
}


newtype InterfaceM (m :: * -> *) f = InterfaceM
newtype InterfaceM (m :: Type -> Type) f = InterfaceM
{ nameM :: Text
}

@@ -74,7 +75,7 @@ instance Typeable r => IsDocType (Returns r) where
flatDoc (Ret retName) =
MethodDocs [] (MethodVal retName (typeName (undefined :: r)))

data ReturnsM (m :: * -> *) r
data ReturnsM (m :: Type -> Type) r

instance Typeable r => IsDocType (ReturnsM m r) where
data Doc (ReturnsM m r) = RetM Text
@@ -105,7 +106,7 @@ typeName = Text.replace "[Char]" "String" . Text.pack . show . Typeable.typeOf
--------------------------------------------------------------------------------


class IsClientType (m :: * -> *) f where
class IsClientType (m :: Type -> Type) f where
type ClientType m f

instance IsClientType m r => IsClientType m (o -> r) where
@@ -123,7 +124,7 @@ call = Client.call . nameM
--------------------------------------------------------------------------------


class IsReturnType (m :: * -> *) f where
class IsReturnType (m :: Type -> Type) f where
type HaskellType f
type ServerType m f

5 changes: 3 additions & 2 deletions src/Network/MessagePack/Rpc.hs
Original file line number Diff line number Diff line change
@@ -14,6 +14,7 @@ module Network.MessagePack.Rpc
) where

import Control.Monad.Catch (MonadThrow)
import Data.Kind (Type)
import Data.Text (Text)

import qualified Network.MessagePack.Interface as I
@@ -27,8 +28,8 @@ import Network.MessagePack.Server.Basic ()


class RpcService rpc where
type ClientMonad rpc :: * -> *
type ServerMonad rpc :: * -> *
type ClientMonad rpc :: Type -> Type
type ServerMonad rpc :: Type -> Type
type F rpc
rpc :: rpc -> I.ClientType (ClientMonad rpc) (F rpc)
method :: rpc -> Server.Method (ServerMonad rpc)
1 change: 1 addition & 0 deletions src/Network/MessagePack/Types/Result.hs
Original file line number Diff line number Diff line change
@@ -1,3 +1,4 @@
{-# OPTIONS_GHC -Wno-noncanonical-monad-instances #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}

0 comments on commit e7d9312

Please sign in to comment.