4bc8d3e · typeable/http-api-data

git.iko.soy/typeable/http-api-data

Treat Maybes and lists specially when deriving Generic instances

4bc8d3eNickolay Kudasov10 years ago

.ghcinew file+1

@@ -0,0 +1 @@

1+:set -itest -isrc -optP-include -optP .stack-work/dist/x86_64-osx/Cabal-1.24.0.0/build/autogen/cabal_macros.h -optP-I -optPinclude

http-api-data.cabal+2

@@ -12,6 +12,7 @@ stability: unstable

12cabal-version: >= 1.10

13build-type: Custom

14extra-source-files:

15+ include/overlapping-compat.h

15 test/*.hs

16 test/*.hs

16 CHANGELOG.md

17 CHANGELOG.md

17 README.md

18 README.md

@@ -22,6 +23,7 @@ flag use-text-show

23library

24library

24 hs-source-dirs: src/

25 hs-source-dirs: src/

26+ include-dirs: include/

25 build-depends: base >= 4.6 && < 4.10

27 build-depends: base >= 4.6 && < 4.10

26 , bytestring

28 , bytestring

27 , containers

29 , containers

include/overlapping-compat.hnew file+8

@@ -0,0 +1,8 @@

1+#if __GLASGOW_HASKELL__ >= 710

2+#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}

3+#define OVERLAPPING_ {-# OVERLAPPING #-}

4+#else

5+{-# LANGUAGE OverlappingInstances #-}

6+#define OVERLAPPABLE_

7+#define OVERLAPPING_

8+#endif

src/Web/FormUrlEncoded.hs+2

@@ -25,9 +25,11 @@ module Web.FormUrlEncoded (

25 fromEntriesByKey,

27 lookupAll,

28+ lookupMaybe,

28 lookupUnique,

29 lookupUnique,

30 parseAll,

31 parseAll,

32+ parseMaybe,

31 parseUnique,

33 parseUnique,

32) where

34) where

src/Web/Internal/FormUrlEncoded.hs+77−11

@@ -13,6 +13,7 @@

13{-# LANGUAGE TypeFamilies #-}

14{-# LANGUAGE TypeOperators #-}

15{-# LANGUAGE UndecidableInstances #-}

16+#include "overlapping-compat.h"

16module Web.Internal.FormUrlEncoded where

17module Web.Internal.FormUrlEncoded where

18#if __GLASGOW_HASKELL__ < 710

19#if __GLASGOW_HASKELL__ < 710

@@ -288,7 +289,25 @@ instance (GToForm t f) => GToForm t (M1 D x f) where

288instance (GToForm t f) => GToForm t (M1 C x f) where

289instance (GToForm t f) => GToForm t (M1 C x f) where

289 gToForm p opts (M1 a) = gToForm p opts a

290 gToForm p opts (M1 a) = gToForm p opts a

290

291

292+instance OVERLAPPABLE_ (Selector s, ToHttpApiData c) => GToForm t (M1 S s (K1 i c)) where

293+ gToForm _ opts (M1 (K1 c)) = fromList [(key, toQueryParam c)]

294+ where

295+ key = Text.pack $ fieldLabelModifier opts $ selName (Proxy3 :: Proxy3 s g p)

296+

291−instance (Selector s, ToHttpApiData c) => GToForm t (M1 S s (K1 i c)) where

297+instance (Selector s, ToHttpApiData c) => GToForm t (M1 S s (K1 i (Maybe c))) where

298+ gToForm _ opts (M1 (K1 c)) =

299+ case c of

300+ Nothing -> mempty

301+ Just x -> fromList [(key, toQueryParam x)]

302+ where

303+ key = Text.pack $ fieldLabelModifier opts $ selName (Proxy3 :: Proxy3 s g p)

304+

305+instance (Selector s, ToHttpApiData c) => GToForm t (M1 S s (K1 i [c])) where

306+ gToForm _ opts (M1 (K1 cs)) = fromList (map (\c -> (key, toQueryParam c)) cs)

307+ where

308+ key = Text.pack $ fieldLabelModifier opts $ selName (Proxy3 :: Proxy3 s g p)

309+

310+instance OVERLAPPING_ (Selector s) => GToForm t (M1 S s (K1 i String)) where

292 gToForm _ opts (M1 (K1 c)) = fromList [(key, toQueryParam c)]

311 gToForm _ opts (M1 (K1 c)) = fromList [(key, toQueryParam c)]

293 where

312 where

294 key = Text.pack $ fieldLabelModifier opts $ selName (Proxy3 :: Proxy3 s g p)

313 key = Text.pack $ fieldLabelModifier opts $ selName (Proxy3 :: Proxy3 s g p)

@@ -379,17 +398,32 @@ class GFromForm t (f :: * -> *) where

379instance (GFromForm t f, GFromForm t g) => GFromForm t (f :*: g) where

398instance (GFromForm t f, GFromForm t g) => GFromForm t (f :*: g) where

380 gFromForm p opts f = (:*:) <$> gFromForm p opts f <*> gFromForm p opts f

399 gFromForm p opts f = (:*:) <$> gFromForm p opts f <*> gFromForm p opts f

381

400

382−instance (Selector s, FromHttpApiData f) => GFromForm t (M1 S s (K1 i f)) where

383− gFromForm _ opts form = M1 . K1 <$> parseUnique key form

384− where

385− key = Text.pack $ fieldLabelModifier opts $ selName (Proxy3 :: Proxy3 s g p)

386−

387instance GFromForm t f => GFromForm t (M1 D x f) where

401instance GFromForm t f => GFromForm t (M1 D x f) where

388 gFromForm p opts f = M1 <$> gFromForm p opts f

402 gFromForm p opts f = M1 <$> gFromForm p opts f

389

403

390instance GFromForm t f => GFromForm t (M1 C x f) where

404instance GFromForm t f => GFromForm t (M1 C x f) where

391 gFromForm p opts f = M1 <$> gFromForm p opts f

405 gFromForm p opts f = M1 <$> gFromForm p opts f

392

406

407+instance OVERLAPPABLE_ (Selector s, FromHttpApiData c) => GFromForm t (M1 S s (K1 i c)) where

408+ gFromForm _ opts form = M1 . K1 <$> parseUnique key form

409+ where

410+ key = Text.pack $ fieldLabelModifier opts $ selName (Proxy3 :: Proxy3 s g p)

411+

412+instance (Selector s, FromHttpApiData c) => GFromForm t (M1 S s (K1 i (Maybe c))) where

413+ gFromForm _ opts form = M1 . K1 <$> parseMaybe key form

414+ where

415+ key = Text.pack $ fieldLabelModifier opts $ selName (Proxy3 :: Proxy3 s g p)

416+

417+instance (Selector s, FromHttpApiData c) => GFromForm t (M1 S s (K1 i [c])) where

418+ gFromForm _ opts form = M1 . K1 <$> parseAll key form

419+ where

420+ key = Text.pack $ fieldLabelModifier opts $ selName (Proxy3 :: Proxy3 s g p)

421+

422+instance OVERLAPPING_ (Selector s) => GFromForm t (M1 S s (K1 i String)) where

423+ gFromForm _ opts form = M1 . K1 <$> parseUnique key form

424+ where

425+ key = Text.pack $ fieldLabelModifier opts $ selName (Proxy3 :: Proxy3 s g p)

426+

393instance NotSupported FromForm t "is a sum type" => GFromForm t (f :+: g) where gFromForm = error "impossible"

427instance NotSupported FromForm t "is a sum type" => GFromForm t (f :+: g) where gFromForm = error "impossible"

394

428

395-- | Encode a 'Form' to an @application/x-www-form-urlencoded@ 'BSL.ByteString'.

429-- | Encode a 'Form' to an @application/x-www-form-urlencoded@ 'BSL.ByteString'.

@@ -505,6 +539,22 @@ urlEncodeAsForm = urlEncodeForm . toForm

505lookupAll :: Text -> Form -> [Text]

539lookupAll :: Text -> Form -> [Text]

506lookupAll key = F.concat . HashMap.lookup key . unForm

540lookupAll key = F.concat . HashMap.lookup key . unForm

507

541

542+-- | Lookup an optional value for a key.

543+-- Fail if there is more than one value.

544+--

545+-- >>> lookupMaybe "name" []

546+-- Right Nothing

547+-- >>> lookupMaybe "name" [("name", "Oleg")]

548+-- Right (Just "Oleg")

549+-- >>> lookupMaybe "name" [("name", "Oleg"), ("name", "David")]

550+-- Left "Duplicate key \"name\""

551+lookupMaybe :: Text -> Form -> Either Text (Maybe Text)

552+lookupMaybe key form =

553+ case lookupAll key form of

554+ [] -> pure Nothing

555+ [v] -> pure (Just v)

556+ _ -> Left $ "Duplicate key " <> Text.pack (show key)

557+

508-- | Lookup a unique value for a key.

558-- | Lookup a unique value for a key.

509-- Fail if there is zero or more than one value.

559-- Fail if there is zero or more than one value.

510--

560--

@@ -515,11 +565,11 @@ lookupAll key = F.concat . HashMap.lookup key . unForm

515-- >>> lookupUnique "name" [("name", "Oleg"), ("name", "David")]

565-- >>> lookupUnique "name" [("name", "Oleg"), ("name", "David")]

516-- Left "Duplicate key \"name\""

566-- Left "Duplicate key \"name\""

517lookupUnique :: Text -> Form -> Either Text Text

567lookupUnique :: Text -> Form -> Either Text Text

518−lookupUnique key form =

568+lookupUnique key form = do

569+ mv <- lookupMaybe key form

519− case lookupAll key form of

570+ case mv of

520− [v] -> pure v

571+ Just v -> pure v

521− [] -> Left $ "Could not find key " <> Text.pack (show key)

572+ Nothing -> Left $ "Could not find key " <> Text.pack (show key)

522− _ -> Left $ "Duplicate key " <> Text.pack (show key)

523

573

524-- | Lookup all values for a given key in a 'Form' and parse them with 'parseQueryParams'.

574-- | Lookup all values for a given key in a 'Form' and parse them with 'parseQueryParams'.

525--

575--

@@ -534,6 +584,22 @@ lookupUnique key form =

534parseAll :: FromHttpApiData v => Text -> Form -> Either Text [v]

584parseAll :: FromHttpApiData v => Text -> Form -> Either Text [v]

535parseAll key = parseQueryParams . lookupAll key

585parseAll key = parseQueryParams . lookupAll key

536

586

587+-- | Lookup an optional value for a given key and parse it with 'parseQueryParam'.

588+-- Fail if there is more than one value for the key.

589+--

590+-- >>> parseMaybe "age" [] :: Either Text (Maybe Word8)

591+-- Right Nothing

592+-- >>> parseMaybe "age" [("age", "12"), ("age", "25")] :: Either Text (Maybe Word8)

593+-- Left "Duplicate key \"age\""

594+-- >>> parseMaybe "age" [("age", "seven")] :: Either Text (Maybe Word8)

595+-- Left "could not parse: `seven' (input does not start with a digit)"

596+-- >>> parseMaybe "age" [("age", "777")] :: Either Text (Maybe Word8)

597+-- Left "out of bounds: `777' (should be between 0 and 255)"

598+-- >>> parseMaybe "age" [("age", "7")] :: Either Text (Maybe Word8)

599+-- Right (Just 7)

600+parseMaybe :: FromHttpApiData v => Text -> Form -> Either Text (Maybe v)

601+parseMaybe key = parseQueryParams <=< lookupMaybe key

602+

537-- | Lookup a unique value for a given key and parse it with 'parseQueryParam'.

603-- | Lookup a unique value for a given key and parse it with 'parseQueryParam'.

538-- Fail if there is zero or more than one value for the key.

604-- Fail if there is zero or more than one value for the key.

539--

605--

test/DocTest.hs+1

@@ -11,6 +11,7 @@ import Test.DocTest

11main :: IO ()

12main = getSources >>= \sources -> doctest $

13 "-isrc"

14+ : "-Iinclude"

14 : ("-i" ++ autogen_dir)

15 : ("-i" ++ autogen_dir)

15 : "-optP-include"

16 : "-optP-include"

16 : ("-optP" ++ autogen_dir ++ "/cabal_macros.h")

17 : ("-optP" ++ autogen_dir ++ "/cabal_macros.h")