c7d5b60 · gogol · git.iko.soy

git.iko.soy/gogol

on develop help sign in

Replacing library usage of Common.Servant.Text

c7d5b60Brendan Hay10 years ago

core/src/Network/Google/Data/JSON.hs+23−12

compare with develop

unifiedsplit

@@ -37,28 +37,39 @@ import Data.Data

37import Data.HashMap.Strict (HashMap)

38import Data.Text (Text)

39import qualified Data.Text as Text

40−import Servant.API

40+import Web.HttpApiData (FromHttpApiData (..), ToHttpApiData (..))

42type JSONValue = Value

44newtype Textual a = Textual a

45− deriving (Eq, Ord, Read, Show, Num, Fractional, Data, Typeable, FromText, ToText)

45+ deriving

46+ ( Eq

47+ , Ord

48+ , Read

49+ , Show

50+ , Num

51+ , Fractional

52+ , Data

53+ , Typeable

54+ , ToHttpApiData

55+ , FromHttpApiData

56+ )

47−instance (FromJSON a, FromText a) => FromJSON (Textual a) where

58+instance (FromJSON a, FromHttpApiData a) => FromJSON (Textual a) where

48 parseJSON (String s) =

59 parseJSON (String s) =

49− case fromText s of

60+ either (fail . Text.unpack) (pure . Textual) (parseQueryParam s)

50− Just x -> pure (Textual x)

51− Nothing -> fail $ "Failed to parse value from " ++ Text.unpack s

52 parseJSON o = Textual <$> parseJSON o

61 parseJSON o = Textual <$> parseJSON o

54−instance ToText a => ToJSON (Textual a) where

63+instance ToHttpApiData a => ToJSON (Textual a) where

55− toJSON (Textual x) = String (toText x)

64+ toJSON (Textual x) = String (toQueryParam x)

57parseJSONObject :: FromJSON a => HashMap Text Value -> Parser a

66parseJSONObject :: FromJSON a => HashMap Text Value -> Parser a

58parseJSONObject = parseJSON . Object

67parseJSONObject = parseJSON . Object

60−parseJSONText :: FromText a => String -> Value -> Parser a

69+parseJSONText :: FromHttpApiData a => String -> Value -> Parser a

61−parseJSONText n = withText n (maybe (fail n) pure . fromText)

70+parseJSONText n = withText n (either (fail . f) pure . parseQueryParam)

71+ where

72+ f x = n ++ " - " ++ Text.unpack x

63−toJSONText :: ToText a => a -> Value

74+toJSONText :: ToHttpApiData a => a -> Value

64−toJSONText = String . toText

75+toJSONText = String . toQueryParam

core/src/Network/Google/Prelude.hs+2

@@ -32,3 +32,5 @@ import Numeric.Natural as Export (Natural)

32import Prelude as Export hiding (product)

33import Servant.API as Export hiding (getResponse)

34import Servant.Utils.Links as Export hiding (Link)

35+import Web.HttpApiData as Export (FromHttpApiData (..),

36+ ToHttpApiData (..))

core/src/Network/Google/Types.hs+41−40

@@ -54,12 +54,13 @@ import Network.HTTP.Media hiding (Accept)

54import Network.HTTP.Types hiding (Header)

55import qualified Network.HTTP.Types as HTTP

56import Servant.API

57+import Web.HttpApiData

58data AltJSON = AltJSON deriving (Eq, Ord, Show, Read, Generic, Typeable)

59data AltJSON = AltJSON deriving (Eq, Ord, Show, Read, Generic, Typeable)

59data AltMedia = AltMedia deriving (Eq, Ord, Show, Read, Generic, Typeable)

60data AltMedia = AltMedia deriving (Eq, Ord, Show, Read, Generic, Typeable)

61−instance ToText AltJSON where toText = const "json"

62+instance ToHttpApiData AltJSON where toQueryParam = const "json"

62−instance ToText AltMedia where toText = const "multipart"

63+instance ToHttpApiData AltMedia where toQueryParam = const "multipart"

64newtype OAuthScope = OAuthScope Text

65newtype OAuthScope = OAuthScope Text

65 deriving

66 deriving

@@ -70,8 +71,8 @@ newtype OAuthScope = OAuthScope Text

70 , IsString

71 , IsString

71 , Generic

72 , Generic

72 , Typeable

73 , Typeable

73− , FromText

74+ , FromHttpApiData

74− , ToText

75+ , ToHttpApiData

75 , FromJSON

76 , FromJSON

76 , ToJSON

77 , ToJSON

77 )

78 )

@@ -85,8 +86,8 @@ newtype AccessToken = AccessToken Text

85 , IsString

86 , IsString

86 , Generic

87 , Generic

87 , Typeable

88 , Typeable

88− , FromText

89+ , FromHttpApiData

89− , ToText

90+ , ToHttpApiData

90 , FromJSON

91 , FromJSON

91 , ToJSON

92 , ToJSON

92 )

93 )

@@ -100,8 +101,8 @@ newtype RefreshToken = RefreshToken Text

100 , IsString

101 , IsString

101 , Generic

102 , Generic

102 , Typeable

103 , Typeable

103− , FromText

104+ , FromHttpApiData

104− , ToText

105+ , ToHttpApiData

105 , FromJSON

106 , FromJSON

106 , ToJSON

107 , ToJSON

107 )

108 )

@@ -115,8 +116,8 @@ newtype ClientId = ClientId Text

115 , IsString

116 , IsString

116 , Generic

117 , Generic

117 , Typeable

118 , Typeable

118− , FromText

119+ , FromHttpApiData

119− , ToText

120+ , ToHttpApiData

120 , FromJSON

121 , FromJSON

121 , ToJSON

122 , ToJSON

122 )

123 )

@@ -130,8 +131,8 @@ newtype Secret = Secret Text

130 , IsString

131 , IsString

131 , Generic

132 , Generic

132 , Typeable

133 , Typeable

133− , FromText

134+ , FromHttpApiData

134− , ToText

135+ , ToHttpApiData

135 , FromJSON

136 , FromJSON

136 , ToJSON

137 , ToJSON

137 )

138 )

@@ -145,8 +146,8 @@ newtype ServiceId = ServiceId Text

145 , IsString

146 , IsString

146 , Generic

147 , Generic

147 , Typeable

148 , Typeable

148− , FromText

149+ , FromHttpApiData

149− , ToText

150+ , ToHttpApiData

150 , FromJSON

151 , FromJSON

151 , ToJSON

152 , ToJSON

152 )

153 )

@@ -286,7 +287,7 @@ instance Monoid Request where

286appendPath :: Request -> Builder -> Request

287appendPath :: Request -> Builder -> Request

287appendPath rq x = rq { _rqPath = _rqPath rq <> "/" <> x }

288appendPath rq x = rq { _rqPath = _rqPath rq <> "/" <> x }

288

289

289−appendPaths :: ToText a => Request -> [a] -> Request

290+appendPaths :: ToHttpApiData a => Request -> [a] -> Request

290appendPaths rq = appendPath rq . foldMap (mappend "/" . buildText)

291appendPaths rq = appendPath rq . foldMap (mappend "/" . buildText)

291

292

292appendQuery :: Request -> ByteString -> Maybe Text -> Request

293appendQuery :: Request -> ByteString -> Maybe Text -> Request

@@ -437,9 +438,9 @@ instance (GoogleClient a, GoogleClient b) => GoogleClient (a :<|> b) where

437 buildClient (Proxy :: Proxy a) rq

438 buildClient (Proxy :: Proxy a) rq

438 :<|> buildClient (Proxy :: Proxy b) rq

439 :<|> buildClient (Proxy :: Proxy b) rq

439

440

440−instance ( KnownSymbol s

441+instance ( KnownSymbol s

441− , ToText a

442+ , ToHttpApiData a

442− , GoogleClient fn

443+ , GoogleClient fn

443 ) => GoogleClient (Capture s a :> fn) where

444 ) => GoogleClient (Capture s a :> fn) where

444 type Fn (Capture s a :> fn) = a -> Fn fn

445 type Fn (Capture s a :> fn) = a -> Fn fn

445

446

@@ -447,19 +448,19 @@ instance ( KnownSymbol s

447 . appendPath rq

448 . appendPath rq

448 . buildText

449 . buildText

449

450

450−instance ( KnownSymbol s

451+instance ( KnownSymbol s

451− , ToText a

452+ , ToHttpApiData a

452− , GoogleClient fn

453+ , GoogleClient fn

453 ) => GoogleClient (Captures s a :> fn) where

454 ) => GoogleClient (Captures s a :> fn) where

454 type Fn (Captures s a :> fn) = [a] -> Fn fn

455 type Fn (Captures s a :> fn) = [a] -> Fn fn

455

456

456 buildClient Proxy rq = buildClient (Proxy :: Proxy fn)

457 buildClient Proxy rq = buildClient (Proxy :: Proxy fn)

457 . appendPaths rq

458 . appendPaths rq

458

459

459−instance ( KnownSymbol s

460+instance ( KnownSymbol s

460− , KnownSymbol m

461+ , KnownSymbol m

461− , ToText a

462+ , ToHttpApiData a

462− , GoogleClient fn

463+ , GoogleClient fn

463 ) => GoogleClient (CaptureMode s m a :> fn) where

464 ) => GoogleClient (CaptureMode s m a :> fn) where

464 type Fn (CaptureMode s m a :> fn) = a -> Fn fn

465 type Fn (CaptureMode s m a :> fn) = a -> Fn fn

465

466

@@ -467,9 +468,9 @@ instance ( KnownSymbol s

467 . appendPath rq

468 . appendPath rq

468 $ buildText x <> buildSymbol (Proxy :: Proxy m)

469 $ buildText x <> buildSymbol (Proxy :: Proxy m)

469

470

470−instance ( KnownSymbol s

471+instance ( KnownSymbol s

471− , ToText a

472+ , ToHttpApiData a

472− , GoogleClient fn

473+ , GoogleClient fn

473 ) => GoogleClient (QueryParam s a :> fn) where

474 ) => GoogleClient (QueryParam s a :> fn) where

474 type Fn (QueryParam s a :> fn) = Maybe a -> Fn fn

475 type Fn (QueryParam s a :> fn) = Maybe a -> Fn fn

475

476

@@ -479,23 +480,23 @@ instance ( KnownSymbol s

479 Just x -> appendQuery rq k v

480 Just x -> appendQuery rq k v

480 where

481 where

481 k = byteSymbol (Proxy :: Proxy s)

482 k = byteSymbol (Proxy :: Proxy s)

482− v = Just (toText x)

483+ v = Just (toQueryParam x)

483

484

484−instance ( KnownSymbol s

485+instance ( KnownSymbol s

485− , ToText a

486+ , ToHttpApiData a

486− , GoogleClient fn

487+ , GoogleClient fn

487 ) => GoogleClient (QueryParams s a :> fn) where

488 ) => GoogleClient (QueryParams s a :> fn) where

488 type Fn (QueryParams s a :> fn) = [a] -> Fn fn

489 type Fn (QueryParams s a :> fn) = [a] -> Fn fn

489

490

490 buildClient Proxy rq = buildClient (Proxy :: Proxy fn) . foldl' go rq

491 buildClient Proxy rq = buildClient (Proxy :: Proxy fn) . foldl' go rq

491 where

492 where

492− go r = appendQuery r k . Just . toText

493+ go r = appendQuery r k . Just . toQueryParam

493

494

494 k = byteSymbol (Proxy :: Proxy s)

495 k = byteSymbol (Proxy :: Proxy s)

495

496

496−instance ( KnownSymbol s

497+instance ( KnownSymbol s

497− , ToText a

498+ , ToHttpApiData a

498− , GoogleClient fn

499+ , GoogleClient fn

499 ) => GoogleClient (Header s a :> fn) where

500 ) => GoogleClient (Header s a :> fn) where

500 type Fn (Header s a :> fn) = Maybe a -> Fn fn

501 type Fn (Header s a :> fn) = Maybe a -> Fn fn

501

502

@@ -505,7 +506,7 @@ instance ( KnownSymbol s

505 Just x -> appendHeader rq (CI.mk k) v

506 Just x -> appendHeader rq (CI.mk k) v

506 where

507 where

507 k = byteSymbol (Proxy :: Proxy s)

508 k = byteSymbol (Proxy :: Proxy s)

508− v = Just (toText x)

509+ v = Just (toQueryParam x)

509

510

510instance ( ToBody c a

511instance ( ToBody c a

511 , GoogleClient fn

512 , GoogleClient fn

@@ -573,7 +574,7 @@ instance {-# OVERLAPPABLE #-}

573 buildClient Proxy = mime (Proxy :: Proxy c) methodDelete [200, 202]

574 buildClient Proxy = mime (Proxy :: Proxy c) methodDelete [200, 202]

574

575

575instance {-# OVERLAPPING #-}

576instance {-# OVERLAPPING #-}

576− GoogleClient (Delete (c ': cs) ()) where

577+ GoogleClient (Delete (c ': cs) ()) where

577 type Fn (Delete (c ': cs) ()) = ServiceConfig -> Client ()

578 type Fn (Delete (c ': cs) ()) = ServiceConfig -> Client ()

578

579

579 buildClient Proxy = discard methodDelete [204]

580 buildClient Proxy = discard methodDelete [204]

@@ -581,8 +582,8 @@ instance {-# OVERLAPPING #-}

581sinkLBS :: Stream -> ResourceT IO LBS.ByteString

582sinkLBS :: Stream -> ResourceT IO LBS.ByteString

582sinkLBS = fmap LBS.fromChunks . ($$+- CL.consume)

583sinkLBS = fmap LBS.fromChunks . ($$+- CL.consume)

583

584

584−buildText :: ToText a => a -> Builder

585+buildText :: ToHttpApiData a => a -> Builder

585−buildText = Build.fromText . toText

586+buildText = Build.fromText . toQueryParam

586

587

587buildSymbol :: forall n proxy. KnownSymbol n => proxy n -> Builder

588buildSymbol :: forall n proxy. KnownSymbol n => proxy n -> Builder

588buildSymbol = Build.fromString . symbolVal

589buildSymbol = Build.fromString . symbolVal

gen/template/_include/sum.ede+7−7

@@ -11,19 +11,19 @@ data {{ type.name }}

11{{ branch.value.help }}

12 {% endif %}

13 {% endfor %}

14− deriving (Eq,Ord,Enum,Read,Show,Data,Typeable,Generic)

14+ deriving (Eq, Ord, Enum, Read, Show, Data, Typeable, Generic)

16instance Hashable {{ type.name }}

18−instance FromText {{ type.name }} where

18+instance FromHttpApiData {{ type.name }} where

19− fromText = \case

19+ parseQueryParam = \case

20 {% for branch in type.branches %}

21− "{{ branch.value.value }}" -> Just {{ branch.value.name }}

21+ "{{ branch.value.value }}" -> Right {{ branch.value.name }}

22 {% endfor %}

23− _ -> Nothing

23+ x -> Left ("Unable to parse {{ type.name }} from: " <> x)

25−instance ToText {{ type.name }} where

25+instance ToHttpApiData {{ type.name }} where

26− toText = \case

26+ toQueryParam = \case

27 {% for branch in type.branches %}

28 {{ branch.value.name }} -> "{{ branch.value.value }}"

29 {% endfor %}