git.iko.soy/typeable/http-api-data
on master help sign in
Add instances for Data.Monoid newtypes

Added instances for: - All - Any - Dual a - Sum a - Product a - First a - Last a Also changed PathPieces implementation for Maybe. Now newtypes and Maybe use unsafeCoerce to reuse HttpApiData instances.

commitc2959c07386d19f3c0793533131caad108035196 authorNickolay Kudasov <nickolay.kudasov@gmail.com> dateTue 6 Oct 2015, 01:51 (11 years ago) parent5fcc4b0
2 files changed+59−7
compare with master
unifiedsplit
Web/HttpApiData.hs+22−4 Web/PathPieces.hs+37−3
Web/HttpApiData.hs+22−4
@@ -164,6 +164,15 @@ instance ToHttpApiData Text where toUrlPiece = id
164164instance ToHttpApiData L.Text where toUrlPiece = L.toStrict
165165instance ToHttpApiData Day where toUrlPiece = showUrlPiece
166166
167+instance ToHttpApiData All where toUrlPiece = toUrlPiece . getAll
168+instance ToHttpApiData Any where toUrlPiece = toUrlPiece . getAny
169+
170+instance ToHttpApiData a => ToHttpApiData (Dual a) where toUrlPiece = toUrlPiece . getDual
171+instance ToHttpApiData a => ToHttpApiData (Sum a) where toUrlPiece = toUrlPiece . getSum
172+instance ToHttpApiData a => ToHttpApiData (Product a) where toUrlPiece = toUrlPiece . getProduct
173+instance ToHttpApiData a => ToHttpApiData (First a) where toUrlPiece = toUrlPiece . getFirst
174+instance ToHttpApiData a => ToHttpApiData (Last a) where toUrlPiece = toUrlPiece . getLast
175+
167176-- |
168177-- >>> toUrlPiece (Just "Hello")
169178-- "Just Hello"
@@ -193,6 +202,11 @@ instance FromHttpApiData Version where
193202 ((x, ""):_) -> return x
194203 _ -> defaultParseError s
195204
205+#if MIN_VERSION_base(4,8,0)
206+instance FromHttpApiData Void where
207+ parseUrlPiece _ = Left "Void cannot be parsed!"
208+#endif
209+
196210instance FromHttpApiData Bool where parseUrlPiece = readEitherUrlPiece
197211instance FromHttpApiData Ordering where parseUrlPiece = readEitherUrlPiece
198212instance FromHttpApiData Double where parseUrlPiece = runReader rational
@@ -213,10 +227,14 @@ instance FromHttpApiData Text where parseUrlPiece = Right
213227instance FromHttpApiData L.Text where parseUrlPiece = Right . L.fromStrict
214228instance FromHttpApiData Day where parseUrlPiece = readEitherUrlPiece
215229
216−#if MIN_VERSION_base(4,8,0)
217−instance FromHttpApiData Void where
218− parseUrlPiece _ = Left "Void cannot be parsed!"
219−#endif
230+instance FromHttpApiData All where parseUrlPiece = fmap All . parseUrlPiece
231+instance FromHttpApiData Any where parseUrlPiece = fmap Any . parseUrlPiece
232+
233+instance FromHttpApiData a => FromHttpApiData (Dual a) where parseUrlPiece = fmap Dual . parseUrlPiece
234+instance FromHttpApiData a => FromHttpApiData (Sum a) where parseUrlPiece = fmap Sum . parseUrlPiece
235+instance FromHttpApiData a => FromHttpApiData (Product a) where parseUrlPiece = fmap Product . parseUrlPiece
236+instance FromHttpApiData a => FromHttpApiData (First a) where parseUrlPiece = fmap First . parseUrlPiece
237+instance FromHttpApiData a => FromHttpApiData (Last a) where parseUrlPiece = fmap Last . parseUrlPiece
220238
221239-- |
222240-- >>> parseUrlPiece "Just 123" :: Either Text (Maybe Int)
Web/PathPieces.hs+37−3
@@ -2,6 +2,8 @@
22{-# LANGUAGE DefaultSignatures #-}
33{-# LANGUAGE FlexibleInstances #-}
44{-# LANGUAGE OverloadedStrings #-}
5+{-# LANGUAGE Rank2Types #-}
6+{-# LANGUAGE ScopedTypeVariables #-}
57{-# LANGUAGE TypeSynonymInstances #-}
68-- |
79-- Convert Haskell values to and from route pieces.
@@ -13,6 +15,7 @@ module Web.PathPieces (
1315 WrappedPathPiece(..),
1416) where
1517
18+import Data.Monoid
1619import Data.Int
1720import Data.Word
1821import qualified Data.Text as S
@@ -21,6 +24,8 @@ import Data.Version (Version)
2124import Data.Time (Day)
2225import Text.Read (readMaybe)
2326
27+import Unsafe.Coerce
28+
2429#if MIN_VERSION_base(4,8,0)
2530import Data.Void (Void)
2631#endif
@@ -65,6 +70,33 @@ instance PathPiece Version
6570instance PathPiece Void
6671#endif
6772
73+instance PathPiece All
74+instance PathPiece Any
75+
76+instance PathPiece a => PathPiece (Dual a) where
77+ toPathPiece = unsafeToPathPiece1
78+ fromPathPiece = unsafeFromPathPiece1
79+
80+instance PathPiece a => PathPiece (Sum a) where
81+ toPathPiece = unsafeToPathPiece1
82+ fromPathPiece = unsafeFromPathPiece1
83+
84+instance PathPiece a => PathPiece (Product a) where
85+ toPathPiece = unsafeToPathPiece1
86+ fromPathPiece = unsafeFromPathPiece1
87+
88+instance PathPiece a => PathPiece (First a) where
89+ toPathPiece = unsafeToPathPiece1
90+ fromPathPiece = unsafeFromPathPiece1
91+
92+instance PathPiece a => PathPiece (Last a) where
93+ toPathPiece = unsafeToPathPiece1
94+ fromPathPiece = unsafeFromPathPiece1
95+
96+instance PathPiece a => PathPiece (Maybe a) where
97+ toPathPiece = unsafeToPathPiece1
98+ fromPathPiece = unsafeFromPathPiece1
99+
68100-- | Wrapped @'PathPiece'@ value.
69101newtype WrappedPathPiece a = WrappedPathPiece { unwrapPathPiece :: a }
70102
@@ -74,9 +106,11 @@ instance PathPiece a => ToHttpApiData (WrappedPathPiece a) where
74106instance PathPiece a => FromHttpApiData (WrappedPathPiece a) where
75107 parseUrlPiece = fmap WrappedPathPiece . parseMaybeHttpApiData fromPathPiece
76108
77−instance PathPiece a => PathPiece (Maybe a) where
78− toPathPiece = toUrlPiece . fmap WrappedPathPiece
79− fromPathPiece = either (const Nothing) (Just . fmap unwrapPathPiece) . parseUrlPiece
109+unsafeToPathPiece1 :: forall f a. (PathPiece a, ToHttpApiData (f (WrappedPathPiece a))) => f a -> S.Text
110+unsafeToPathPiece1 = toUrlPiece . (unsafeCoerce :: f a -> f (WrappedPathPiece a))
111+
112+unsafeFromPathPiece1 :: forall f a. (PathPiece a, FromHttpApiData (f (WrappedPathPiece a))) => S.Text -> Maybe (f a)
113+unsafeFromPathPiece1 = either (const Nothing) (Just . (unsafeCoerce :: f (WrappedPathPiece a) -> f a)) . parseUrlPiece
80114
81115-- | Convert Haskell values to and from sequence of route pieces.
82116class PathMultiPiece s where