git.iko.soy/typeable/http-api-data
on master help sign in
Add instances for Version
e79860fNickolay Kudasov
Web/HttpApiData.hs+17
compare with master
unifiedsplit
@@ -36,8 +36,10 @@ import qualified Data.Text as T
36import qualified Data.Text.Lazy as L
36import qualified Data.Text.Lazy as L
37
37
38import Data.Time (Day)
38import Data.Time (Day)
39+import Data.Version
39
40
40import Text.Read (readMaybe)
41import Text.Read (readMaybe)
42+import Text.ParserCombinators.ReadP (readP_to_S)
41
43
42-- $setup
44-- $setup
43--
45--
@@ -126,6 +128,12 @@ instance ToHttpApiData () where
126
128
127instance ToHttpApiData Char where toUrlPiece = T.singleton
129instance ToHttpApiData Char where toUrlPiece = T.singleton
128
130
131+-- |
132+-- >>> toUrlPiece (makeVersion [1, 2, 3])
133+-- "1.2.3"
134+instance ToHttpApiData Version where
135+ toUrlPiece = T.pack . showVersion
136+
129instance ToHttpApiData Bool where toUrlPiece = showUrlPiece
137instance ToHttpApiData Bool where toUrlPiece = showUrlPiece
130instance ToHttpApiData Double where toUrlPiece = showUrlPiece
138instance ToHttpApiData Double where toUrlPiece = showUrlPiece
131instance ToHttpApiData Float where toUrlPiece = showUrlPiece
139instance ToHttpApiData Float where toUrlPiece = showUrlPiece
@@ -165,6 +173,15 @@ instance FromHttpApiData Char where
165 Just (c, s') | T.null s' -> return c
173 Just (c, s') | T.null s' -> return c
166 _ -> defaultParseError s
174 _ -> defaultParseError s
167
175
176+-- |
177+-- >>> showVersion <$> parseUrlPiece "1.2.3"
178+-- 1.2.3
179+instance FromHttpApiData Version where
180+ parseUrlPiece s =
181+ case reverse (readP_to_S parseVersion (T.unpack s)) of
182+ ((x, ""):_) -> return x
183+ _ -> defaultParseError s
184+
168instance FromHttpApiData Bool where parseUrlPiece = readEitherUrlPiece
185instance FromHttpApiData Bool where parseUrlPiece = readEitherUrlPiece
169instance FromHttpApiData Double where parseUrlPiece = runReader rational
186instance FromHttpApiData Double where parseUrlPiece = runReader rational
170instance FromHttpApiData Float where parseUrlPiece = runReader rational
187instance FromHttpApiData Float where parseUrlPiece = runReader rational
Web/PathPieces.hs+2
@@ -16,6 +16,7 @@ import Data.Int
16import Data.Word
16import Data.Word
17import qualified Data.Text as S
17import qualified Data.Text as S
18import qualified Data.Text.Lazy as L
18import qualified Data.Text.Lazy as L
19+import Data.Version (Version)
19import Data.Time (Day)
20import Data.Time (Day)
20import Text.Read (readMaybe)
21import Text.Read (readMaybe)
21
22
@@ -52,6 +53,7 @@ instance PathPiece String
52instance PathPiece S.Text
53instance PathPiece S.Text
53instance PathPiece L.Text
54instance PathPiece L.Text
54instance PathPiece Day
55instance PathPiece Day
56+instance PathPiece Version
55
57
56-- | Wrapped @'PathPiece'@ value.
58-- | Wrapped @'PathPiece'@ value.
57newtype WrappedPathPiece a = WrappedPathPiece { unwrapPathPiece :: a }
59newtype WrappedPathPiece a = WrappedPathPiece { unwrapPathPiece :: a }
test/main.hs+24−17
@@ -9,6 +9,7 @@ import Data.Word
9import Data.Time
9import Data.Time
10import qualified Data.Text as T
10import qualified Data.Text as T
11import qualified Data.Text.Lazy as L
11import qualified Data.Text.Lazy as L
12+import Data.Version
12
13
13import Test.Hspec
14import Test.Hspec
14import Test.Hspec.QuickCheck(prop)
15import Test.Hspec.QuickCheck(prop)
@@ -25,6 +26,11 @@ instance Arbitrary L.Text where
25instance Arbitrary Day where
26instance Arbitrary Day where
26 arbitrary = liftA3 fromGregorian (fmap abs arbitrary) arbitrary arbitrary
27 arbitrary = liftA3 fromGregorian (fmap abs arbitrary) arbitrary arbitrary
27
28
29+instance Arbitrary Version where
30+ arbitrary = (makeVersion . map abs) <$> nonempty
31+ where
32+ nonempty = liftA2 (:) arbitrary arbitrary
33+
28main :: IO ()
34main :: IO ()
29main = hspec spec
35main = hspec spec
30
36
@@ -34,23 +40,24 @@ main = hspec spec
34spec :: Spec
40spec :: Spec
35spec = do
41spec = do
36 describe "PathPiece" $ do
42 describe "PathPiece" $ do
37− prop "toPathPiece <=> fromPathPiece ()" $ \(p :: ()) -> (toPathPiece <=> fromPathPiece) p
43+ prop "toPathPiece <=> fromPathPiece ()" $ \(p :: ()) -> (toPathPiece <=> fromPathPiece) p
38− prop "toPathPiece <=> fromPathPiece Char" $ \(p :: Char) -> (toPathPiece <=> fromPathPiece) p
44+ prop "toPathPiece <=> fromPathPiece Char" $ \(p :: Char) -> (toPathPiece <=> fromPathPiece) p
39− prop "toPathPiece <=> fromPathPiece Bool" $ \(p :: Bool) -> (toPathPiece <=> fromPathPiece) p
45+ prop "toPathPiece <=> fromPathPiece Bool" $ \(p :: Bool) -> (toPathPiece <=> fromPathPiece) p
40− prop "toPathPiece <=> fromPathPiece Int" $ \(p :: Int) -> (toPathPiece <=> fromPathPiece) p
46+ prop "toPathPiece <=> fromPathPiece Int" $ \(p :: Int) -> (toPathPiece <=> fromPathPiece) p
41− prop "toPathPiece <=> fromPathPiece Int8" $ \(p :: Int8) -> (toPathPiece <=> fromPathPiece) p
47+ prop "toPathPiece <=> fromPathPiece Int8" $ \(p :: Int8) -> (toPathPiece <=> fromPathPiece) p
42− prop "toPathPiece <=> fromPathPiece Int16" $ \(p :: Int16) -> (toPathPiece <=> fromPathPiece) p
48+ prop "toPathPiece <=> fromPathPiece Int16" $ \(p :: Int16) -> (toPathPiece <=> fromPathPiece) p
43− prop "toPathPiece <=> fromPathPiece Int32" $ \(p :: Int32) -> (toPathPiece <=> fromPathPiece) p
49+ prop "toPathPiece <=> fromPathPiece Int32" $ \(p :: Int32) -> (toPathPiece <=> fromPathPiece) p
44− prop "toPathPiece <=> fromPathPiece Word" $ \(p :: Word) -> (toPathPiece <=> fromPathPiece) p
50+ prop "toPathPiece <=> fromPathPiece Word" $ \(p :: Word) -> (toPathPiece <=> fromPathPiece) p
45− prop "toPathPiece <=> fromPathPiece Word8" $ \(p :: Word8) -> (toPathPiece <=> fromPathPiece) p
51+ prop "toPathPiece <=> fromPathPiece Word8" $ \(p :: Word8) -> (toPathPiece <=> fromPathPiece) p
46− prop "toPathPiece <=> fromPathPiece Word16" $ \(p :: Word16) -> (toPathPiece <=> fromPathPiece) p
52+ prop "toPathPiece <=> fromPathPiece Word16" $ \(p :: Word16) -> (toPathPiece <=> fromPathPiece) p
47− prop "toPathPiece <=> fromPathPiece Word32" $ \(p :: Word32) -> (toPathPiece <=> fromPathPiece) p
53+ prop "toPathPiece <=> fromPathPiece Word32" $ \(p :: Word32) -> (toPathPiece <=> fromPathPiece) p
48− prop "toPathPiece <=> fromPathPiece Word64" $ \(p :: Word64) -> (toPathPiece <=> fromPathPiece) p
54+ prop "toPathPiece <=> fromPathPiece Word64" $ \(p :: Word64) -> (toPathPiece <=> fromPathPiece) p
49− prop "toPathPiece <=> fromPathPiece Word64" $ \(p :: Word64) -> (toPathPiece <=> fromPathPiece) p
55+ prop "toPathPiece <=> fromPathPiece Word64" $ \(p :: Word64) -> (toPathPiece <=> fromPathPiece) p
50− prop "toPathPiece <=> fromPathPiece String" $ \(p :: String) -> (toPathPiece <=> fromPathPiece) p
56+ prop "toPathPiece <=> fromPathPiece String" $ \(p :: String) -> (toPathPiece <=> fromPathPiece) p
51− prop "toPathPiece <=> fromPathPiece Text.Strict" $ \(p :: T.Text) -> (toPathPiece <=> fromPathPiece) p
57+ prop "toPathPiece <=> fromPathPiece Text.Strict" $ \(p :: T.Text) -> (toPathPiece <=> fromPathPiece) p
52− prop "toPathPiece <=> fromPathPiece Text.Lazy" $ \(p :: L.Text) -> (toPathPiece <=> fromPathPiece) p
58+ prop "toPathPiece <=> fromPathPiece Text.Lazy" $ \(p :: L.Text) -> (toPathPiece <=> fromPathPiece) p
53− prop "toPathPiece <=> fromPathPiece Day" $ \(p :: Day) -> (toPathPiece <=> fromPathPiece) p
59+ prop "toPathPiece <=> fromPathPiece Day" $ \(p :: Day) -> (toPathPiece <=> fromPathPiece) p
60+ prop "toPathPiece <=> fromPathPiece Version" $ \(p :: Version) -> (toPathPiece <=> fromPathPiece) p
54
61
55 prop "toPathPiece <=> fromPathPiece Maybe String" $ \(p::Maybe String) -> (toPathPiece <=> fromPathPiece) p
62 prop "toPathPiece <=> fromPathPiece Maybe String" $ \(p::Maybe String) -> (toPathPiece <=> fromPathPiece) p
56
63