git.iko.soy/typeable/http-api-data
on master help sign in
Add To/FromHttpApiData instances for Maybe and add WrappedPathPiece
274f458Nickolay Kudasov
Web/HttpApiData.hs+20−1
compare with master
unifiedsplit
@@ -21,6 +21,8 @@ module Web.HttpApiData (
21 readEitherUrlPiece,
21 readEitherUrlPiece,
22) where
22) where
23
23
24+import Control.Applicative
25+
24import Data.Monoid
26import Data.Monoid
25import Data.ByteString (ByteString)
27import Data.ByteString (ByteString)
26
28
@@ -141,11 +143,18 @@ instance ToHttpApiData Text where toUrlPiece = id
141instance ToHttpApiData L.Text where toUrlPiece = L.toStrict
143instance ToHttpApiData L.Text where toUrlPiece = L.toStrict
142instance ToHttpApiData Day where toUrlPiece = showUrlPiece
144instance ToHttpApiData Day where toUrlPiece = showUrlPiece
143
145
146+-- |
147+-- >>> toUrlPiece (Just "Hello")
148+-- "Just Hello"
149+instance ToHttpApiData a => ToHttpApiData (Maybe a) where
150+ toUrlPiece (Just x) = "Just " <> toUrlPiece x
151+ toUrlPiece Nothing = "Nothing"
152+
144-- |
153-- |
145-- >>> parseUrlPiece "_" :: Either Text ()
154-- >>> parseUrlPiece "_" :: Either Text ()
146-- Right ()
155-- Right ()
147instance FromHttpApiData () where
156instance FromHttpApiData () where
148− parseUrlPiece "_" = pure ()
157+ parseUrlPiece "_" = return ()
149 parseUrlPiece s = defaultParseError s
158 parseUrlPiece s = defaultParseError s
150
159
151instance FromHttpApiData Bool where parseUrlPiece = readEitherUrlPiece
160instance FromHttpApiData Bool where parseUrlPiece = readEitherUrlPiece
@@ -167,6 +176,16 @@ instance FromHttpApiData Text where parseUrlPiece = Right
167instance FromHttpApiData L.Text where parseUrlPiece = Right . L.fromStrict
176instance FromHttpApiData L.Text where parseUrlPiece = Right . L.fromStrict
168instance FromHttpApiData Day where parseUrlPiece = readEitherUrlPiece
177instance FromHttpApiData Day where parseUrlPiece = readEitherUrlPiece
169
178
179+-- |
180+-- >>> parseUrlPiece "Just 123" :: Either Text Int
181+-- Just 123
182+instance FromHttpApiData a => FromHttpApiData (Maybe a) where
183+ parseUrlPiece "Nothing" = return Nothing
184+ parseUrlPiece s =
185+ case T.stripPrefix "Just " s of
186+ Nothing -> defaultParseError s
187+ Just x -> Just <$> parseUrlPiece x
188+
170-- $examples
189-- $examples
171--
190--
172-- Booleans:
191-- Booleans:
Web/PathPieces.hs+13−9
@@ -9,6 +9,7 @@ module Web.PathPieces (
9 PathMultiPiece (..),
9 PathMultiPiece (..),
10 readFromPathPiece,
10 readFromPathPiece,
11 showToPathPiece,
11 showToPathPiece,
12+ WrappedPathPiece(..),
12) where
13) where
13
14
14import Data.Int
15import Data.Int
@@ -51,15 +52,18 @@ instance PathPiece S.Text
51instance PathPiece L.Text
52instance PathPiece L.Text
52instance PathPiece Day
53instance PathPiece Day
53
54
55+-- | Wrapped @'PathPiece'@ value.
56+newtype WrappedPathPiece a = WrappedPathPiece { unwrapPathPiece :: a }
57+
58+instance PathPiece a => ToHttpApiData (WrappedPathPiece a) where
59+ toUrlPiece = toPathPiece . unwrapPathPiece
60+
61+instance PathPiece a => FromHttpApiData (WrappedPathPiece a) where
62+ parseUrlPiece = fmap WrappedPathPiece . parseMaybeHttpApiData fromPathPiece
63+
54−instance (PathPiece a) => PathPiece (Maybe a) where
64+instance PathPiece a => PathPiece (Maybe a) where
55− fromPathPiece s = case S.stripPrefix "Just " s of
65+ toPathPiece = toUrlPiece . fmap WrappedPathPiece
56− Just r -> Just `fmap` fromPathPiece r
66+ fromPathPiece = either (const Nothing) (Just . fmap unwrapPathPiece) . parseUrlPiece
57− _ -> case s of
58− "Nothing" -> Just Nothing
59− _ -> Nothing
60− toPathPiece m = case m of
61− Just s -> "Just " `S.append` toPathPiece s
62− _ -> "Nothing"
63
67
64-- | Convert Haskell values to and from sequence of route pieces.
68-- | Convert Haskell values to and from sequence of route pieces.
65class PathMultiPiece s where
69class PathMultiPiece s where