git.iko.soy/typeable/http-api-data
on master help sign in
Add instances for Data.Monoid newtypes
c2959c0Nickolay Kudasov
Web/HttpApiData.hs+22−4
@@ -164,6 +164,15 @@ instance ToHttpApiData Text where toUrlPiece = id
164instance ToHttpApiData L.Text where toUrlPiece = L.toStrict
164instance ToHttpApiData L.Text where toUrlPiece = L.toStrict
165instance ToHttpApiData Day where toUrlPiece = showUrlPiece
165instance ToHttpApiData Day where toUrlPiece = showUrlPiece
166
166
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+
167-- |
176-- |
168-- >>> toUrlPiece (Just "Hello")
177-- >>> toUrlPiece (Just "Hello")
169-- "Just Hello"
178-- "Just Hello"
@@ -193,6 +202,11 @@ instance FromHttpApiData Version where
193 ((x, ""):_) -> return x
202 ((x, ""):_) -> return x
194 _ -> defaultParseError s
203 _ -> defaultParseError s
195
204
205+#if MIN_VERSION_base(4,8,0)
206+instance FromHttpApiData Void where
207+ parseUrlPiece _ = Left "Void cannot be parsed!"
208+#endif
209+
196instance FromHttpApiData Bool where parseUrlPiece = readEitherUrlPiece
210instance FromHttpApiData Bool where parseUrlPiece = readEitherUrlPiece
197instance FromHttpApiData Ordering where parseUrlPiece = readEitherUrlPiece
211instance FromHttpApiData Ordering where parseUrlPiece = readEitherUrlPiece
198instance FromHttpApiData Double where parseUrlPiece = runReader rational
212instance FromHttpApiData Double where parseUrlPiece = runReader rational
@@ -213,10 +227,14 @@ instance FromHttpApiData Text where parseUrlPiece = Right
213instance FromHttpApiData L.Text where parseUrlPiece = Right . L.fromStrict
227instance FromHttpApiData L.Text where parseUrlPiece = Right . L.fromStrict
214instance FromHttpApiData Day where parseUrlPiece = readEitherUrlPiece
228instance FromHttpApiData Day where parseUrlPiece = readEitherUrlPiece
215
229
216−#if MIN_VERSION_base(4,8,0)
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
217−instance FromHttpApiData Void where
234+instance FromHttpApiData a => FromHttpApiData (Sum a) where parseUrlPiece = fmap Sum . parseUrlPiece
218− parseUrlPiece _ = Left "Void cannot be parsed!"
235+instance FromHttpApiData a => FromHttpApiData (Product a) where parseUrlPiece = fmap Product . parseUrlPiece
219−#endif
236+instance FromHttpApiData a => FromHttpApiData (First a) where parseUrlPiece = fmap First . parseUrlPiece
237+instance FromHttpApiData a => FromHttpApiData (Last a) where parseUrlPiece = fmap Last . parseUrlPiece
220
238
221-- |
239-- |
222-- >>> parseUrlPiece "Just 123" :: Either Text (Maybe Int)
240-- >>> parseUrlPiece "Just 123" :: Either Text (Maybe Int)
Web/PathPieces.hs+37−3
@@ -2,6 +2,8 @@
2{-# LANGUAGE DefaultSignatures #-}
2{-# LANGUAGE DefaultSignatures #-}
3{-# LANGUAGE FlexibleInstances #-}
3{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE OverloadedStrings #-}
4{-# LANGUAGE OverloadedStrings #-}
5+{-# LANGUAGE Rank2Types #-}
6+{-# LANGUAGE ScopedTypeVariables #-}
5{-# LANGUAGE TypeSynonymInstances #-}
7{-# LANGUAGE TypeSynonymInstances #-}
6-- |
8-- |
7-- Convert Haskell values to and from route pieces.
9-- Convert Haskell values to and from route pieces.
@@ -13,6 +15,7 @@ module Web.PathPieces (
13 WrappedPathPiece(..),
15 WrappedPathPiece(..),
14) where
16) where
15
17
18+import Data.Monoid
16import Data.Int
19import Data.Int
17import Data.Word
20import Data.Word
18import qualified Data.Text as S
21import qualified Data.Text as S
@@ -21,6 +24,8 @@ import Data.Version (Version)
21import Data.Time (Day)
24import Data.Time (Day)
22import Text.Read (readMaybe)
25import Text.Read (readMaybe)
23
26
27+import Unsafe.Coerce
28+
24#if MIN_VERSION_base(4,8,0)
29#if MIN_VERSION_base(4,8,0)
25import Data.Void (Void)
30import Data.Void (Void)
26#endif
31#endif
@@ -65,6 +70,33 @@ instance PathPiece Version
65instance PathPiece Void
70instance PathPiece Void
66#endif
71#endif
67
72
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+
68-- | Wrapped @'PathPiece'@ value.
100-- | Wrapped @'PathPiece'@ value.
69newtype WrappedPathPiece a = WrappedPathPiece { unwrapPathPiece :: a }
101newtype WrappedPathPiece a = WrappedPathPiece { unwrapPathPiece :: a }
70
102
@@ -74,9 +106,11 @@ instance PathPiece a => ToHttpApiData (WrappedPathPiece a) where
74instance PathPiece a => FromHttpApiData (WrappedPathPiece a) where
106instance PathPiece a => FromHttpApiData (WrappedPathPiece a) where
75 parseUrlPiece = fmap WrappedPathPiece . parseMaybeHttpApiData fromPathPiece
107 parseUrlPiece = fmap WrappedPathPiece . parseMaybeHttpApiData fromPathPiece
76
108
77−instance PathPiece a => PathPiece (Maybe a) where
109+unsafeToPathPiece1 :: forall f a. (PathPiece a, ToHttpApiData (f (WrappedPathPiece a))) => f a -> S.Text
78− toPathPiece = toUrlPiece . fmap WrappedPathPiece
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)
79− fromPathPiece = either (const Nothing) (Just . fmap unwrapPathPiece) . parseUrlPiece
113+unsafeFromPathPiece1 = either (const Nothing) (Just . (unsafeCoerce :: f (WrappedPathPiece a) -> f a)) . parseUrlPiece
80
114
81-- | Convert Haskell values to and from sequence of route pieces.
115-- | Convert Haskell values to and from sequence of route pieces.
82class PathMultiPiece s where
116class PathMultiPiece s where