Review fixes

servant.cabal

@@ -46,7 +46,7 @@ library
   build-depends:
       base >=4.7 && <5
     , bytestring == 0.10.*
-    , http-media >= 0.4 && < 0.5
+    , http-media >= 0.4 && < 0.6
     , http-types == 0.8.*
     , text >= 1 && < 2
     , template-haskell >= 2.7 && < 2.10

src/Servant/API/ContentTypes.hs

@@ -11,7 +11,6 @@
 {-# LANGUAGE UndecidableInstances #-}
 module Servant.API.ContentTypes where
 
-import           Control.Monad           (join)
 import qualified Data.ByteString         as BS
 import           Data.ByteString.Lazy    (ByteString)
 import           Data.String.Conversions (cs)
@@ -102,27 +101,25 @@ instance ( AllMimeRender ctyps a, IsNonEmpty ctyps
          ) => AllCTRender ctyps a where
     handleAcceptH _ (AcceptHeader accept) val = M.mapAcceptMedia lkup accept
       where pctyps = Proxy :: Proxy ctyps
-            amrs = amr pctyps val
-            lkup = zip (map fst amrs) $ map (\(a,b) -> (cs $ show a, b)) amrs
-
-
+            amrs = allMimeRender pctyps val
+            lkup = fmap (\(a,b) -> (a, (cs $ show a, b))) amrs
 
 
 --------------------------------------------------------------------------
 -- * Unrender
 class Accept ctype => MimeUnrender ctype a where
-    fromByteString :: Proxy ctype -> ByteString -> Maybe a
+    fromByteString :: Proxy ctype -> ByteString -> Either String a
 
 class AllCTUnrender list a where
     handleCTypeH :: Proxy list
                  -> ByteString     -- Content-Type header
                  -> ByteString     -- Request body
-                 -> Maybe a
+                 -> Maybe (Either String a)
 
 instance ( AllMimeUnrender ctyps a, IsNonEmpty ctyps
          ) => AllCTUnrender ctyps a where
-    handleCTypeH _ ctypeH body = join $ M.mapContentMedia lkup (cs ctypeH)
-      where lkup = amu (Proxy :: Proxy ctyps) body
+    handleCTypeH _ ctypeH body = M.mapContentMedia lkup (cs ctypeH)
+      where lkup = allMimeUnrender (Proxy :: Proxy ctyps) body
 
 --------------------------------------------------------------------------
 -- * Utils (Internal)
@@ -132,50 +129,42 @@ instance ( AllMimeUnrender ctyps a, IsNonEmpty ctyps
 -- Check that all elements of list are instances of MimeRender
 --------------------------------------------------------------------------
 class AllMimeRender ls a where
-    amr :: Proxy ls
-        -> a                              -- value to serialize
-        -> [(M.MediaType, ByteString)]    -- content-types/response pairs
+    allMimeRender :: Proxy ls
+                  -> a                              -- value to serialize
+                  -> [(M.MediaType, ByteString)]    -- content-types/response pairs
 
 instance ( MimeRender ctyp a ) => AllMimeRender '[ctyp] a where
-    amr _ a = [(contentType pctyp, toByteString pctyp a)]
+    allMimeRender _ a = [(contentType pctyp, toByteString pctyp a)]
         where pctyp = Proxy :: Proxy ctyp
 
 instance ( MimeRender ctyp a
-         , MimeRender ctyp' a        -- at least two elems to avoid overlap
-         , AllMimeRender ctyps a
+         , AllMimeRender (ctyp' ': ctyps) a
          ) => AllMimeRender (ctyp ': ctyp' ': ctyps) a where
-    amr _ a = (contentType pctyp, toByteString pctyp a)
-             :(contentType pctyp', toByteString pctyp' a)
-             :(amr pctyps a)
+    allMimeRender _ a = (contentType pctyp, toByteString pctyp a)
+                       :(allMimeRender pctyps a)
         where pctyp = Proxy :: Proxy ctyp
-              pctyps = Proxy :: Proxy ctyps
-              pctyp' = Proxy :: Proxy ctyp'
+              pctyps = Proxy :: Proxy (ctyp' ': ctyps)
 
 
 instance AllMimeRender '[] a where
-    amr _ _ = []
+    allMimeRender _ _ = []
 
 --------------------------------------------------------------------------
 -- Check that all elements of list are instances of MimeUnrender
 --------------------------------------------------------------------------
 class AllMimeUnrender ls a where
-    amu :: Proxy ls -> ByteString -> [(M.MediaType, Maybe a)]
+    allMimeUnrender :: Proxy ls -> ByteString -> [(M.MediaType, Either String a)]
 
-instance ( MimeUnrender ctyp a ) => AllMimeUnrender '[ctyp] a where
-    amu _ val = [(contentType pctyp, fromByteString pctyp val)]
-        where pctyp = Proxy :: Proxy ctyp
+instance AllMimeUnrender '[] a where
+    allMimeUnrender _ _ = []
 
 instance ( MimeUnrender ctyp a
-         , MimeUnrender ctyp' a
          , AllMimeUnrender ctyps a
-         ) => AllMimeUnrender (ctyp ': ctyp' ': ctyps) a where
-    amu _ val = (contentType pctyp, fromByteString pctyp val)
-               :(contentType pctyp', fromByteString pctyp' val)
-               :(amu pctyps val)
+         ) => AllMimeUnrender (ctyp ': ctyps) a where
+    allMimeUnrender _ val = (contentType pctyp, fromByteString pctyp val)
+                           :(allMimeUnrender pctyps val)
         where pctyp = Proxy :: Proxy ctyp
               pctyps = Proxy :: Proxy ctyps
-              pctyp' = Proxy :: Proxy ctyp'
 
 type family IsNonEmpty (ls::[*]) :: Constraint where
-    IsNonEmpty '[] = 'False ~ 'True
-    IsNonEmpty x   = ()
+    IsNonEmpty (x ': xs)   = ()

src/Servant/API/Get.hs

@@ -10,5 +10,5 @@ import Data.Typeable ( Typeable )
 -- Example:
 --
 -- > type MyApi = "books" :> Get '[JSON] [Book]
-data Get (cts::[*]) a
+data Get (contentTypes::[*]) a
   deriving Typeable

src/Servant/API/Patch.hs

@@ -1,4 +1,6 @@
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE KindSignatures #-}
 module Servant.API.Patch where
 
 import Data.Typeable ( Typeable )
@@ -11,9 +13,9 @@ import Data.Typeable ( Typeable )
 --
 -- Example:
 --
--- >            -- POST /books
+-- >            -- PATCH /books
 -- >            -- with a JSON encoded Book as the request body
 -- >            -- returning the just-created Book
--- > type MyApi = "books" :> ReqBody Book :> Post Book
-data Patch a
+-- > type MyApi = "books" :> ReqBody Book :> Patch '[JSON] Book
+data Patch (contentTypes::[*]) a
   deriving Typeable

src/Servant/API/Post.hs

@@ -15,5 +15,5 @@ import Data.Typeable ( Typeable )
 -- >            -- with a JSON encoded Book as the request body
 -- >            -- returning the just-created Book
 -- > type MyApi = "books" :> ReqBody Book :> Post '[JSON] Book
-data Post (cts::[*]) a
+data Post (contentTypes::[*]) a
   deriving Typeable

src/Servant/API/Put.hs

@@ -13,5 +13,5 @@ import Data.Typeable ( Typeable )
 -- > -- PUT /books/:isbn
 -- > -- with a Book as request body, returning the updated Book
 -- > type MyApi = "books" :> Capture "isbn" Text :> ReqBody Book :> Put '[JSON] Book
-data Put (cts::[*]) a
+data Put (contentTypes::[*]) a
   deriving Typeable

src/Servant/API/ReqBody.hs

@@ -8,4 +8,4 @@ module Servant.API.ReqBody where
 --
 -- >            -- POST /books
 -- > type MyApi = "books" :> ReqBody '[JSON] Book :> Post Book
-data ReqBody (ls::[*]) a
+data ReqBody (contentTypes::[*]) a

src/Servant/Utils/Links.hs

@@ -180,7 +180,6 @@ type family IsSubList a b :: Constraint where
     IsSubList '[x] (x ': xs) = ()
     IsSubList '[x] (y ': ys) = IsSubList '[x] ys
     IsSubList (x ': xs) y = IsSubList '[x] y `And` IsSubList xs y
-    IsSubList a b = 'True ~ 'False
 
 -- Phantom types for Param
 data Matrix