@@ -16,18 +16,18 @@ module Web.Internal.FormUrlEncoded where
1616import Control.Applicative
1717#endif
1818
19−import Control.Arrow (first, second)
20−import Control.Monad.State
21−import qualified Data.ByteString.Lazy as BSL
22−import qualified Data.Map as M
19+import Control.Monad ((<=<))
20+import qualified Data.ByteString.Lazy as BSL
21+import qualified Data.ByteString.Lazy.Char8 as BSL8
22+import qualified Data.Map as M
2323import Data.Monoid
24−import qualified Data.Text as T
25−import Data.Text.Encoding (decodeUtf8With, encodeUtf8)
26−import Data.Text.Encoding.Error (lenientDecode)
27−import GHC.Exts (IsList (..))
24+import qualified Data.Text as T
25+import Data.Text.Encoding (decodeUtf8With, encodeUtf8)
26+import Data.Text.Encoding.Error (lenientDecode)
27+import GHC.Exts (IsList (..))
2828import GHC.Generics
29−import Network.URI (escapeURIString, isUnreserved,
30− unEscapeString)
29+import Network.URI (escapeURIString, isUnreserved,
30+ unEscapeString)
3131
3232import Web.Internal.HttpApiData
3333
@@ -108,23 +108,13 @@ instance ToForm Form where toForm = id
108108-- | A 'Generic'-based implementation of 'toForm'.
109109-- This is used as a default implementation in 'ToForm'.
110110genericToForm :: (Generic a, GToForm (Rep a)) => a -> Form
111−genericToForm x = evalState (unGenericToFormS . gToForm $ from x) (Nothing, 0)
112−
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))
111+genericToForm = gToForm . from
118112
119113class GToForm (f :: * -> *) where
120− gToForm :: f x -> GenericToFormS Form
114+ gToForm :: f x -> Form
121115
122116instance (GToForm f, GToForm g) => GToForm (f :*: g) where
123− gToForm (a :*: b) = do
124− a' <- gToForm a
125− modify $ second (+ 1)
126− b' <- gToForm b
127− return (a' <> b')
117+ gToForm (a :*: b) = gToForm a <> gToForm b
128118
129119instance (GToForm f, GToForm g) => GToForm (f :+: g) where
130120 gToForm (L1 a) = gToForm a
@@ -136,17 +126,10 @@ instance (GToForm f) => GToForm (M1 D x f) where
136126instance (GToForm f) => GToForm (M1 C x f) where
137127 gToForm (M1 a) = gToForm a
138128
139−instance {-# OVERLAPPABLE #-} (Selector sel, GToForm f)
140− => GToForm (M1 S sel f) where
141− gToForm (M1 a) = modify (first $ const sel) >> gToForm a
142− where sel = Just . T.pack $ selName (Proxy3 :: Proxy3 sel g p)
143−
144−instance (ToHttpApiData f) => GToForm (K1 i f) where
145− gToForm (K1 a) = do
146− s <- get
147− return . Form $ M.insert (name s) (toQueryParam a) $ mempty
148− where name (Nothing, i) = T.pack $ show i
149− name (Just x, _) = x
129+instance (Selector s, ToHttpApiData c) => GToForm (M1 S s (K1 i c)) where
130+ gToForm (M1 (K1 c)) = fromList [(key, toQueryParam c)]
131+ where
132+ key = T.pack $ selName (Proxy3 :: Proxy3 s g p)
150133
151134-- | Parse 'Form' into a value.
152135--
@@ -202,24 +185,24 @@ genericFromForm f = to <$> gFromForm f
202185class GFromForm (f :: * -> *) where
203186 gFromForm :: Form -> Either T.Text (f x)
204187
205−instance (GFromForm f, GFromForm g)
206− => GFromForm (f :*: g) where
188+instance (GFromForm f, GFromForm g) => GFromForm (f :*: g) where
207189 gFromForm f = (:*:) <$> gFromForm f <*> gFromForm f
208190
209−instance (GFromForm f, GFromForm g)
210− => GFromForm (f :+: g) where
211− gFromForm f = case gFromForm f of
212− Right a -> return $ L1 a
213− Left e1 -> case gFromForm f of
214− Right b -> return $ R1 b
215− Left e2 -> Left (e1 <> e2)
216−
217−instance (Selector sel, FromHttpApiData f)
218− => GFromForm (M1 S sel (K1 i f)) where
219− gFromForm f = case M.lookup sel (unForm f) of
220− Nothing -> Left $ "Could not find key " <> sel
221− Just v -> M1 . K1 <$> parseQueryParam v
222− where sel = T.pack $ selName (Proxy3 :: Proxy3 sel g p)
191+instance (GFromForm f, GFromForm g) => GFromForm (f :+: g) where
192+ gFromForm f
193+ = fmap L1 (gFromForm f)
194+ <!> fmap R1 (gFromForm f)
195+ where
196+ Left _ <!> y = y
197+ x <!> _ = x
198+
199+instance (Selector s, FromHttpApiData f) => GFromForm (M1 S s (K1 i f)) where
200+ gFromForm f =
201+ case M.lookup key (unForm f) of
202+ Nothing -> Left $ "Could not find key " <> T.pack (show key)
203+ Just v -> M1 . K1 <$> parseQueryParam v
204+ where
205+ key = T.pack $ selName (Proxy3 :: Proxy3 s g p)
223206
224207instance (GFromForm f) => GFromForm (M1 D x f) where
225208 gFromForm f = M1 <$> gFromForm f
@@ -297,7 +280,7 @@ encodeForm xs = BSL.intercalate "&" $ map (BSL.fromStrict . encodePair) $ toList
297280decodeForm :: BSL.ByteString -> Either T.Text Form
298281decodeForm bs = toForm <$> traverse parsePair pairs
299282 where
300− pairs = map (decodeUtf8With lenientDecode . BSL.toStrict) (BSL.split '&' bs)
283+ pairs = map (decodeUtf8With lenientDecode . BSL.toStrict) (BSL8.split '&' bs)
301284
302285 unescape = T.pack . unEscapeString . T.unpack . T.replace "+" "%20"
303286