c7d5b60 · gogol · git.iko.soy

git.iko.soy/gogol

Replacing library usage of Common.Servant.Text

commitc7d5b60fc5a47e11492e983053cddc9ad57cfb1f authorBrendan Hay <brendan.g.hay@gmail.com> dateTue 10 May 2016, 16:58 (10 years ago) parent51d2997

4 files changed+73−59

compare with develop

unifiedsplit

core/src/Network/Google/Data/JSON.hs+23−12 core/src/Network/Google/Prelude.hs+2 core/src/Network/Google/Types.hs+41−40 gen/template/_include/sum.ede+7−7

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

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

3737import Data.HashMap.Strict (HashMap)

3838import Data.Text (Text)

3939import qualified Data.Text as Text

40−import Servant.API

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

4141

4242type JSONValue = Value

4343

4444newtype 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+ )

4657

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

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

4859 parseJSON (String s) =

49− case fromText s of

50− Just x -> pure (Textual x)

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

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

5261 parseJSON o = Textual <$> parseJSON o

5362

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

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

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

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

5665

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

5867parseJSONObject = parseJSON . Object

5968

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

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

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

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

71+ where

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

6273

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

64−toJSONText = String . toText

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

75+toJSONText = String . toQueryParam

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

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

3232import Prelude as Export hiding (product)

3333import Servant.API as Export hiding (getResponse)

3434import 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)

5454import Network.HTTP.Types hiding (Header)

5555import qualified Network.HTTP.Types as HTTP

5656import Servant.API

57+import Web.HttpApiData

5758

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

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

6061

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

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

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

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

6364

6465newtype OAuthScope = OAuthScope Text

6566 deriving

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

7071 , IsString

7172 , Generic

7273 , Typeable

73− , FromText

74− , ToText

74+ , FromHttpApiData

75+ , ToHttpApiData

7576 , FromJSON

7677 , ToJSON

7778 )

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

8586 , IsString

8687 , Generic

8788 , Typeable

88− , FromText

89− , ToText

89+ , FromHttpApiData

90+ , ToHttpApiData

9091 , FromJSON

9192 , ToJSON

9293 )

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

100101 , IsString

101102 , Generic

102103 , Typeable

103− , FromText

104− , ToText

104+ , FromHttpApiData

105+ , ToHttpApiData

105106 , FromJSON

106107 , ToJSON

107108 )

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

115116 , IsString

116117 , Generic

117118 , Typeable

118− , FromText

119− , ToText

119+ , FromHttpApiData

120+ , ToHttpApiData

120121 , FromJSON

121122 , ToJSON

122123 )

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

130131 , IsString

131132 , Generic

132133 , Typeable

133− , FromText

134− , ToText

134+ , FromHttpApiData

135+ , ToHttpApiData

135136 , FromJSON

136137 , ToJSON

137138 )

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

145146 , IsString

146147 , Generic

147148 , Typeable

148− , FromText

149− , ToText

149+ , FromHttpApiData

150+ , ToHttpApiData

150151 , FromJSON

151152 , ToJSON

152153 )

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

286287appendPath :: Request -> Builder -> Request

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

288289

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

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

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

291292

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

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

437438 buildClient (Proxy :: Proxy a) rq

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

439440

440−instance ( KnownSymbol s

441− , ToText a

442− , GoogleClient fn

441+instance ( KnownSymbol s

442+ , ToHttpApiData a

443+ , GoogleClient fn

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

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

445446

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

447448 . appendPath rq

448449 . buildText

449450

450−instance ( KnownSymbol s

451− , ToText a

452− , GoogleClient fn

451+instance ( KnownSymbol s

452+ , ToHttpApiData a

453+ , GoogleClient fn

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

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

455456

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

457458 . appendPaths rq

458459

459−instance ( KnownSymbol s

460− , KnownSymbol m

461− , ToText a

462− , GoogleClient fn

460+instance ( KnownSymbol s

461+ , KnownSymbol m

462+ , ToHttpApiData a

463+ , GoogleClient fn

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

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

465466

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

467468 . appendPath rq

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

469470

470−instance ( KnownSymbol s

471− , ToText a

472− , GoogleClient fn

471+instance ( KnownSymbol s

472+ , ToHttpApiData a

473+ , GoogleClient fn

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

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

475476

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

479480 Just x -> appendQuery rq k v

480481 where

481482 k = byteSymbol (Proxy :: Proxy s)

482− v = Just (toText x)

483+ v = Just (toQueryParam x)

483484

484−instance ( KnownSymbol s

485− , ToText a

486− , GoogleClient fn

485+instance ( KnownSymbol s

486+ , ToHttpApiData a

487+ , GoogleClient fn

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

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

489490

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

491492 where

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

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

493494

494495 k = byteSymbol (Proxy :: Proxy s)

495496

496−instance ( KnownSymbol s

497− , ToText a

498− , GoogleClient fn

497+instance ( KnownSymbol s

498+ , ToHttpApiData a

499+ , GoogleClient fn

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

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

501502

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

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

506507 where

507508 k = byteSymbol (Proxy :: Proxy s)

508− v = Just (toText x)

509+ v = Just (toQueryParam x)

509510

510511instance ( ToBody c a

511512 , GoogleClient fn

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

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

574575

575576instance {-# OVERLAPPING #-}

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

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

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

578579

579580 buildClient Proxy = discard methodDelete [204]

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

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

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

583584

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

585−buildText = Build.fromText . toText

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

586+buildText = Build.fromText . toQueryParam

586587

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

588589buildSymbol = Build.fromString . symbolVal

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

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

1111{{ branch.value.help }}

1212 {% endif %}

1313 {% endfor %}

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

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

1515

1616instance Hashable {{ type.name }}

1717

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

19− fromText = \case

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

19+ parseQueryParam = \case

2020 {% for branch in type.branches %}

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

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

2222 {% endfor %}

23− _ -> Nothing

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

2424

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

26− toText = \case

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

26+ toQueryParam = \case

2727 {% for branch in type.branches %}

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

2929 {% endfor %}