on master help sign in
Review fixes
5e4297aJulian K. Arni
servant.cabal+1−1
@@ -46,7 +46,7 @@ library
46 build-depends:
46 build-depends:
47 base >=4.7 && <5
47 base >=4.7 && <5
48 , bytestring == 0.10.*
48 , bytestring == 0.10.*
49− , http-media >= 0.4 && < 0.5
49+ , http-media >= 0.4 && < 0.6
50 , http-types == 0.8.*
50 , http-types == 0.8.*
51 , text >= 1 && < 2
51 , text >= 1 && < 2
52 , template-haskell >= 2.7 && < 2.10
52 , template-haskell >= 2.7 && < 2.10
src/Servant/API/ContentTypes.hs+22−33
@@ -11,7 +11,6 @@
11{-# LANGUAGE UndecidableInstances #-}
11{-# LANGUAGE UndecidableInstances #-}
12module Servant.API.ContentTypes where
12module Servant.API.ContentTypes where
13
13
14−import Control.Monad (join)
15import qualified Data.ByteString as BS
14import qualified Data.ByteString as BS
16import Data.ByteString.Lazy (ByteString)
15import Data.ByteString.Lazy (ByteString)
17import Data.String.Conversions (cs)
16import Data.String.Conversions (cs)
@@ -102,27 +101,25 @@ instance ( AllMimeRender ctyps a, IsNonEmpty ctyps
102 ) => AllCTRender ctyps a where
101 ) => AllCTRender ctyps a where
103 handleAcceptH _ (AcceptHeader accept) val = M.mapAcceptMedia lkup accept
102 handleAcceptH _ (AcceptHeader accept) val = M.mapAcceptMedia lkup accept
104 where pctyps = Proxy :: Proxy ctyps
103 where pctyps = Proxy :: Proxy ctyps
105− amrs = amr pctyps val
104+ amrs = allMimeRender pctyps val
106− lkup = zip (map fst amrs) $ map (\(a,b) -> (cs $ show a, b)) amrs
105+ lkup = fmap (\(a,b) -> (a, (cs $ show a, b))) amrs
107−
108−
109
106
110
107
111--------------------------------------------------------------------------
108--------------------------------------------------------------------------
112-- * Unrender
109-- * Unrender
113class Accept ctype => MimeUnrender ctype a where
110class Accept ctype => MimeUnrender ctype a where
114− fromByteString :: Proxy ctype -> ByteString -> Maybe a
111+ fromByteString :: Proxy ctype -> ByteString -> Either String a
115
112
116class AllCTUnrender list a where
113class AllCTUnrender list a where
117 handleCTypeH :: Proxy list
114 handleCTypeH :: Proxy list
118 -> ByteString -- Content-Type header
115 -> ByteString -- Content-Type header
119 -> ByteString -- Request body
116 -> ByteString -- Request body
120− -> Maybe a
117+ -> Maybe (Either String a)
121
118
122instance ( AllMimeUnrender ctyps a, IsNonEmpty ctyps
119instance ( AllMimeUnrender ctyps a, IsNonEmpty ctyps
123 ) => AllCTUnrender ctyps a where
120 ) => AllCTUnrender ctyps a where
124− handleCTypeH _ ctypeH body = join $ M.mapContentMedia lkup (cs ctypeH)
121+ handleCTypeH _ ctypeH body = M.mapContentMedia lkup (cs ctypeH)
125− where lkup = amu (Proxy :: Proxy ctyps) body
122+ where lkup = allMimeUnrender (Proxy :: Proxy ctyps) body
126
123
127--------------------------------------------------------------------------
124--------------------------------------------------------------------------
128-- * Utils (Internal)
125-- * Utils (Internal)
@@ -132,50 +129,42 @@ instance ( AllMimeUnrender ctyps a, IsNonEmpty ctyps
132-- Check that all elements of list are instances of MimeRender
129-- Check that all elements of list are instances of MimeRender
133--------------------------------------------------------------------------
130--------------------------------------------------------------------------
134class AllMimeRender ls a where
131class AllMimeRender ls a where
135− amr :: Proxy ls
132+ allMimeRender :: Proxy ls
136− -> a -- value to serialize
133+ -> a -- value to serialize
137− -> [(M.MediaType, ByteString)] -- content-types/response pairs
134+ -> [(M.MediaType, ByteString)] -- content-types/response pairs
138
135
139instance ( MimeRender ctyp a ) => AllMimeRender '[ctyp] a where
136instance ( MimeRender ctyp a ) => AllMimeRender '[ctyp] a where
140− amr _ a = [(contentType pctyp, toByteString pctyp a)]
137+ allMimeRender _ a = [(contentType pctyp, toByteString pctyp a)]
141 where pctyp = Proxy :: Proxy ctyp
138 where pctyp = Proxy :: Proxy ctyp
142
139
143instance ( MimeRender ctyp a
140instance ( MimeRender ctyp a
144− , MimeRender ctyp' a -- at least two elems to avoid overlap
141+ , AllMimeRender (ctyp' ': ctyps) a
145− , AllMimeRender ctyps a
146 ) => AllMimeRender (ctyp ': ctyp' ': ctyps) a where
142 ) => AllMimeRender (ctyp ': ctyp' ': ctyps) a where
147− amr _ a = (contentType pctyp, toByteString pctyp a)
143+ allMimeRender _ a = (contentType pctyp, toByteString pctyp a)
148− :(contentType pctyp', toByteString pctyp' a)
149− :(amr pctyps a)
144+ :(allMimeRender pctyps a)
150 where pctyp = Proxy :: Proxy ctyp
145 where pctyp = Proxy :: Proxy ctyp
151− pctyps = Proxy :: Proxy ctyps
146+ pctyps = Proxy :: Proxy (ctyp' ': ctyps)
152− pctyp' = Proxy :: Proxy ctyp'
153
147
154
148
155instance AllMimeRender '[] a where
149instance AllMimeRender '[] a where
156− amr _ _ = []
150+ allMimeRender _ _ = []
157
151
158--------------------------------------------------------------------------
152--------------------------------------------------------------------------
159-- Check that all elements of list are instances of MimeUnrender
153-- Check that all elements of list are instances of MimeUnrender
160--------------------------------------------------------------------------
154--------------------------------------------------------------------------
161class AllMimeUnrender ls a where
155class AllMimeUnrender ls a where
162− amu :: Proxy ls -> ByteString -> [(M.MediaType, Maybe a)]
156+ allMimeUnrender :: Proxy ls -> ByteString -> [(M.MediaType, Either String a)]
163
157
164−instance ( MimeUnrender ctyp a ) => AllMimeUnrender '[ctyp] a where
158+instance AllMimeUnrender '[] a where
165− amu _ val = [(contentType pctyp, fromByteString pctyp val)]
159+ allMimeUnrender _ _ = []
166− where pctyp = Proxy :: Proxy ctyp
167
160
168instance ( MimeUnrender ctyp a
161instance ( MimeUnrender ctyp a
169− , MimeUnrender ctyp' a
170 , AllMimeUnrender ctyps a
162 , AllMimeUnrender ctyps a
171− ) => AllMimeUnrender (ctyp ': ctyp' ': ctyps) a where
163+ ) => AllMimeUnrender (ctyp ': ctyps) a where
172− amu _ val = (contentType pctyp, fromByteString pctyp val)
164+ allMimeUnrender _ val = (contentType pctyp, fromByteString pctyp val)
173− :(contentType pctyp', fromByteString pctyp' val)
174− :(amu pctyps val)
165+ :(allMimeUnrender pctyps val)
175 where pctyp = Proxy :: Proxy ctyp
166 where pctyp = Proxy :: Proxy ctyp
176 pctyps = Proxy :: Proxy ctyps
167 pctyps = Proxy :: Proxy ctyps
177− pctyp' = Proxy :: Proxy ctyp'
178
168
179type family IsNonEmpty (ls::[*]) :: Constraint where
169type family IsNonEmpty (ls::[*]) :: Constraint where
180− IsNonEmpty '[] = 'False ~ 'True
170+ IsNonEmpty (x ': xs) = ()
181− IsNonEmpty x = ()
src/Servant/API/Get.hs+1−1
@@ -10,5 +10,5 @@ import Data.Typeable ( Typeable )
10-- Example:
10-- Example:
11--
11--
12-- > type MyApi = "books" :> Get '[JSON] [Book]
12-- > type MyApi = "books" :> Get '[JSON] [Book]
13−data Get (cts::[*]) a
13+data Get (contentTypes::[*]) a
14 deriving Typeable
14 deriving Typeable
src/Servant/API/Patch.hs+5−3
@@ -1,4 +1,6 @@
1{-# LANGUAGE DeriveDataTypeable #-}
1{-# LANGUAGE DeriveDataTypeable #-}
2+{-# LANGUAGE DataKinds #-}
3+{-# LANGUAGE KindSignatures #-}
2module Servant.API.Patch where
4module Servant.API.Patch where
3
5
4import Data.Typeable ( Typeable )
6import Data.Typeable ( Typeable )
@@ -11,9 +13,9 @@ import Data.Typeable ( Typeable )
11--
13--
12-- Example:
14-- Example:
13--
15--
14−-- > -- POST /books
16+-- > -- PATCH /books
15-- > -- with a JSON encoded Book as the request body
17-- > -- with a JSON encoded Book as the request body
16-- > -- returning the just-created Book
18-- > -- returning the just-created Book
17−-- > type MyApi = "books" :> ReqBody Book :> Post Book
19+-- > type MyApi = "books" :> ReqBody Book :> Patch '[JSON] Book
18−data Patch a
20+data Patch (contentTypes::[*]) a
19 deriving Typeable
21 deriving Typeable
src/Servant/API/Post.hs+1−1
@@ -15,5 +15,5 @@ import Data.Typeable ( Typeable )
15-- > -- with a JSON encoded Book as the request body
15-- > -- with a JSON encoded Book as the request body
16-- > -- returning the just-created Book
16-- > -- returning the just-created Book
17-- > type MyApi = "books" :> ReqBody Book :> Post '[JSON] Book
17-- > type MyApi = "books" :> ReqBody Book :> Post '[JSON] Book
18−data Post (cts::[*]) a
18+data Post (contentTypes::[*]) a
19 deriving Typeable
19 deriving Typeable
src/Servant/API/Put.hs+1−1
@@ -13,5 +13,5 @@ import Data.Typeable ( Typeable )
13-- > -- PUT /books/:isbn
13-- > -- PUT /books/:isbn
14-- > -- with a Book as request body, returning the updated Book
14-- > -- with a Book as request body, returning the updated Book
15-- > type MyApi = "books" :> Capture "isbn" Text :> ReqBody Book :> Put '[JSON] Book
15-- > type MyApi = "books" :> Capture "isbn" Text :> ReqBody Book :> Put '[JSON] Book
16−data Put (cts::[*]) a
16+data Put (contentTypes::[*]) a
17 deriving Typeable
17 deriving Typeable
src/Servant/API/ReqBody.hs+1−1
@@ -8,4 +8,4 @@ module Servant.API.ReqBody where
8--
8--
9-- > -- POST /books
9-- > -- POST /books
10-- > type MyApi = "books" :> ReqBody '[JSON] Book :> Post Book
10-- > type MyApi = "books" :> ReqBody '[JSON] Book :> Post Book
11−data ReqBody (ls::[*]) a
11+data ReqBody (contentTypes::[*]) a
src/Servant/Utils/Links.hs−1
@@ -180,7 +180,6 @@ type family IsSubList a b :: Constraint where
180 IsSubList '[x] (x ': xs) = ()
180 IsSubList '[x] (x ': xs) = ()
181 IsSubList '[x] (y ': ys) = IsSubList '[x] ys
181 IsSubList '[x] (y ': ys) = IsSubList '[x] ys
182 IsSubList (x ': xs) y = IsSubList '[x] y `And` IsSubList xs y
182 IsSubList (x ': xs) y = IsSubList '[x] y `And` IsSubList xs y
183− IsSubList a b = 'True ~ 'False
184
183
185-- Phantom types for Param
184-- Phantom types for Param
186data Matrix
185data Matrix