Merge pull request #246 from well-typed/edsko/more-cleanup

More cleanup and docs

grapesy/grapesy.cabal

@@ -150,7 +150,7 @@ library
     , crypton-x509         >= 1.7     && < 1.8
     , crypton-x509-store   >= 1.6     && < 1.7
     , crypton-x509-system  >= 1.6     && < 1.7
-    , data-default-class   >= 0.1     && < 0.2
+    , data-default         >= 0.7     && < 0.9
     , deepseq              >= 1.4     && < 1.6
     , exceptions           >= 0.10    && < 0.11
     , grpc-spec            >= 0.1     && < 0.2

grapesy/src/Network/GRPC/Client/Connection.hs

@@ -29,7 +29,7 @@ import Control.Concurrent
 import Control.Concurrent.STM
 import Control.Monad
 import Control.Monad.Catch
-import Data.Default.Class
+import Data.Default
 import GHC.Stack
 import Network.HPACK qualified as HPACK
 import Network.HTTP2.Client qualified as HTTP2.Client

grapesy/src/Network/GRPC/Common.hs

@@ -80,7 +80,7 @@ module Network.GRPC.Common (
   , Default(..)
   ) where
 
-import Data.Default.Class
+import Data.Default
 import Data.Proxy
 import Network.Socket (PortNumber)
 

grapesy/src/Network/GRPC/Common/Compression.hs

@@ -28,7 +28,7 @@ module Network.GRPC.Common.Compression (
   , insist
   ) where
 
-import Data.Default.Class
+import Data.Default
 import Data.Foldable (toList)
 import Data.List.NonEmpty (NonEmpty(..))
 import Data.List.NonEmpty qualified as NE

grapesy/src/Network/GRPC/Common/HTTP2Settings.hs

@@ -7,7 +7,7 @@ module Network.GRPC.Common.HTTP2Settings
   , defaultHTTP2Settings
   ) where
 
-import Data.Default.Class
+import Data.Default
 import Data.Word
 
 -- | HTTP\/2 settings

grapesy/src/Network/GRPC/Util/TLS.hs

@@ -23,7 +23,7 @@ module Network.GRPC.Util.TLS (
   ) where
 
 import Control.Exception
-import Data.Default.Class
+import Data.Default
 import Data.X509 qualified as X509
 import Data.X509.CertificateStore qualified as X509
 import System.Environment

grpc-spec/grpc-spec.cabal

@@ -131,7 +131,7 @@ library
     , bytestring          >= 0.10.12 && < 0.13
     , case-insensitive    >= 1.2     && < 1.3
     , containers          >= 0.6     && < 0.8
-    , data-default-class  >= 0.1     && < 0.2
+    , data-default        >= 0.7     && < 0.9
     , deepseq             >= 1.4     && < 1.6
     , exceptions          >= 0.10    && < 0.11
     , hashable            >= 1.3     && < 1.5

grpc-spec/src/Network/GRPC/Spec/Call.hs

@@ -5,7 +5,7 @@ module Network.GRPC.Spec.Call (
   , callRequestMetadata
   ) where
 
-import Data.Default.Class
+import Data.Default
 import Data.Functor.Const
 
 import Network.GRPC.Spec.CustomMetadata.Typed
@@ -47,7 +47,7 @@ data CallParams rpc = CallParams {
 
 deriving instance (Show (RequestMetadata rpc)) => Show (CallParams rpc)
 
--- | Default 'CallParams'
+-- | Default t'CallParams'
 instance Default (RequestMetadata rpc) => Default (CallParams rpc) where
   def = CallParams {
         callTimeout         = Nothing

grpc-spec/src/Network/GRPC/Spec/Compression.hs

@@ -95,13 +95,15 @@ data CompressionId =
   | Custom String
   deriving stock (Eq, Ord, Generic)
 
+-- | Serialize compression ID
 serializeCompressionId :: CompressionId -> Strict.ByteString
 serializeCompressionId Identity   = "identity"
 serializeCompressionId GZip       = "gzip"
 serializeCompressionId Deflate    = "deflate"
 serializeCompressionId Snappy     = "snappy"
 serializeCompressionId (Custom i) = BS.Strict.UTF8.fromString i
 
+-- | Parse compression ID
 deserializeCompressionId :: Strict.ByteString -> CompressionId
 deserializeCompressionId "identity" = Identity
 deserializeCompressionId "gzip"     = GZip
@@ -122,6 +124,7 @@ compressionIsIdentity = (== Identity) . compressionId
   Compression algorithms
 -------------------------------------------------------------------------------}
 
+-- | Disable compression (referred to as @identity@ in the gRPC spec)
 noCompression :: Compression
 noCompression = Compression {
       compressionId             = Identity
@@ -130,6 +133,7 @@ noCompression = Compression {
     , uncompressedSizeThreshold = const False
     }
 
+-- | @gzip@
 gzip :: Compression
 gzip = Compression {
       compressionId = GZip
@@ -141,7 +145,7 @@ gzip = Compression {
     , uncompressedSizeThreshold = (>= 27)
     }
 
--- | zlib deflate compression
+-- | @zlib@ (aka @deflate@) compression
 --
 -- Note: The gRPC spec calls this "deflate", but it is /not/ raw deflate
 -- format. The expected format (at least by the python server) is just zlib

grpc-spec/src/Network/GRPC/Spec/CustomMetadata/Map.hs

@@ -1,6 +1,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 
--- | Map of 'CustomMetadata', handling joining values
+-- | Map of t'CustomMetadata', handling joining values
 module Network.GRPC.Spec.CustomMetadata.Map (
     CustomMetadataMap -- opaque
     -- * Conversion
@@ -53,14 +53,14 @@ instance Semigroup CustomMetadataMap where
   Conversion
 -------------------------------------------------------------------------------}
 
--- | Construct 'CustomMetadataMap', joining duplicates
+-- | Construct t'CustomMetadataMap', joining duplicates
 customMetadataMapFromList :: [CustomMetadata] -> CustomMetadataMap
 customMetadataMapFromList =
       CustomMetadataMap
     . Map.fromListWith joinHeaderValue
     . map unpairCustomMetadata
 
--- | Flatten 'CustomMetadataMap' to a list
+-- | Flatten t'CustomMetadataMap' to a list
 --
 -- Precondition: the map must be valid.
 customMetadataMapToList :: CustomMetadataMap -> [CustomMetadata]
@@ -74,7 +74,7 @@ customMetadataMapToList mds =
   Construction
 -------------------------------------------------------------------------------}
 
--- | Insert value into 'CustomMetadataMap'
+-- | Insert value into t'CustomMetadataMap'
 --
 -- If a header with the same name already exists, the value is appended to
 -- (the end of) the existing value.

grpc-spec/src/Network/GRPC/Spec/CustomMetadata/NoMetadata.hs

@@ -1,13 +1,10 @@
 module Network.GRPC.Spec.CustomMetadata.NoMetadata (
     NoMetadata(..)
-  , UnexpectedMetadata(..)
   ) where
 
-import Control.Exception
 import Control.Monad.Catch
-import Data.Default.Class
+import Data.Default
 
-import Network.GRPC.Spec.CustomMetadata.Raw
 import Network.GRPC.Spec.CustomMetadata.Typed
 
 -- | Indicate the absence of custom metadata
@@ -26,8 +23,3 @@ instance ParseMetadata NoMetadata where
 
 instance StaticMetadata NoMetadata where
   metadataHeaderNames _ = []
-
-data UnexpectedMetadata = UnexpectedMetadata [CustomMetadata]
-  deriving stock (Show)
-  deriving anyclass (Exception)
-

grpc-spec/src/Network/GRPC/Spec/CustomMetadata/Raw.hs

@@ -56,13 +56,19 @@ import Network.GRPC.Spec.Util.ByteString (strip, ascii)
 -- with duplicate header names. Duplicate header names may have their values
 -- joined with "," as the delimiter and be considered semantically equivalent.
 data CustomMetadata = UnsafeCustomMetadata {
-      customMetadataName  :: HeaderName
+      -- | Header name
+      --
+      -- The header name determines if this is an ASCII header or a binary
+      -- header; see the t'CustomMetadata' pattern synonym.
+      customMetadataName :: HeaderName
+
+      -- | Header value
     , customMetadataValue :: Strict.ByteString
     }
   deriving stock (Eq, Generic)
   deriving anyclass (NFData)
 
--- | 'Show' instance relies on the 'CustomMetadata' pattern synonym
+-- | 'Show' instance relies on the v'CustomMetadata' pattern synonym
 instance Show CustomMetadata where
   showsPrec p (UnsafeCustomMetadata name value) = showParen (p >= appPrec1) $
          showString "CustomMetadata "
@@ -81,6 +87,10 @@ instance Show CustomMetadata where
 isValidAsciiValue :: Strict.ByteString -> Bool
 isValidAsciiValue bs = BS.Strict.all (\c -> 0x20 <= c && c <= 0x7E) bs
 
+-- | Construct t'CustomMetadata'
+--
+-- Returns 'Nothing' if the 'HeaderName' indicates an ASCII header but the
+-- value is not valid ASCII (consider using a binary header instead).
 safeCustomMetadata :: HeaderName -> Strict.ByteString -> Maybe CustomMetadata
 safeCustomMetadata name value =
     case name of

grpc-spec/src/Network/GRPC/Spec/CustomMetadata/Typed.hs

@@ -8,6 +8,7 @@ module Network.GRPC.Spec.CustomMetadata.Typed (
   , BuildMetadata(..)
   , StaticMetadata(..)
   , ParseMetadata(..)
+  , UnexpectedMetadata(..)
   , buildMetadataIO
   ) where
 
@@ -113,3 +114,11 @@ class BuildMetadata a => StaticMetadata a where
 class ParseMetadata a where
   parseMetadata :: MonadThrow m => [CustomMetadata] -> m a
 
+-- | Unexpected metadata
+--
+-- This exception can be thrown in 'ParseMetadata' instances. See 'ParseMetadata'
+-- for discussion.
+data UnexpectedMetadata = UnexpectedMetadata [CustomMetadata]
+  deriving stock (Show)
+  deriving anyclass (Exception)
+

grpc-spec/src/Network/GRPC/Spec/Headers/Common.hs

@@ -22,7 +22,7 @@ module Network.GRPC.Spec.Headers.Common (
   ) where
 
 import Data.ByteString qualified as Strict (ByteString)
-import Data.Default.Class
+import Data.Default
 import Data.Proxy
 import GHC.Generics (Generic)
 
@@ -53,6 +53,7 @@ data ContentType =
 instance Default ContentType where
   def = ContentTypeDefault
 
+-- | Interpret 'ContentType'
 chooseContentType :: IsRPC rpc => Proxy rpc -> ContentType -> Strict.ByteString
 chooseContentType p ContentTypeDefault       = rpcContentType p
 chooseContentType _ (ContentTypeOverride ct) = ct
@@ -77,6 +78,7 @@ data MessageType =
 instance Default MessageType where
   def = MessageTypeDefault
 
+-- | Interpret 'MessageType'
 chooseMessageType ::
      IsRPC rpc
   => Proxy rpc -> MessageType -> Maybe Strict.ByteString

grpc-spec/src/Network/GRPC/Spec/Headers/Invalid.hs

@@ -54,7 +54,7 @@ newtype InvalidHeaders e = InvalidHeaders {
 --
 -- This corresponds to a single \"raw\" HTTP header. It is possible that a
 -- particular field of, say, 'Network.GRPC.Spec.Headers.Request.RequestHeaders'
--- corresponds to /multiple/ 'InvalidHeader', when the value of that field is
+-- corresponds to /multiple/ t'InvalidHeader', when the value of that field is
 -- determined by combining multiple HTTP headers. A special case of this is the
 -- field for unrecognized headers (see
 -- 'Network.GRPC.Spec.Headers.Request.requestUnrecognized',
@@ -90,21 +90,26 @@ data InvalidHeader e =
   Construction
 -------------------------------------------------------------------------------}
 
+-- | Convenience constructor around v'InvalidHeader'
 invalidHeader :: Maybe HTTP.Status -> HTTP.Header -> String -> InvalidHeaders e
 invalidHeader status hdr err = wrapOne $ InvalidHeader status hdr err
 
+-- | Convenience constructor around v'MissingHeader'
 missingHeader :: Maybe HTTP.Status -> HTTP.HeaderName -> InvalidHeaders e
 missingHeader status name = wrapOne $ MissingHeader status name
 
+-- | Convenience constructor around v'UnexpectedHeader'
 unexpectedHeader :: HTTP.HeaderName -> InvalidHeaders e
 unexpectedHeader name = wrapOne $ UnexpectedHeader name
 
+-- | Convenience constructor around v'InvalidHeaderSynthesize'
 invalidHeaderSynthesize ::
      e
   -> InvalidHeader HandledSynthesized
   -> InvalidHeaders e
 invalidHeaderSynthesize e orig = wrapOne $ InvalidHeaderSynthesize e orig
 
+-- | Convenience function for throwing an 'invalidHeader' exception.
 throwInvalidHeader ::
      MonadError (InvalidHeaders e) m
   => HTTP.Header
@@ -136,6 +141,7 @@ instance Show HandledSynthesized where
 instance Eq HandledSynthesized where
   x == _ = handledSynthesized x
 
+-- | Evidence that 'HandledSynthesized' is an empty type
 handledSynthesized :: HandledSynthesized -> a
 handledSynthesized x = case x of {}
 
@@ -154,6 +160,7 @@ dropSynthesized = \(InvalidHeaders es) ->
     aux (InvalidHeaderSynthesize _ orig) =
         orig
 
+-- | Map over the errors
 mapSynthesizedM :: forall m e e'.
      Monad m
   => (e -> m e')
@@ -176,9 +183,13 @@ mapSynthesizedM f = \(InvalidHeaders es) ->
             e' <- f e
             go (InvalidHeaderSynthesize e' orig : acc) xs
 
+-- | Pure version of 'mapSynthesizedM'
 mapSynthesized :: (e -> e') -> InvalidHeaders e -> InvalidHeaders e'
 mapSynthesized f = runIdentity . mapSynthesizedM (Identity . f)
 
+-- | Throw all synthesized errors
+--
+-- After this we are guaranteed that the synthesized errors have been handlded.
 throwSynthesized ::
      (HKD.Traversable h, Monad m)
   => (forall a. GrpcException -> m a)
@@ -206,6 +217,7 @@ invalidHeaders = \invalid ->
     aux UnexpectedHeader{}            = Nothing
     aux (InvalidHeaderSynthesize e _) = handledSynthesized e
 
+-- | Render t'InvalidHeaders'
 prettyInvalidHeaders :: InvalidHeaders HandledSynthesized -> ByteString.Builder
 prettyInvalidHeaders = mconcat . map go . getInvalidHeaders
   where

grpc-spec/src/Network/GRPC/Spec/Headers/Response.hs

@@ -73,12 +73,13 @@ data ResponseHeaders_ f = ResponseHeaders {
 
 -- | Response headers (without allowing for invalid headers)
 --
--- See 'RequestHeaders' for an explanation of @Undecorated@.
+-- See t'Network.GRPC.Spec.RequestHeaders' for an explanation of 'Undecorated'.
 type ResponseHeaders = ResponseHeaders_ Undecorated
 
 -- | Response headers allowing for invalid headers
 --
--- See 'RequestHeaders'' for an explanation of @Checked@ and the purpose of @e@.
+-- See t'Network.GRPC.Spec.RequestHeaders'' for an explanation of 'Checked' and
+-- the purpose of @e@.
 type ResponseHeaders' e =  ResponseHeaders_ (Checked (InvalidHeaders e))
 
 deriving stock instance Show    ResponseHeaders
@@ -132,7 +133,7 @@ data ProperTrailers_ f = ProperTrailers {
     }
   deriving anyclass (HKD.Coerce)
 
--- | Default constructor for 'ProperTrailers'
+-- | Default constructor for t'ProperTrailers'
 simpleProperTrailers :: forall f.
      HKD.ValidDecoration Applicative f
   => HKD f GrpcStatus
@@ -209,7 +210,7 @@ instance HKD.Traversable TrailersOnly_ where
         <$> (f              $ trailersOnlyContentType x)
         <*> (HKD.traverse f $ trailersOnlyProper      x)
 
--- | 'ProperTrailers' is a subset of 'TrailersOnly'
+-- | t'ProperTrailers' is a subset of t'TrailersOnly'
 properTrailersToTrailersOnly ::
      (ProperTrailers_ f, HKD f (Maybe ContentType))
   -> TrailersOnly_ f
@@ -218,7 +219,7 @@ properTrailersToTrailersOnly (proper, ct) = TrailersOnly {
     , trailersOnlyContentType = ct
     }
 
--- | 'TrailersOnly' is a superset of 'ProperTrailers'
+-- | t'TrailersOnly' is a superset of t'ProperTrailers'
 trailersOnlyToProperTrailers ::
       TrailersOnly_ f
    -> (ProperTrailers_ f, HKD f (Maybe ContentType))
@@ -268,7 +269,7 @@ data GrpcNormalTermination = GrpcNormalTermination {
 --
 -- However, in practice gRPC servers can also respond with @Trailers-Only@ in
 -- non-error cases, simply indicating that the server considers the
--- conversation over. To distinguish, we look at 'trailerGrpcStatus'.
+-- conversation over. To distinguish, we look at 'properTrailersGrpcStatus'.
 grpcClassifyTermination ::
      ProperTrailers'
   -> Either GrpcException GrpcNormalTermination