git.iko.soy/typeable/http-api-data
on master help sign in
Add To/FromHttpApiData instances for ()
3cb3fe6Nickolay Kudasov
Web/HttpApiData.hs+19−2
compare with master
unifiedsplit
@@ -73,11 +73,15 @@ class FromHttpApiData a where
73 parseQueryParam :: Text -> Either Text a
73 parseQueryParam :: Text -> Either Text a
74 parseQueryParam = parseUrlPiece
74 parseQueryParam = parseUrlPiece
75
75
76+-- | Default parsing error.
77+defaultParseError :: Text -> Either Text a
78+defaultParseError input = Left ("could not convert: `" <> input <> "'")
79+
76-- | Convert @'Maybe'@ parser into @'Either' 'Text'@ parser with default error message.
80-- | Convert @'Maybe'@ parser into @'Either' 'Text'@ parser with default error message.
77parseMaybeHttpApiData :: (Text -> Maybe a) -> (Text -> Either Text a)
81parseMaybeHttpApiData :: (Text -> Maybe a) -> (Text -> Either Text a)
78parseMaybeHttpApiData parse input =
82parseMaybeHttpApiData parse input =
79 case parse input of
83 case parse input of
80− Nothing -> Left ("could not convert: `" <> input <> "'")
84+ Nothing -> defaultParseError input
81 Just val -> Right val
85 Just val -> Right val
82
86
83-- | Convert to URL piece using @'Show'@ instance.
87-- | Convert to URL piece using @'Show'@ instance.
@@ -99,7 +103,7 @@ runReader reader input =
99 Left err -> Left (T.pack err)
103 Left err -> Left (T.pack err)
100 Right (x, rest)
104 Right (x, rest)
101 | T.null rest -> Right x
105 | T.null rest -> Right x
102− | otherwise -> Left ("could not convert: `" <> input <> "'")
106+ | otherwise -> defaultParseError input
103
107
104-- | Run @'Reader'@ to parse bounded integral value with bounds checking.
108-- | Run @'Reader'@ to parse bounded integral value with bounds checking.
105parseBounded :: forall a. (Bounded a, Integral a) => Reader Integer -> Text -> Either Text a
109parseBounded :: forall a. (Bounded a, Integral a) => Reader Integer -> Text -> Either Text a
@@ -112,6 +116,12 @@ parseBounded reader input = do
112 l = toInteger (minBound :: a)
116 l = toInteger (minBound :: a)
113 h = toInteger (maxBound :: a)
117 h = toInteger (maxBound :: a)
114
118
119+-- |
120+-- >>> toUrlPiece ()
121+-- "_"
122+instance ToHttpApiData () where
123+ toUrlPiece () = "_"
124+
115instance ToHttpApiData Bool where toUrlPiece = showUrlPiece
125instance ToHttpApiData Bool where toUrlPiece = showUrlPiece
116instance ToHttpApiData Double where toUrlPiece = showUrlPiece
126instance ToHttpApiData Double where toUrlPiece = showUrlPiece
117instance ToHttpApiData Float where toUrlPiece = showUrlPiece
127instance ToHttpApiData Float where toUrlPiece = showUrlPiece
@@ -131,6 +141,13 @@ instance ToHttpApiData Text where toUrlPiece = id
131instance ToHttpApiData L.Text where toUrlPiece = L.toStrict
141instance ToHttpApiData L.Text where toUrlPiece = L.toStrict
132instance ToHttpApiData Day where toUrlPiece = showUrlPiece
142instance ToHttpApiData Day where toUrlPiece = showUrlPiece
133
143
144+-- |
145+-- >>> parseUrlPiece "_" :: Either Text ()
146+-- Right ()
147+instance FromHttpApiData () where
148+ parseUrlPiece "_" = pure ()
149+ parseUrlPiece s = defaultParseError s
150+
134instance FromHttpApiData Bool where parseUrlPiece = readEitherUrlPiece
151instance FromHttpApiData Bool where parseUrlPiece = readEitherUrlPiece
135instance FromHttpApiData Double where parseUrlPiece = runReader rational
152instance FromHttpApiData Double where parseUrlPiece = runReader rational
136instance FromHttpApiData Float where parseUrlPiece = runReader rational
153instance FromHttpApiData Float where parseUrlPiece = runReader rational
Web/PathPieces.hs+1−4
@@ -32,6 +32,7 @@ class PathPiece s where
32 default toPathPiece :: ToHttpApiData s => s -> S.Text
32 default toPathPiece :: ToHttpApiData s => s -> S.Text
33 toPathPiece = toUrlPiece
33 toPathPiece = toUrlPiece
34
34
35+instance PathPiece ()
35instance PathPiece Bool
36instance PathPiece Bool
36instance PathPiece Double
37instance PathPiece Double
37instance PathPiece Float
38instance PathPiece Float
@@ -50,10 +51,6 @@ instance PathPiece S.Text
50instance PathPiece L.Text
51instance PathPiece L.Text
51instance PathPiece Day
52instance PathPiece Day
52
53
53−instance PathPiece () where
54− fromPathPiece t = if t == "_" then Just () else Nothing
55− toPathPiece () = "_"
56−
57instance (PathPiece a) => PathPiece (Maybe a) where
54instance (PathPiece a) => PathPiece (Maybe a) where
58 fromPathPiece s = case S.stripPrefix "Just " s of
55 fromPathPiece s = case S.stripPrefix "Just " s of
59 Just r -> Just `fmap` fromPathPiece r
56 Just r -> Just `fmap` fromPathPiece r
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