on develop help sign in
Correctly rendering alt=media vs uploadType=multipart query parameters
commit400d2f9dc588f94d5603a3fe2f5506138ef5d2e7 authorBrendan Hay <brendan.g.hay@gmail.com> dateFri 10 Jun 2016, 16:13 (10 years ago) parent16de6ce
3 files changed+13−22
gen/src/Gen/Syntax.hs+4−5 gen/src/Gen/Types/Id.hs+8−4 gen/src/Gen/Types/Map.hs+1−13
gen/src/Gen/Syntax.hs+4−5
@@ -106,9 +106,8 @@ uploadAlias sub m
106106
107107 media = case _mRequest m of
108108 Just b ->
109− TyApp (TyApp (TyApp (TyCon "MultipartRelated") jsonMedia)
110− (tycon (ref b)))
111− (TyCon "RequestBody")
109+ TyApp (TyApp (TyCon "MultipartRelated") jsonMedia)
110+ (tycon (ref b))
112111
113112 Nothing ->
114113 TyApp (TyApp (TyCon "ReqBody") streamMedia)
@@ -185,7 +184,7 @@ altParam =
185184uploadParam :: Type
186185uploadParam =
187186 TyApp (TyApp (TyCon "QueryParam") (sing "uploadType"))
188− (TyCon "AltMedia")
187+ (TyCon "Multipart")
189188
190189metadataPat, downloadPat, uploadPat :: Method a -> Pat
191190metadataPat = pattern 1
@@ -258,7 +257,7 @@ uploadDecl n pre api url fs m =
258257
259258 extras = maybeToList alt ++ [upl] ++ payload ++ [var media]
260259 where
261− upl = app (var "Just") (var "AltMedia")
260+ upl = app (var "Just") (var "Multipart")
262261 alt = app (var "Just") . var . name . Text.unpack . alternate <$>
263262 (Map.lookup "alt" (_mParameters m) >>= view iDefault)
264263
gen/src/Gen/Types/Id.hs+8−4
@@ -58,10 +58,12 @@ import Control.Applicative
5858import Control.Monad
5959import Data.Aeson hiding (Bool, String)
6060import qualified Data.Attoparsec.Text as A
61+import Data.Bifunctor (first)
6162import qualified Data.CaseInsensitive as CI
6263import Data.Foldable (foldl')
6364import Data.Function (on)
6465import Data.Hashable
66+import qualified Data.HashMap.Strict as Map
6567import Data.List (intersperse)
6668import Data.List (elemIndex, nub, sortOn)
6769import Data.Semigroup hiding (Sum)
@@ -165,8 +167,9 @@ instance FromJSON Global where
165167instance ToJSON Global where
166168 toJSON = toJSON . global
167169
168−instance TextKey Global where
169− toKey = mkGlobal
170+instance FromJSON v => FromJSON (Map Global v) where
171+ parseJSON = fmap (Map.fromList . map (first mkGlobal) . Map.toList)
172+ . parseJSON
170173
171174gid :: Format a (Global -> a)
172175gid = later (Build.fromText . global)
@@ -174,8 +177,9 @@ gid = later (Build.fromText . global)
174177newtype Local = Local { local :: Text }
175178 deriving (Eq, Ord, Show, Generic, Hashable, FromJSON, ToJSON, IsString)
176179
177−instance TextKey Local where
178− toKey = Local
180+instance FromJSON v => FromJSON (Map Local v) where
181+ parseJSON = fmap (Map.fromList . map (first Local) . Map.toList)
182+ . parseJSON
179183
180184lid :: Format a (Local -> a)
181185lid = later (Build.fromText . local)
gen/src/Gen/Types/Map.hs+1−13
@@ -1,7 +1,4 @@
1−{-# LANGUAGE FlexibleInstances #-}
2−
3−
4− -- Module : Gen.Types.Map
1+-- Module : Gen.Types.Map
52-- Copyright : (c) 2013-2015 Brendan Hay
63-- License : This Source Code Form is subject to the terms of
74-- the Mozilla Public License, v. 2.0.
@@ -14,8 +11,6 @@
1411module Gen.Types.Map where
1512
1613import Control.Lens
17−import Data.Aeson
18−import Data.Bifunctor
1914import Data.Hashable
2015import qualified Data.HashMap.Strict as Map
2116import Data.Maybe
@@ -35,10 +30,3 @@ kvTraverseMaybe :: (Applicative f, Eq k, Hashable k)
3530 -> f (Map k b)
3631kvTraverseMaybe f = fmap (Map.map fromJust . Map.filter isJust)
3732 . Map.traverseWithKey f
38−
39−class (Hashable a, Eq a) => TextKey a where
40− toKey :: Text -> a
41−
42−instance (TextKey k, FromJSON v) => FromJSON (Map k v) where
43− parseJSON = fmap (Map.fromList . map (first toKey) . Map.toList)
44− . parseJSON