@@ -13,6 +13,7 @@
1313{-# LANGUAGE TypeFamilies #-}
1414{-# LANGUAGE TypeOperators #-}
1515{-# LANGUAGE UndecidableInstances #-}
16+#include "overlapping-compat.h"
1617module Web.Internal.FormUrlEncoded where
1718
1819#if __GLASGOW_HASKELL__ < 710
@@ -288,7 +289,25 @@ instance (GToForm t f) => GToForm t (M1 D x f) where
288289instance (GToForm t f) => GToForm t (M1 C x f) where
289290 gToForm p opts (M1 a) = gToForm p opts a
290291
291−instance (Selector s, ToHttpApiData c) => GToForm t (M1 S s (K1 i c)) where
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+
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
292311 gToForm _ opts (M1 (K1 c)) = fromList [(key, toQueryParam c)]
293312 where
294313 key = Text.pack $ fieldLabelModifier opts $ selName (Proxy3 :: Proxy3 s g p)
@@ -379,17 +398,32 @@ class GFromForm t (f :: * -> *) where
379398instance (GFromForm t f, GFromForm t g) => GFromForm t (f :*: g) where
380399 gFromForm p opts f = (:*:) <$> gFromForm p opts f <*> gFromForm p opts f
381400
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−
387401instance GFromForm t f => GFromForm t (M1 D x f) where
388402 gFromForm p opts f = M1 <$> gFromForm p opts f
389403
390404instance GFromForm t f => GFromForm t (M1 C x f) where
391405 gFromForm p opts f = M1 <$> gFromForm p opts f
392406
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+
393427instance NotSupported FromForm t "is a sum type" => GFromForm t (f :+: g) where gFromForm = error "impossible"
394428
395429-- | Encode a 'Form' to an @application/x-www-form-urlencoded@ 'BSL.ByteString'.
@@ -505,6 +539,22 @@ urlEncodeAsForm = urlEncodeForm . toForm
505539lookupAll :: Text -> Form -> [Text]
506540lookupAll key = F.concat . HashMap.lookup key . unForm
507541
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+
508558-- | Lookup a unique value for a key.
509559-- Fail if there is zero or more than one value.
510560--
@@ -515,11 +565,11 @@ lookupAll key = F.concat . HashMap.lookup key . unForm
515565-- >>> lookupUnique "name" [("name", "Oleg"), ("name", "David")]
516566-- Left "Duplicate key \"name\""
517567lookupUnique :: Text -> Form -> Either Text Text
518−lookupUnique key form =
519− case lookupAll key form of
520− [v] -> pure v
521− [] -> Left $ "Could not find key " <> Text.pack (show key)
522− _ -> Left $ "Duplicate key " <> Text.pack (show key)
568+lookupUnique key form = do
569+ mv <- lookupMaybe key form
570+ case mv of
571+ Just v -> pure v
572+ Nothing -> Left $ "Could not find key " <> Text.pack (show key)
523573
524574-- | Lookup all values for a given key in a 'Form' and parse them with 'parseQueryParams'.
525575--
@@ -534,6 +584,22 @@ lookupUnique key form =
534584parseAll :: FromHttpApiData v => Text -> Form -> Either Text [v]
535585parseAll key = parseQueryParams . lookupAll key
536586
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+
537603-- | Lookup a unique value for a given key and parse it with 'parseQueryParam'.
538604-- Fail if there is zero or more than one value for the key.
539605--