git.iko.soy/gogol
on develop help sign in
Adding concept of repeated path parameters
d71bad1Brendan Hay
core/src/Network/Google/Data/JSON.hs+16−2
compare with develop
unifiedsplit
@@ -10,9 +10,23 @@
10-- Stability : provisional
10-- Stability : provisional
11-- Portability : non-portable (GHC extensions)
11-- Portability : non-portable (GHC extensions)
12--
12--
13−module Network.Google.Data.JSON where
13+module Network.Google.Data.JSON
14+ ( module Network.Google.Data.JSON
14
15
16+ , FromJSON (..)
17+ , ToJSON (..)
18+
19+ , Value (Object)
20+ , withObject
21+ , object
22+
23+ , (.=)
24+ , (.:)
25+ , (.:?)
26+ , (.!=)
27+ ) where
28+
15−import Control.Lens
29+import Control.Lens hiding ((.=))
16import Data.Aeson
30import Data.Aeson
17import Data.Aeson.Types
31import Data.Aeson.Types
18import Servant.API
32import Servant.API
core/src/Network/Google/Prelude.hs+67−13
@@ -2,8 +2,11 @@
2{-# LANGUAGE DeriveDataTypeable #-}
2{-# LANGUAGE DeriveDataTypeable #-}
3{-# LANGUAGE DeriveGeneric #-}
3{-# LANGUAGE DeriveGeneric #-}
4{-# LANGUAGE FlexibleContexts #-}
4{-# LANGUAGE FlexibleContexts #-}
5+{-# LANGUAGE FlexibleInstances #-}
5{-# LANGUAGE GeneralizedNewtypeDeriving #-}
6{-# LANGUAGE GeneralizedNewtypeDeriving #-}
7+{-# LANGUAGE MultiParamTypeClasses #-}
6{-# LANGUAGE OverloadedStrings #-}
8{-# LANGUAGE OverloadedStrings #-}
9+{-# LANGUAGE ScopedTypeVariables #-}
7{-# LANGUAGE TypeFamilies #-}
10{-# LANGUAGE TypeFamilies #-}
8{-# LANGUAGE TypeOperators #-}
11{-# LANGUAGE TypeOperators #-}
9
12
@@ -21,50 +24,57 @@ module Network.Google.Prelude
21 ) where
24 ) where
22
25
23import Control.Lens as Export (Lens', lens, mapping,
26import Control.Lens as Export (Lens', lens, mapping,
24− _Just)
27+ (^.), _Just)
25import Control.Lens hiding (coerce)
28import Control.Lens hiding (coerce)
26import Control.Monad.Trans.Either as Export (EitherT)
29import Control.Monad.Trans.Either as Export (EitherT)
27−import Data.Aeson as Export
28import Data.Coerce
30import Data.Coerce
29import Data.Data as Export (Data, Typeable)
31import Data.Data as Export (Data, Typeable)
30import Data.Hashable as Export
32import Data.Hashable as Export
31import Data.Int as Export (Int32, Int64)
33import Data.Int as Export (Int32, Int64)
32import Data.Maybe as Export
34import Data.Maybe as Export
35+import Data.Monoid
33import Data.Proxy as Export
36import Data.Proxy as Export
34import Data.Text as Export (Text)
37import Data.Text as Export (Text)
38+import qualified Data.Text as Text
35−import Data.Time as Export (UTCTime)
39+import Data.Time as Export
36import Data.Word as Export (Word32, Word64, Word8)
40import Data.Word as Export (Word32, Word64, Word8)
37import GHC.Generics as Export (Generic)
41import GHC.Generics as Export (Generic)
42+import GHC.TypeLits
38import Network.Google.Data.JSON as Export
43import Network.Google.Data.JSON as Export
39import Network.Google.Data.Numeric as Export
44import Network.Google.Data.Numeric as Export
40−import Network.HTTP.Media
45+-- import Network.HTTP.Media
41import Numeric.Natural as Export (Natural)
46import Numeric.Natural as Export (Natural)
42import Servant.API as Export
47import Servant.API as Export
43import Servant.Client as Export
48import Servant.Client as Export
44import Servant.Common.Req as Export (Req, defReq)
49import Servant.Common.Req as Export (Req, defReq)
50+import Servant.Common.Req (appendToPath)
45import Servant.Utils.Links as Export
51import Servant.Utils.Links as Export
46
52
47_Coerce :: (Coercible a b, Coercible b a) => Iso' a b
53_Coerce :: (Coercible a b, Coercible b a) => Iso' a b
48_Coerce = iso coerce coerce
54_Coerce = iso coerce coerce
49
55
50−-- | Invalid Iso, should be a Prism but exists for ease of composition
56+-- | Invalid Iso, exists for ease of composition with the current 'Lens . Iso'
51−-- with the current 'Lens . Iso' chaining to hide internal types from the user.
57+-- chaining to hide internal types from the user.
52_Default :: Monoid a => Iso' (Maybe a) a
58_Default :: Monoid a => Iso' (Maybe a) a
53_Default = iso f Just
59_Default = iso f Just
54 where
60 where
55 f (Just x) = x
61 f (Just x) = x
56 f Nothing = mempty
62 f Nothing = mempty
57
63
58−newtype Time' = Time' Text
64+_Time = undefined
59− deriving (Eq, Ord, Show, Read, Generic, Data, Typeable, ToText, FromText)
65+_Date = undefined
66+_DateTime = undefined
60
67
61−newtype Date' = Date' Text
68+newtype Time' = Time' Text -- TimeOfDay
62− deriving (Eq, Ord, Show, Read, Generic, Data, Typeable, ToText, FromText)
69+ deriving (Eq, Ord, Show, Read, Generic, Data, Typeable, FromText, ToText, FromJSON, ToJSON)
63
70
71+newtype Date' = Date' Text -- LocalTime
72+ deriving (Eq, Ord, Show, Read, Generic, Data, Typeable, FromText, ToText, FromJSON, ToJSON)
73+
64−newtype DateTime' = DateTime' Text
74+newtype DateTime' = DateTime' Text -- UTCTime
65− deriving (Eq, Ord, Show, Read, Generic, Data, Typeable, ToText, FromText)
75+ deriving (Eq, Ord, Show, Read, Generic, Data, Typeable, FromText, ToText, FromJSON, ToJSON)
66
76
67−data AltJSON = AltJSON
77+data AltJSON = AltJSON
68 deriving (Eq, Ord, Show, Read, Generic, Data, Typeable)
78 deriving (Eq, Ord, Show, Read, Generic, Data, Typeable)
69
79
70instance ToText AltJSON where
80instance ToText AltJSON where
@@ -105,8 +115,52 @@ instance GoogleAuth a => GoogleAuth (Download a) where
105data Body = Body -- MediaType
115data Body = Body -- MediaType
106 deriving (Eq, Show, Generic, Data, Typeable)
116 deriving (Eq, Show, Generic, Data, Typeable)
107
117
118+data Captures (capture :: Symbol) a
119+ deriving (Typeable)
120+
121+instance (KnownSymbol capture, ToText a, HasClient sublayout)
122+ => HasClient (Captures capture a :> sublayout) where
123+ type Client (Captures capture a :> sublayout) = [a] -> Client sublayout
124+
125+ clientWithRoute Proxy req baseUrl xs =
126+ clientWithRoute (Proxy :: Proxy sublayout) (appendToPath vs req) baseUrl
127+ where
128+ vs = Text.unpack $ Text.intercalate "/" (map toText xs)
129+
130+data CaptureMode (capture :: Symbol) (mode :: Symbol) a
131+ deriving (Typeable)
132+
133+instance (KnownSymbol capture, KnownSymbol mode, ToText a, HasClient sublayout)
134+ => HasClient (CaptureMode capture mode a :> sublayout) where
135+ type Client (CaptureMode capture mode a :> sublayout) = a -> Client sublayout
136+
137+ clientWithRoute Proxy req baseUrl val =
138+ clientWithRoute (Proxy :: Proxy sublayout) (appendToPath p req) baseUrl
139+ where
140+ p = Text.unpack (toText val) <> m
141+ m = symbolVal (Proxy :: Proxy mode)
142+
143+instance MimeUnrender OctetStream Body
108
144
109data MultipartRelated (metatypes :: [*]) meta media
145data MultipartRelated (metatypes :: [*]) meta media
146+ deriving (Typeable)
147+
148+instance (MimeUnrender ct a, HasClient sublayout)
149+ => HasClient (MultipartRelated (ct ': cts) a b :> sublayout) where
150+
151+ type Client (MultipartRelated (ct ': cts) a b :> sublayout) =
152+ a -> b -> Client sublayout
153+
154+ clientWithRoute Proxy req baseurl meta media = undefined
155+
156+ -- clientWithRoute (Proxy :: Proxy sublayout)
157+ -- (let ctProxy = Proxy :: Proxy ct
158+ -- in setRQBody (mimeRender ctProxy body)
159+ -- (contentType ctProxy)
160+ -- req
161+ -- )
162+ -- baseurl
163+
110
164
111-- IsElem sa (ReqBody y x :> sb) = IsElem sa sb
165-- IsElem sa (ReqBody y x :> sb) = IsElem sa sb
112
166
gen/src/Gen/Syntax.hs+5
@@ -71,6 +71,11 @@ verbAlias n m
71 Nothing -> error $ "Unable to find path parameter " ++ show l
71 Nothing -> error $ "Unable to find path parameter " ++ show l
72 Just x ->
72 Just x ->
73 case c of
73 case c of
74+ Nothing | x ^. iRepeated ->
75+ TyApp (TyApp (TyCon "Captures")
76+ (sing (local l)))
77+ (terminalType (_type (_pParam x)))
78+
74 Nothing ->
79 Nothing ->
75 TyApp (TyApp (TyCon "Capture")
80 TyApp (TyApp (TyCon "Capture")
76 (sing (local l)))
81 (sing (local l)))
gen/src/Gen/Types/Id.hs+17−13
@@ -4,7 +4,7 @@
4{-# LANGUAGE LambdaCase #-}
4{-# LANGUAGE LambdaCase #-}
5{-# LANGUAGE OverloadedStrings #-}
5{-# LANGUAGE OverloadedStrings #-}
6{-# LANGUAGE ScopedTypeVariables #-}
6{-# LANGUAGE ScopedTypeVariables #-}
7−{-# LANGUAGE ViewPatterns #-}
7+{-# LANGUAGE TupleSections #-}
8
8
9-- Module : Gen.Types.Id
9-- Module : Gen.Types.Id
10-- Copyright : (c) 2015 Brendan Hay
10-- Copyright : (c) 2015 Brendan Hay
@@ -51,7 +51,10 @@ module Gen.Types.Id
51 , pname
51 , pname
52 ) where
52 ) where
53
53
54+import Control.Applicative
55+import Control.Monad
54import Data.Aeson hiding (Bool, String)
56import Data.Aeson hiding (Bool, String)
57+import qualified Data.Attoparsec.Text as A
55import Data.CaseInsensitive (CI)
58import Data.CaseInsensitive (CI)
56import qualified Data.CaseInsensitive as CI
59import qualified Data.CaseInsensitive as CI
57import Data.Coerce
60import Data.Coerce
@@ -168,22 +171,23 @@ globalise :: Local -> Global
168globalise = Global . (:[]) . local
171globalise = Global . (:[]) . local
169
172
170extractPath :: Text -> [Either Text (Local, Maybe Text)]
173extractPath :: Text -> [Either Text (Local, Maybe Text)]
171−extractPath = map match . filter (not . Text.null) . Text.split (== '/')
174+extractPath = either (error . show) id . A.parseOnly path
172 where
175 where
173− match x =
176+ path = A.many1 (seg <|> repeat <|> var) <* A.endOfInput
174− case Text.uncons x of
175− Just (c, Text.dropWhile (== '+') -> t)
176− | c == '{' -> Right $
177− let y = toKey (Text.takeWhile (/= '}') t)
178− in case Text.dropWhile (/= ':') t of
179− "" -> (y, Nothing)
180− z -> (y, Just z)
181
177
182− -- Resource "editId" "commit"
178+ seg = fmap Left $
183− -- "path": "{packageName}/edits/{editId}:commit",
179+ optional (A.char '/') *> A.takeWhile1 (A.notInClass "/{+*}:")
184
180
185− _ -> Left x
181+ repeat = fmap Right $ do
182+ A.string "{/"
183+ (,Nothing) <$> fmap Local (A.takeWhile1 (/= '*'))
184+ <* A.string "*}"
186
185
186+ var = fmap Right $ do
187+ void $ optional (A.char '/') *> A.char '{'
188+ (,) <$> fmap Local (A.takeWhile1 (A.notInClass "/{+*}:"))
189+ <* A.char '}'
190+ <*> optional (A.char ':' *> A.takeWhile1 (A.notInClass "/{+*}:"))
187
191
188orderParams :: (a -> Local) -> [a] -> [Local] -> [a]
192orderParams :: (a -> Local) -> [a] -> [Local] -> [a]
189orderParams f xs ys = orderBy f zs (del zs [] ++ global)
193orderParams f xs ys = orderBy f zs (del zs [] ++ global)