@@ -16,18 +16,18 @@ module Web.Internal.FormUrlEncoded where
16import Control.Applicative
16import Control.Applicative
19−import Control.Arrow (first, second)
19+import Control.Monad ((<=<))
20−import Control.Monad.State
21−import qualified Data.ByteString.Lazy as BSL
20+import qualified Data.ByteString.Lazy as BSL
22−import qualified Data.Map as M
21+import qualified Data.ByteString.Lazy.Char8 as BSL8
22+import qualified Data.Map as M
23import Data.Monoid
23import Data.Monoid
24−import qualified Data.Text as T
24+import qualified Data.Text as T
25−import Data.Text.Encoding (decodeUtf8With, encodeUtf8)
25+import Data.Text.Encoding (decodeUtf8With, encodeUtf8)
26−import Data.Text.Encoding.Error (lenientDecode)
26+import Data.Text.Encoding.Error (lenientDecode)
27−import GHC.Exts (IsList (..))
27+import GHC.Exts (IsList (..))
28import GHC.Generics
28import GHC.Generics
29−import Network.URI (escapeURIString, isUnreserved,
29+import Network.URI (escapeURIString, isUnreserved,
30− unEscapeString)
30+ unEscapeString)
32import Web.Internal.HttpApiData
32import Web.Internal.HttpApiData
@@ -108,23 +108,13 @@ instance ToForm Form where toForm = id
108-- | A 'Generic'-based implementation of 'toForm'.
108-- | A 'Generic'-based implementation of 'toForm'.
109-- This is used as a default implementation in 'ToForm'.
109-- This is used as a default implementation in 'ToForm'.
110genericToForm :: (Generic a, GToForm (Rep a)) => a -> Form
110genericToForm :: (Generic a, GToForm (Rep a)) => a -> Form
111−genericToForm x = evalState (unGenericToFormS . gToForm $ from x) (Nothing, 0)
111+genericToForm = gToForm . from
113−-- | A datatype for generically generating forms. The state keeps track of the
114−-- record name currently being inspected (if any) and the field number.
115−newtype GenericToFormS a = GenericToFormS {
116− unGenericToFormS :: State (Maybe T.Text, Int) a
117− } deriving (Functor, Applicative, Generic, Monad, MonadState (Maybe T.Text, Int))
119class GToForm (f :: * -> *) where
113class GToForm (f :: * -> *) where
120− gToForm :: f x -> GenericToFormS Form
114+ gToForm :: f x -> Form
122instance (GToForm f, GToForm g) => GToForm (f :*: g) where
116instance (GToForm f, GToForm g) => GToForm (f :*: g) where
123− gToForm (a :*: b) = do
117+ gToForm (a :*: b) = gToForm a <> gToForm b
125− modify $ second (+ 1)
129instance (GToForm f, GToForm g) => GToForm (f :+: g) where
119instance (GToForm f, GToForm g) => GToForm (f :+: g) where
130 gToForm (L1 a) = gToForm a
120 gToForm (L1 a) = gToForm a
@@ -136,17 +126,10 @@ instance (GToForm f) => GToForm (M1 D x f) where
136instance (GToForm f) => GToForm (M1 C x f) where
126instance (GToForm f) => GToForm (M1 C x f) where
137 gToForm (M1 a) = gToForm a
127 gToForm (M1 a) = gToForm a
139−instance {-# OVERLAPPABLE #-} (Selector sel, GToForm f)
140− => GToForm (M1 S sel f) where
129+instance (Selector s, ToHttpApiData c) => GToForm (M1 S s (K1 i c)) where
141− gToForm (M1 a) = modify (first $ const sel) >> gToForm a
130+ gToForm (M1 (K1 c)) = fromList [(key, toQueryParam c)]
142− where sel = Just . T.pack $ selName (Proxy3 :: Proxy3 sel g p)
132+ key = T.pack $ selName (Proxy3 :: Proxy3 s g p)
144−instance (ToHttpApiData f) => GToForm (K1 i f) where
147− return . Form $ M.insert (name s) (toQueryParam a) $ mempty
148− where name (Nothing, i) = T.pack $ show i
149− name (Just x, _) = x
151-- | Parse 'Form' into a value.
134-- | Parse 'Form' into a value.
@@ -202,24 +185,24 @@ genericFromForm f = to <$> gFromForm f
202class GFromForm (f :: * -> *) where
185class GFromForm (f :: * -> *) where
203 gFromForm :: Form -> Either T.Text (f x)
186 gFromForm :: Form -> Either T.Text (f x)
205−instance (GFromForm f, GFromForm g)
188+instance (GFromForm f, GFromForm g) => GFromForm (f :*: g) where
206− => GFromForm (f :*: g) where
207 gFromForm f = (:*:) <$> gFromForm f <*> gFromForm f
189 gFromForm f = (:*:) <$> gFromForm f <*> gFromForm f
209−instance (GFromForm f, GFromForm g)
191+instance (GFromForm f, GFromForm g) => GFromForm (f :+: g) where
210− => GFromForm (f :+: g) where
211− gFromForm f = case gFromForm f of
192+ gFromForm f
212− Right a -> return $ L1 a
213− Left e1 -> case gFromForm f of
193+ = fmap L1 (gFromForm f)
214− Right b -> return $ R1 b
194+ <!> fmap R1 (gFromForm f)
215− Left e2 -> Left (e1 <> e2)
195+ where
216−
196+ Left _ <!> y = y
217−instance (Selector sel, FromHttpApiData f)
199+instance (Selector s, FromHttpApiData f) => GFromForm (M1 S s (K1 i f)) where
218− => GFromForm (M1 S sel (K1 i f)) where
200+ gFromForm f =
219− gFromForm f = case M.lookup sel (unForm f) of
201+ case M.lookup key (unForm f) of
220− Nothing -> Left $ "Could not find key " <> sel
202+ Nothing -> Left $ "Could not find key " <> T.pack (show key)
221− Just v -> M1 . K1 <$> parseQueryParam v
203+ Just v -> M1 . K1 <$> parseQueryParam v
222− where sel = T.pack $ selName (Proxy3 :: Proxy3 sel g p)
205+ key = T.pack $ selName (Proxy3 :: Proxy3 s g p)
224instance (GFromForm f) => GFromForm (M1 D x f) where
207instance (GFromForm f) => GFromForm (M1 D x f) where
225 gFromForm f = M1 <$> gFromForm f
208 gFromForm f = M1 <$> gFromForm f
@@ -297,7 +280,7 @@ encodeForm xs = BSL.intercalate "&" $ map (BSL.fromStrict . encodePair) $ toList
297decodeForm :: BSL.ByteString -> Either T.Text Form
280decodeForm :: BSL.ByteString -> Either T.Text Form
298decodeForm bs = toForm <$> traverse parsePair pairs
281decodeForm bs = toForm <$> traverse parsePair pairs
300− pairs = map (decodeUtf8With lenientDecode . BSL.toStrict) (BSL.split '&' bs)
283+ pairs = map (decodeUtf8With lenientDecode . BSL.toStrict) (BSL8.split '&' bs)
302 unescape = T.pack . unEscapeString . T.unpack . T.replace "+" "%20"
285 unescape = T.pack . unEscapeString . T.unpack . T.replace "+" "%20"