git.iko.soy/typeable/http-api-data
on master help sign in
Merge pull request #13 from fizruk/tuple-maybe-instances

Instances for () and Maybe

commit9b260fba027dd192016d4ef90f91ede60a474edc authorNickolay Kudasov <fizruk@users.noreply.github.com> dateMon 5 Oct 2015, 23:45 (11 years ago) parentfec05beab7e794
3 files changed+52−14
compare with master
unifiedsplit
Web/HttpApiData.hs+38−2 Web/PathPieces.hs+13−12 test/main.hs+1
Web/HttpApiData.hs+38−2
@@ -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
@@ -73,11 +75,15 @@ class FromHttpApiData a where
7375 parseQueryParam :: Text -> Either Text a
7476 parseQueryParam = parseUrlPiece
7577
78+-- | Default parsing error.
79+defaultParseError :: Text -> Either Text a
80+defaultParseError input = Left ("could not convert: `" <> input <> "'")
81+
7682-- | Convert @'Maybe'@ parser into @'Either' 'Text'@ parser with default error message.
7783parseMaybeHttpApiData :: (Text -> Maybe a) -> (Text -> Either Text a)
7884parseMaybeHttpApiData parse input =
7985 case parse input of
80− Nothing -> Left ("could not convert: `" <> input <> "'")
86+ Nothing -> defaultParseError input
8187 Just val -> Right val
8288
8389-- | Convert to URL piece using @'Show'@ instance.
@@ -99,7 +105,7 @@ runReader reader input =
99105 Left err -> Left (T.pack err)
100106 Right (x, rest)
101107 | T.null rest -> Right x
102− | otherwise -> Left ("could not convert: `" <> input <> "'")
108+ | otherwise -> defaultParseError input
103109
104110-- | Run @'Reader'@ to parse bounded integral value with bounds checking.
105111parseBounded :: forall a. (Bounded a, Integral a) => Reader Integer -> Text -> Either Text a
@@ -112,6 +118,12 @@ parseBounded reader input = do
112118 l = toInteger (minBound :: a)
113119 h = toInteger (maxBound :: a)
114120
121+-- |
122+-- >>> toUrlPiece ()
123+-- "_"
124+instance ToHttpApiData () where
125+ toUrlPiece () = "_"
126+
115127instance ToHttpApiData Bool where toUrlPiece = showUrlPiece
116128instance ToHttpApiData Double where toUrlPiece = showUrlPiece
117129instance ToHttpApiData Float where toUrlPiece = showUrlPiece
@@ -131,6 +143,20 @@ instance ToHttpApiData Text where toUrlPiece = id
131143instance ToHttpApiData L.Text where toUrlPiece = L.toStrict
132144instance ToHttpApiData Day where toUrlPiece = showUrlPiece
133145
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+
153+-- |
154+-- >>> parseUrlPiece "_" :: Either Text ()
155+-- Right ()
156+instance FromHttpApiData () where
157+ parseUrlPiece "_" = return ()
158+ parseUrlPiece s = defaultParseError s
159+
134160instance FromHttpApiData Bool where parseUrlPiece = readEitherUrlPiece
135161instance FromHttpApiData Double where parseUrlPiece = runReader rational
136162instance FromHttpApiData Float where parseUrlPiece = runReader rational
@@ -150,6 +176,16 @@ instance FromHttpApiData Text where parseUrlPiece = Right
150176instance FromHttpApiData L.Text where parseUrlPiece = Right . L.fromStrict
151177instance FromHttpApiData Day where parseUrlPiece = readEitherUrlPiece
152178
179+-- |
180+-- >>> parseUrlPiece "Just 123" :: Either Text (Maybe Int)
181+-- Right (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+
153189-- $examples
154190--
155191-- Booleans:
Web/PathPieces.hs+13−12
@@ -9,6 +9,7 @@ module Web.PathPieces (
99 PathMultiPiece (..),
1010 readFromPathPiece,
1111 showToPathPiece,
12+ WrappedPathPiece(..),
1213) where
1314
1415import Data.Int
@@ -32,6 +33,7 @@ class PathPiece s where
3233 default toPathPiece :: ToHttpApiData s => s -> S.Text
3334 toPathPiece = toUrlPiece
3435
36+instance PathPiece ()
3537instance PathPiece Bool
3638instance PathPiece Double
3739instance PathPiece Float
@@ -50,19 +52,18 @@ instance PathPiece S.Text
5052instance PathPiece L.Text
5153instance PathPiece Day
5254
53−instance PathPiece () where
54− fromPathPiece t = if t == "_" then Just () else Nothing
55− toPathPiece () = "_"
55+-- | Wrapped @'PathPiece'@ value.
56+newtype WrappedPathPiece a = WrappedPathPiece { unwrapPathPiece :: a }
5657
57−instance (PathPiece a) => PathPiece (Maybe a) where
58− fromPathPiece s = case S.stripPrefix "Just " s of
59− Just r -> Just `fmap` fromPathPiece r
60− _ -> case s of
61− "Nothing" -> Just Nothing
62− _ -> Nothing
63− toPathPiece m = case m of
64− Just s -> "Just " `S.append` toPathPiece s
65− _ -> "Nothing"
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
6667
6768-- | Convert Haskell values to and from sequence of route pieces.
6869class PathMultiPiece s where
test/main.hs+1
@@ -34,6 +34,7 @@ main = hspec spec
3434spec :: Spec
3535spec = do
3636 describe "PathPiece" $ do
37+ prop "toPathPiece <=> fromPathPiece ()" $ \(p :: ()) -> (toPathPiece <=> fromPathPiece) p
3738 prop "toPathPiece <=> fromPathPiece Bool" $ \(p :: Bool) -> (toPathPiece <=> fromPathPiece) p
3839 prop "toPathPiece <=> fromPathPiece Int" $ \(p :: Int) -> (toPathPiece <=> fromPathPiece) p
3940 prop "toPathPiece <=> fromPathPiece Int8" $ \(p :: Int8) -> (toPathPiece <=> fromPathPiece) p