git.iko.soy/typeable/http-api-data
on master help sign in
Add instances for Version
commite79860f48fa881640499fc2634ed02b07ec4c2f3 authorNickolay Kudasov <nickolay.kudasov@gmail.com> dateTue 6 Oct 2015, 00:36 (11 years ago) parent7dc6866
3 files changed+43−17
compare with master
unifiedsplit
Web/HttpApiData.hs+17 Web/PathPieces.hs+2 test/main.hs+24−17
Web/HttpApiData.hs+17
@@ -36,8 +36,10 @@ import qualified Data.Text as T
3636import qualified Data.Text.Lazy as L
3737
3838import Data.Time (Day)
39+import Data.Version
3940
4041import Text.Read (readMaybe)
42+import Text.ParserCombinators.ReadP (readP_to_S)
4143
4244-- $setup
4345--
@@ -126,6 +128,12 @@ instance ToHttpApiData () where
126128
127129instance ToHttpApiData Char where toUrlPiece = T.singleton
128130
131+-- |
132+-- >>> toUrlPiece (makeVersion [1, 2, 3])
133+-- "1.2.3"
134+instance ToHttpApiData Version where
135+ toUrlPiece = T.pack . showVersion
136+
129137instance ToHttpApiData Bool where toUrlPiece = showUrlPiece
130138instance ToHttpApiData Double where toUrlPiece = showUrlPiece
131139instance ToHttpApiData Float where toUrlPiece = showUrlPiece
@@ -165,6 +173,15 @@ instance FromHttpApiData Char where
165173 Just (c, s') | T.null s' -> return c
166174 _ -> defaultParseError s
167175
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+
168185instance FromHttpApiData Bool where parseUrlPiece = readEitherUrlPiece
169186instance FromHttpApiData Double where parseUrlPiece = runReader rational
170187instance FromHttpApiData Float where parseUrlPiece = runReader rational
Web/PathPieces.hs+2
@@ -16,6 +16,7 @@ import Data.Int
1616import Data.Word
1717import qualified Data.Text as S
1818import qualified Data.Text.Lazy as L
19+import Data.Version (Version)
1920import Data.Time (Day)
2021import Text.Read (readMaybe)
2122
@@ -52,6 +53,7 @@ instance PathPiece String
5253instance PathPiece S.Text
5354instance PathPiece L.Text
5455instance PathPiece Day
56+instance PathPiece Version
5557
5658-- | Wrapped @'PathPiece'@ value.
5759newtype WrappedPathPiece a = WrappedPathPiece { unwrapPathPiece :: a }
test/main.hs+24−17
@@ -9,6 +9,7 @@ import Data.Word
99import Data.Time
1010import qualified Data.Text as T
1111import qualified Data.Text.Lazy as L
12+import Data.Version
1213
1314import Test.Hspec
1415import Test.Hspec.QuickCheck(prop)
@@ -25,6 +26,11 @@ instance Arbitrary L.Text where
2526instance Arbitrary Day where
2627 arbitrary = liftA3 fromGregorian (fmap abs arbitrary) arbitrary arbitrary
2728
29+instance Arbitrary Version where
30+ arbitrary = (makeVersion . map abs) <$> nonempty
31+ where
32+ nonempty = liftA2 (:) arbitrary arbitrary
33+
2834main :: IO ()
2935main = hspec spec
3036
@@ -34,23 +40,24 @@ main = hspec spec
3440spec :: Spec
3541spec = do
3642 describe "PathPiece" $ do
37− prop "toPathPiece <=> fromPathPiece ()" $ \(p :: ()) -> (toPathPiece <=> fromPathPiece) p
38− prop "toPathPiece <=> fromPathPiece Char" $ \(p :: Char) -> (toPathPiece <=> fromPathPiece) p
39− prop "toPathPiece <=> fromPathPiece Bool" $ \(p :: Bool) -> (toPathPiece <=> fromPathPiece) p
40− prop "toPathPiece <=> fromPathPiece Int" $ \(p :: Int) -> (toPathPiece <=> fromPathPiece) p
41− prop "toPathPiece <=> fromPathPiece Int8" $ \(p :: Int8) -> (toPathPiece <=> fromPathPiece) p
42− prop "toPathPiece <=> fromPathPiece Int16" $ \(p :: Int16) -> (toPathPiece <=> fromPathPiece) p
43− prop "toPathPiece <=> fromPathPiece Int32" $ \(p :: Int32) -> (toPathPiece <=> fromPathPiece) p
44− prop "toPathPiece <=> fromPathPiece Word" $ \(p :: Word) -> (toPathPiece <=> fromPathPiece) p
45− prop "toPathPiece <=> fromPathPiece Word8" $ \(p :: Word8) -> (toPathPiece <=> fromPathPiece) p
46− prop "toPathPiece <=> fromPathPiece Word16" $ \(p :: Word16) -> (toPathPiece <=> fromPathPiece) p
47− prop "toPathPiece <=> fromPathPiece Word32" $ \(p :: Word32) -> (toPathPiece <=> fromPathPiece) p
48− prop "toPathPiece <=> fromPathPiece Word64" $ \(p :: Word64) -> (toPathPiece <=> fromPathPiece) p
49− prop "toPathPiece <=> fromPathPiece Word64" $ \(p :: Word64) -> (toPathPiece <=> fromPathPiece) p
50− prop "toPathPiece <=> fromPathPiece String" $ \(p :: String) -> (toPathPiece <=> fromPathPiece) p
51− prop "toPathPiece <=> fromPathPiece Text.Strict" $ \(p :: T.Text) -> (toPathPiece <=> fromPathPiece) p
52− prop "toPathPiece <=> fromPathPiece Text.Lazy" $ \(p :: L.Text) -> (toPathPiece <=> fromPathPiece) p
53− prop "toPathPiece <=> fromPathPiece Day" $ \(p :: Day) -> (toPathPiece <=> fromPathPiece) p
43+ prop "toPathPiece <=> fromPathPiece ()" $ \(p :: ()) -> (toPathPiece <=> fromPathPiece) p
44+ prop "toPathPiece <=> fromPathPiece Char" $ \(p :: Char) -> (toPathPiece <=> fromPathPiece) p
45+ prop "toPathPiece <=> fromPathPiece Bool" $ \(p :: Bool) -> (toPathPiece <=> fromPathPiece) p
46+ prop "toPathPiece <=> fromPathPiece Int" $ \(p :: Int) -> (toPathPiece <=> fromPathPiece) p
47+ prop "toPathPiece <=> fromPathPiece Int8" $ \(p :: Int8) -> (toPathPiece <=> fromPathPiece) p
48+ prop "toPathPiece <=> fromPathPiece Int16" $ \(p :: Int16) -> (toPathPiece <=> fromPathPiece) p
49+ prop "toPathPiece <=> fromPathPiece Int32" $ \(p :: Int32) -> (toPathPiece <=> fromPathPiece) p
50+ prop "toPathPiece <=> fromPathPiece Word" $ \(p :: Word) -> (toPathPiece <=> fromPathPiece) p
51+ prop "toPathPiece <=> fromPathPiece Word8" $ \(p :: Word8) -> (toPathPiece <=> fromPathPiece) p
52+ prop "toPathPiece <=> fromPathPiece Word16" $ \(p :: Word16) -> (toPathPiece <=> fromPathPiece) p
53+ prop "toPathPiece <=> fromPathPiece Word32" $ \(p :: Word32) -> (toPathPiece <=> fromPathPiece) p
54+ prop "toPathPiece <=> fromPathPiece Word64" $ \(p :: Word64) -> (toPathPiece <=> fromPathPiece) p
55+ prop "toPathPiece <=> fromPathPiece Word64" $ \(p :: Word64) -> (toPathPiece <=> fromPathPiece) p
56+ prop "toPathPiece <=> fromPathPiece String" $ \(p :: String) -> (toPathPiece <=> fromPathPiece) p
57+ prop "toPathPiece <=> fromPathPiece Text.Strict" $ \(p :: T.Text) -> (toPathPiece <=> fromPathPiece) p
58+ prop "toPathPiece <=> fromPathPiece Text.Lazy" $ \(p :: L.Text) -> (toPathPiece <=> fromPathPiece) p
59+ prop "toPathPiece <=> fromPathPiece Day" $ \(p :: Day) -> (toPathPiece <=> fromPathPiece) p
60+ prop "toPathPiece <=> fromPathPiece Version" $ \(p :: Version) -> (toPathPiece <=> fromPathPiece) p
5461
5562 prop "toPathPiece <=> fromPathPiece Maybe String" $ \(p::Maybe String) -> (toPathPiece <=> fromPathPiece) p
5663