git.iko.soy/typeable/http-api-data
on master help sign in
Merge pull request #13 from fizruk/tuple-maybe-instances
9b260fbNickolay Kudasov
Web/HttpApiData.hs+38−2
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
@@ -73,11 +75,15 @@ class FromHttpApiData a where
73 parseQueryParam :: Text -> Either Text a
75 parseQueryParam :: Text -> Either Text a
74 parseQueryParam = parseUrlPiece
76 parseQueryParam = parseUrlPiece
75
77
78+-- | Default parsing error.
79+defaultParseError :: Text -> Either Text a
80+defaultParseError input = Left ("could not convert: `" <> input <> "'")
81+
76-- | Convert @'Maybe'@ parser into @'Either' 'Text'@ parser with default error message.
82-- | Convert @'Maybe'@ parser into @'Either' 'Text'@ parser with default error message.
77parseMaybeHttpApiData :: (Text -> Maybe a) -> (Text -> Either Text a)
83parseMaybeHttpApiData :: (Text -> Maybe a) -> (Text -> Either Text a)
78parseMaybeHttpApiData parse input =
84parseMaybeHttpApiData parse input =
79 case parse input of
85 case parse input of
80− Nothing -> Left ("could not convert: `" <> input <> "'")
86+ Nothing -> defaultParseError input
81 Just val -> Right val
87 Just val -> Right val
82
88
83-- | Convert to URL piece using @'Show'@ instance.
89-- | Convert to URL piece using @'Show'@ instance.
@@ -99,7 +105,7 @@ runReader reader input =
99 Left err -> Left (T.pack err)
105 Left err -> Left (T.pack err)
100 Right (x, rest)
106 Right (x, rest)
101 | T.null rest -> Right x
107 | T.null rest -> Right x
102− | otherwise -> Left ("could not convert: `" <> input <> "'")
108+ | otherwise -> defaultParseError input
103
109
104-- | Run @'Reader'@ to parse bounded integral value with bounds checking.
110-- | Run @'Reader'@ to parse bounded integral value with bounds checking.
105parseBounded :: forall a. (Bounded a, Integral a) => Reader Integer -> Text -> Either Text a
111parseBounded :: forall a. (Bounded a, Integral a) => Reader Integer -> Text -> Either Text a
@@ -112,6 +118,12 @@ parseBounded reader input = do
112 l = toInteger (minBound :: a)
118 l = toInteger (minBound :: a)
113 h = toInteger (maxBound :: a)
119 h = toInteger (maxBound :: a)
114
120
121+-- |
122+-- >>> toUrlPiece ()
123+-- "_"
124+instance ToHttpApiData () where
125+ toUrlPiece () = "_"
126+
115instance ToHttpApiData Bool where toUrlPiece = showUrlPiece
127instance ToHttpApiData Bool where toUrlPiece = showUrlPiece
116instance ToHttpApiData Double where toUrlPiece = showUrlPiece
128instance ToHttpApiData Double where toUrlPiece = showUrlPiece
117instance ToHttpApiData Float where toUrlPiece = showUrlPiece
129instance ToHttpApiData Float where toUrlPiece = showUrlPiece
@@ -131,6 +143,20 @@ instance ToHttpApiData Text where toUrlPiece = id
131instance ToHttpApiData L.Text where toUrlPiece = L.toStrict
143instance ToHttpApiData L.Text where toUrlPiece = L.toStrict
132instance ToHttpApiData Day where toUrlPiece = showUrlPiece
144instance ToHttpApiData Day where toUrlPiece = showUrlPiece
133
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+
153+-- |
154+-- >>> parseUrlPiece "_" :: Either Text ()
155+-- Right ()
156+instance FromHttpApiData () where
157+ parseUrlPiece "_" = return ()
158+ parseUrlPiece s = defaultParseError s
159+
134instance FromHttpApiData Bool where parseUrlPiece = readEitherUrlPiece
160instance FromHttpApiData Bool where parseUrlPiece = readEitherUrlPiece
135instance FromHttpApiData Double where parseUrlPiece = runReader rational
161instance FromHttpApiData Double where parseUrlPiece = runReader rational
136instance FromHttpApiData Float where parseUrlPiece = runReader rational
162instance FromHttpApiData Float where parseUrlPiece = runReader rational
@@ -150,6 +176,16 @@ instance FromHttpApiData Text where parseUrlPiece = Right
150instance FromHttpApiData L.Text where parseUrlPiece = Right . L.fromStrict
176instance FromHttpApiData L.Text where parseUrlPiece = Right . L.fromStrict
151instance FromHttpApiData Day where parseUrlPiece = readEitherUrlPiece
177instance FromHttpApiData Day where parseUrlPiece = readEitherUrlPiece
152
178
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+
153-- $examples
189-- $examples
154--
190--
155-- Booleans:
191-- Booleans:
Web/PathPieces.hs+13−12
@@ -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
@@ -32,6 +33,7 @@ class PathPiece s where
32 default toPathPiece :: ToHttpApiData s => s -> S.Text
33 default toPathPiece :: ToHttpApiData s => s -> S.Text
33 toPathPiece = toUrlPiece
34 toPathPiece = toUrlPiece
34
35
36+instance PathPiece ()
35instance PathPiece Bool
37instance PathPiece Bool
36instance PathPiece Double
38instance PathPiece Double
37instance PathPiece Float
39instance PathPiece Float
@@ -50,19 +52,18 @@ instance PathPiece S.Text
50instance PathPiece L.Text
52instance PathPiece L.Text
51instance PathPiece Day
53instance PathPiece Day
52
54
53−instance PathPiece () where
55+-- | Wrapped @'PathPiece'@ value.
54− fromPathPiece t = if t == "_" then Just () else Nothing
56+newtype WrappedPathPiece a = WrappedPathPiece { unwrapPathPiece :: a }
55− toPathPiece () = "_"
56
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+
57−instance (PathPiece a) => PathPiece (Maybe a) where
64+instance PathPiece a => PathPiece (Maybe a) where
58− fromPathPiece s = case S.stripPrefix "Just " s of
65+ toPathPiece = toUrlPiece . fmap WrappedPathPiece
59− Just r -> Just `fmap` fromPathPiece r
66+ fromPathPiece = either (const Nothing) (Just . fmap unwrapPathPiece) . parseUrlPiece
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"
66
67
67-- | Convert Haskell values to and from sequence of route pieces.
68-- | Convert Haskell values to and from sequence of route pieces.
68class PathMultiPiece s where
69class PathMultiPiece s where
test/main.hs+1
@@ -34,6 +34,7 @@ main = hspec spec
34spec :: Spec
34spec :: Spec
35spec = do
35spec = do
36 describe "PathPiece" $ do
36 describe "PathPiece" $ do
37+ prop "toPathPiece <=> fromPathPiece ()" $ \(p :: ()) -> (toPathPiece <=> fromPathPiece) p
37 prop "toPathPiece <=> fromPathPiece Bool" $ \(p :: Bool) -> (toPathPiece <=> fromPathPiece) p
38 prop "toPathPiece <=> fromPathPiece Bool" $ \(p :: Bool) -> (toPathPiece <=> fromPathPiece) p
38 prop "toPathPiece <=> fromPathPiece Int" $ \(p :: Int) -> (toPathPiece <=> fromPathPiece) p
39 prop "toPathPiece <=> fromPathPiece Int" $ \(p :: Int) -> (toPathPiece <=> fromPathPiece) p
39 prop "toPathPiece <=> fromPathPiece Int8" $ \(p :: Int8) -> (toPathPiece <=> fromPathPiece) p
40 prop "toPathPiece <=> fromPathPiece Int8" $ \(p :: Int8) -> (toPathPiece <=> fromPathPiece) p