git.iko.soy/typeable/http-api-data
on master help sign in
Add To/FromHttpApiData instances for Maybe and add WrappedPathPiece
commit274f458c6964d6102f1cca3af6ce259e4434d51d authorNickolay Kudasov <nickolay.kudasov@gmail.com> dateMon 5 Oct 2015, 18:57 (11 years ago) parent3cb3fe6
2 files changed+33−10
Web/HttpApiData.hs+20−1 Web/PathPieces.hs+13−9
Web/HttpApiData.hs+20−1
@@ -21,6 +21,8 @@ module Web.HttpApiData (
2121 readEitherUrlPiece,
2222) where
2323
24+import Control.Applicative
25+
2426import Data.Monoid
2527import Data.ByteString (ByteString)
2628
@@ -141,11 +143,18 @@ instance ToHttpApiData Text where toUrlPiece = id
141143instance ToHttpApiData L.Text where toUrlPiece = L.toStrict
142144instance ToHttpApiData Day where toUrlPiece = showUrlPiece
143145
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+
144153-- |
145154-- >>> parseUrlPiece "_" :: Either Text ()
146155-- Right ()
147156instance FromHttpApiData () where
148− parseUrlPiece "_" = pure ()
157+ parseUrlPiece "_" = return ()
149158 parseUrlPiece s = defaultParseError s
150159
151160instance FromHttpApiData Bool where parseUrlPiece = readEitherUrlPiece
@@ -167,6 +176,16 @@ instance FromHttpApiData Text where parseUrlPiece = Right
167176instance FromHttpApiData L.Text where parseUrlPiece = Right . L.fromStrict
168177instance FromHttpApiData Day where parseUrlPiece = readEitherUrlPiece
169178
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+
170189-- $examples
171190--
172191-- Booleans:
Web/PathPieces.hs+13−9
@@ -9,6 +9,7 @@ module Web.PathPieces (
99 PathMultiPiece (..),
1010 readFromPathPiece,
1111 showToPathPiece,
12+ WrappedPathPiece(..),
1213) where
1314
1415import Data.Int
@@ -51,15 +52,18 @@ instance PathPiece S.Text
5152instance PathPiece L.Text
5253instance PathPiece Day
5354
54−instance (PathPiece a) => PathPiece (Maybe a) where
55− fromPathPiece s = case S.stripPrefix "Just " s of
56− Just r -> Just `fmap` fromPathPiece r
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"
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+
64+instance PathPiece a => PathPiece (Maybe a) where
65+ toPathPiece = toUrlPiece . fmap WrappedPathPiece
66+ fromPathPiece = either (const Nothing) (Just . fmap unwrapPathPiece) . parseUrlPiece
6367
6468-- | Convert Haskell values to and from sequence of route pieces.
6569class PathMultiPiece s where