on develop help sign in
Adding ghetto parameter ordering
cf863cdBrendan Hay
gen/src/Gen/Syntax.hs+4−4
@@ -77,9 +77,7 @@ verbAlias n m
77 (terminalType (_type (_pParam k)))
77 (terminalType (_type (_pParam k)))
78 | otherwise = sing x
78 | otherwise = sing x
79
79
80− -- FIXME: order by _mParameterOrder
81−-- qry :: [Type]
82− qry = mapMaybe f . Map.toList
80+ qry xs = mapMaybe f $ orderParams fst (Map.toList xs) (_mParameterOrder m)
83 where
81 where
84 f (k, x) =
82 f (k, x) =
85 let t = terminalType (_type (_pParam x))
83 let t = terminalType (_type (_pParam x))
@@ -154,7 +152,7 @@ googleRequestDecl :: Global
154 -> [Local]
152 -> [Local]
155 -> Method Solved
153 -> Method Solved
156 -> Decl
154 -> Decl
157−googleRequestDecl g n assoc alt p api url fs m =
155+googleRequestDecl g n assoc alt p api url fields m =
158 InstDecl noLoc Nothing [] [] (unqual "GoogleRequest") [n]
156 InstDecl noLoc Nothing [] [] (unqual "GoogleRequest") [n]
159 [ assoc
157 [ assoc
160 , request
158 , request
@@ -196,6 +194,8 @@ googleRequestDecl g n assoc alt p api url fs m =
196 (fs', rq) | Just r <- _mRequest m = let x = localise (ref r) in (delete x fs, Just x)
194 (fs', rq) | Just r <- _mRequest m = let x = localise (ref r) in (delete x fs, Just x)
197 | otherwise = (fs, Nothing)
195 | otherwise = (fs, Nothing)
198
196
197+ fs = orderParams id fields (_mParameterOrder m)
198+
199 pats = [pvar "r", pvar "u", prec]
199 pats = [pvar "r", pvar "u", prec]
200 prec = PRec (UnQual (dname g)) [PFieldWildcard]
200 prec = PRec (UnQual (dname g)) [PFieldWildcard]
201
201
gen/src/Gen/Types/Id.hs+31
@@ -3,6 +3,7 @@
3{-# LANGUAGE GeneralizedNewtypeDeriving #-}
3{-# LANGUAGE GeneralizedNewtypeDeriving #-}
4{-# LANGUAGE LambdaCase #-}
4{-# LANGUAGE LambdaCase #-}
5{-# LANGUAGE OverloadedStrings #-}
5{-# LANGUAGE OverloadedStrings #-}
6+{-# LANGUAGE ScopedTypeVariables #-}
6
7
7-- Module : Gen.Types.Id
8-- Module : Gen.Types.Id
8-- Copyright : (c) 2015 Brendan Hay
9-- Copyright : (c) 2015 Brendan Hay
@@ -30,6 +31,8 @@ module Gen.Types.Id
30
31
31 , reference
32 , reference
32
33
34+ , orderParams
35+
33 -- * Naming
36 -- * Naming
34 , aname
37 , aname
35 , mname
38 , mname
@@ -44,8 +47,12 @@ module Gen.Types.Id
44 ) where
47 ) where
45
48
46import Data.Aeson hiding (Bool, String)
49import Data.Aeson hiding (Bool, String)
50+import Data.CaseInsensitive (CI)
47import qualified Data.CaseInsensitive as CI
51import qualified Data.CaseInsensitive as CI
52+import Data.Coerce
53+import Data.Foldable (foldl')
48import Data.Hashable
54import Data.Hashable
55+import Data.List (elemIndex, sortOn)
49import Data.Semigroup hiding (Sum)
56import Data.Semigroup hiding (Sum)
50import Data.String
57import Data.String
51import Data.Text (Text)
58import Data.Text (Text)
@@ -146,3 +153,27 @@ reference (Global g) (Local l) = Global (g <> Text.split (== '.') l)
146
153
147localise :: Global -> Local
154localise :: Global -> Local
148localise = Local . global
155localise = Local . global
156+
157+orderParams :: (a -> Local) -> [a] -> [Local] -> [a]
158+orderParams f xs ys = orderBy f zs (del zs [] ++ global)
159+ where
160+ zs = orderBy f (sortOn f xs) ys
161+
162+ del _ [] = []
163+ del [] rs = reverse rs
164+ del (r:qs) rs
165+ | f r `elem` global = del qs rs
166+ | otherwise = del qs (f r:rs)
167+
168+ global =
169+ [ "quotaUser"
170+ , "prettyPrint"
171+ , "userIp"
172+ , "fields"
173+ , "key"
174+ , "oauth_token"
175+ , "alt"
176+ ]
177+
178+orderBy :: Eq b => (a -> b) -> [a] -> [b] -> [a]
179+orderBy g xs ys = sortOn (flip elemIndex ys . g) xs