@@ -11,7 +11,6 @@
1111{-# LANGUAGE UndecidableInstances #-}
1212module Servant.API.ContentTypes where
1313
14−import Control.Monad (join)
1514import qualified Data.ByteString as BS
1615import Data.ByteString.Lazy (ByteString)
1716import Data.String.Conversions (cs)
@@ -102,27 +101,25 @@ instance ( AllMimeRender ctyps a, IsNonEmpty ctyps
102101 ) => AllCTRender ctyps a where
103102 handleAcceptH _ (AcceptHeader accept) val = M.mapAcceptMedia lkup accept
104103 where pctyps = Proxy :: Proxy ctyps
105− amrs = amr pctyps val
106− lkup = zip (map fst amrs) $ map (\(a,b) -> (cs $ show a, b)) amrs
107−
108−
104+ amrs = allMimeRender pctyps val
105+ lkup = fmap (\(a,b) -> (a, (cs $ show a, b))) amrs
109106
110107
111108--------------------------------------------------------------------------
112109-- * Unrender
113110class Accept ctype => MimeUnrender ctype a where
114− fromByteString :: Proxy ctype -> ByteString -> Maybe a
111+ fromByteString :: Proxy ctype -> ByteString -> Either String a
115112
116113class AllCTUnrender list a where
117114 handleCTypeH :: Proxy list
118115 -> ByteString -- Content-Type header
119116 -> ByteString -- Request body
120− -> Maybe a
117+ -> Maybe (Either String a)
121118
122119instance ( AllMimeUnrender ctyps a, IsNonEmpty ctyps
123120 ) => AllCTUnrender ctyps a where
124− handleCTypeH _ ctypeH body = join $ M.mapContentMedia lkup (cs ctypeH)
125− where lkup = amu (Proxy :: Proxy ctyps) body
121+ handleCTypeH _ ctypeH body = M.mapContentMedia lkup (cs ctypeH)
122+ where lkup = allMimeUnrender (Proxy :: Proxy ctyps) body
126123
127124--------------------------------------------------------------------------
128125-- * Utils (Internal)
@@ -132,50 +129,42 @@ instance ( AllMimeUnrender ctyps a, IsNonEmpty ctyps
132129-- Check that all elements of list are instances of MimeRender
133130--------------------------------------------------------------------------
134131class AllMimeRender ls a where
135− amr :: Proxy ls
136− -> a -- value to serialize
137− -> [(M.MediaType, ByteString)] -- content-types/response pairs
132+ allMimeRender :: Proxy ls
133+ -> a -- value to serialize
134+ -> [(M.MediaType, ByteString)] -- content-types/response pairs
138135
139136instance ( MimeRender ctyp a ) => AllMimeRender '[ctyp] a where
140− amr _ a = [(contentType pctyp, toByteString pctyp a)]
137+ allMimeRender _ a = [(contentType pctyp, toByteString pctyp a)]
141138 where pctyp = Proxy :: Proxy ctyp
142139
143140instance ( MimeRender ctyp a
144− , MimeRender ctyp' a -- at least two elems to avoid overlap
145− , AllMimeRender ctyps a
141+ , AllMimeRender (ctyp' ': ctyps) a
146142 ) => AllMimeRender (ctyp ': ctyp' ': ctyps) a where
147− amr _ a = (contentType pctyp, toByteString pctyp a)
148− :(contentType pctyp', toByteString pctyp' a)
149− :(amr pctyps a)
143+ allMimeRender _ a = (contentType pctyp, toByteString pctyp a)
144+ :(allMimeRender pctyps a)
150145 where pctyp = Proxy :: Proxy ctyp
151− pctyps = Proxy :: Proxy ctyps
152− pctyp' = Proxy :: Proxy ctyp'
146+ pctyps = Proxy :: Proxy (ctyp' ': ctyps)
153147
154148
155149instance AllMimeRender '[] a where
156− amr _ _ = []
150+ allMimeRender _ _ = []
157151
158152--------------------------------------------------------------------------
159153-- Check that all elements of list are instances of MimeUnrender
160154--------------------------------------------------------------------------
161155class AllMimeUnrender ls a where
162− amu :: Proxy ls -> ByteString -> [(M.MediaType, Maybe a)]
156+ allMimeUnrender :: Proxy ls -> ByteString -> [(M.MediaType, Either String a)]
163157
164−instance ( MimeUnrender ctyp a ) => AllMimeUnrender '[ctyp] a where
165− amu _ val = [(contentType pctyp, fromByteString pctyp val)]
166− where pctyp = Proxy :: Proxy ctyp
158+instance AllMimeUnrender '[] a where
159+ allMimeUnrender _ _ = []
167160
168161instance ( MimeUnrender ctyp a
169− , MimeUnrender ctyp' a
170162 , AllMimeUnrender ctyps a
171− ) => AllMimeUnrender (ctyp ': ctyp' ': ctyps) a where
172− amu _ val = (contentType pctyp, fromByteString pctyp val)
173− :(contentType pctyp', fromByteString pctyp' val)
174− :(amu pctyps val)
163+ ) => AllMimeUnrender (ctyp ': ctyps) a where
164+ allMimeUnrender _ val = (contentType pctyp, fromByteString pctyp val)
165+ :(allMimeUnrender pctyps val)
175166 where pctyp = Proxy :: Proxy ctyp
176167 pctyps = Proxy :: Proxy ctyps
177− pctyp' = Proxy :: Proxy ctyp'
178168
179169type family IsNonEmpty (ls::[*]) :: Constraint where
180− IsNonEmpty '[] = 'False ~ 'True
181− IsNonEmpty x = ()
170+ IsNonEmpty (x ': xs) = ()