git.iko.soy/typeable/http-api-data
on master help sign in
toSinglePiece -> toRoutePiece
cc3e430Greg Weber
Web/PathPieces.hs+71−3
@@ -1,7 +1,9 @@
1−{-# LANGUAGE FlexibleInstances #-}
1+{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
2−{-# LANGUAGE TypeSynonymInstances #-}
3module Web.PathPieces
2module Web.PathPieces
3+ ( RoutePiece (..)
4+ , RouteMultiPiece (..)
5+ -- * Deprecated
4− ( SinglePiece (..)
6+ , SinglePiece (..)
5 , MultiPiece (..)
7 , MultiPiece (..)
6 ) where
8 ) where
7
9
@@ -10,30 +12,92 @@ import qualified Data.Text as S
10import qualified Data.Text.Lazy as L
12import qualified Data.Text.Lazy as L
11import qualified Data.Text.Read
13import qualified Data.Text.Read
12
14
15+class RoutePiece s where
16+ fromRoutePiece :: S.Text -> Maybe s
17+ toRoutePiece :: s -> S.Text
18+
19+instance RoutePiece String where
20+ fromRoutePiece s = if S.null s then Nothing else Just (S.unpack s)
21+ toRoutePiece = S.pack
22+
23+instance RoutePiece S.Text where
24+ fromRoutePiece s = if S.null s then Nothing else Just s
25+ toRoutePiece = id
26+
27+instance RoutePiece L.Text where
28+ fromRoutePiece s = if S.null s then Nothing else Just (L.fromChunks [s])
29+ toRoutePiece = S.concat . L.toChunks
30+
31+instance RoutePiece Integer where
32+ fromRoutePiece s =
33+ case Data.Text.Read.decimal s of
34+ Right (i, _) -> Just i
35+ Left _ -> Nothing
36+ toRoutePiece = S.pack . show
37+
38+instance RoutePiece Int where
39+ fromRoutePiece s =
40+ case Data.Text.Read.decimal s of
41+ Right (i, _) -> Just i
42+ Left _ -> Nothing
43+ toRoutePiece = S.pack . show
44+
45+instance RoutePiece Int64 where
46+ fromRoutePiece s =
47+ case Data.Text.Read.decimal s of
48+ Right (i, _) -> Just i
49+ Left _ -> Nothing
50+ toRoutePiece = S.pack . show
51+
52+
53+class RouteMultiPiece s where
54+ fromRouteMultiPiece :: [S.Text] -> Maybe s
55+ toRouteMultiPiece :: s -> [S.Text]
56+
57+instance RouteMultiPiece [String] where
58+ fromRouteMultiPiece = Just . map S.unpack
59+ toRouteMultiPiece = map S.pack
60+
61+instance RouteMultiPiece [S.Text] where
62+ fromRouteMultiPiece = Just
63+ toRouteMultiPiece = id
64+
65+instance RouteMultiPiece [L.Text] where
66+ fromRouteMultiPiece = Just . map (L.fromChunks . return)
67+ toRouteMultiPiece = map $ S.concat . L.toChunks
68+
69+
70+-- | deprecated api
13class SinglePiece s where
71class SinglePiece s where
14 fromSinglePiece :: S.Text -> Maybe s
72 fromSinglePiece :: S.Text -> Maybe s
15 toSinglePiece :: s -> S.Text
73 toSinglePiece :: s -> S.Text
74+
16instance SinglePiece String where
75instance SinglePiece String where
17 fromSinglePiece s = if S.null s then Nothing else Just (S.unpack s)
76 fromSinglePiece s = if S.null s then Nothing else Just (S.unpack s)
18 toSinglePiece = S.pack
77 toSinglePiece = S.pack
78+
19instance SinglePiece S.Text where
79instance SinglePiece S.Text where
20 fromSinglePiece s = if S.null s then Nothing else Just s
80 fromSinglePiece s = if S.null s then Nothing else Just s
21 toSinglePiece = id
81 toSinglePiece = id
82+
22instance SinglePiece L.Text where
83instance SinglePiece L.Text where
23 fromSinglePiece s = if S.null s then Nothing else Just (L.fromChunks [s])
84 fromSinglePiece s = if S.null s then Nothing else Just (L.fromChunks [s])
24 toSinglePiece = S.concat . L.toChunks
85 toSinglePiece = S.concat . L.toChunks
86+
25instance SinglePiece Integer where
87instance SinglePiece Integer where
26 fromSinglePiece s =
88 fromSinglePiece s =
27 case Data.Text.Read.decimal s of
89 case Data.Text.Read.decimal s of
28 Right (i, _) -> Just i
90 Right (i, _) -> Just i
29 Left _ -> Nothing
91 Left _ -> Nothing
30 toSinglePiece = S.pack . show
92 toSinglePiece = S.pack . show
93+
31instance SinglePiece Int where
94instance SinglePiece Int where
32 fromSinglePiece s =
95 fromSinglePiece s =
33 case Data.Text.Read.decimal s of
96 case Data.Text.Read.decimal s of
34 Right (i, _) -> Just i
97 Right (i, _) -> Just i
35 Left _ -> Nothing
98 Left _ -> Nothing
36 toSinglePiece = S.pack . show
99 toSinglePiece = S.pack . show
100+
37instance SinglePiece Int64 where
101instance SinglePiece Int64 where
38 fromSinglePiece s =
102 fromSinglePiece s =
39 case Data.Text.Read.decimal s of
103 case Data.Text.Read.decimal s of
@@ -41,15 +105,19 @@ instance SinglePiece Int64 where
41 Left _ -> Nothing
105 Left _ -> Nothing
42 toSinglePiece = S.pack . show
106 toSinglePiece = S.pack . show
43
107
108+
44class MultiPiece s where
109class MultiPiece s where
45 fromMultiPiece :: [S.Text] -> Maybe s
110 fromMultiPiece :: [S.Text] -> Maybe s
46 toMultiPiece :: s -> [S.Text]
111 toMultiPiece :: s -> [S.Text]
112+
47instance MultiPiece [String] where
113instance MultiPiece [String] where
48 fromMultiPiece = Just . map S.unpack
114 fromMultiPiece = Just . map S.unpack
49 toMultiPiece = map S.pack
115 toMultiPiece = map S.pack
116+
50instance MultiPiece [S.Text] where
117instance MultiPiece [S.Text] where
51 fromMultiPiece = Just
118 fromMultiPiece = Just
52 toMultiPiece = id
119 toMultiPiece = id
120+
53instance MultiPiece [L.Text] where
121instance MultiPiece [L.Text] where
54 fromMultiPiece = Just . map (L.fromChunks . return)
122 fromMultiPiece = Just . map (L.fromChunks . return)
55 toMultiPiece = map $ S.concat . L.toChunks
123 toMultiPiece = map $ S.concat . L.toChunks
path-pieces.cabal+14−1
@@ -7,7 +7,7 @@ maintainer: Michael Snoyman <michael@snoyman.com>
7synopsis: Components of paths.
7synopsis: Components of paths.
8category: Web, Yesod
8category: Web, Yesod
9stability: unstable
9stability: unstable
10−cabal-version: >= 1.6
10+cabal-version: >= 1.8
11build-type: Simple
11build-type: Simple
12homepage: http://github.com/snoyberg/path-pieces
12homepage: http://github.com/snoyberg/path-pieces
13
13
@@ -17,6 +17,19 @@ library
17 exposed-modules: Web.PathPieces
17 exposed-modules: Web.PathPieces
18 ghc-options: -Wall
18 ghc-options: -Wall
19
19
20+test-suite test
21+ type: exitcode-stdio-1.0
22+ main-is: main.hs
23+ hs-source-dirs: test
24+ ghc-options: -Wall
25+ build-depends: HUnit
26+ , hspec >= 0.8 && < 0.9
27+ , file-location >= 0.4 && < 0.5
28+ , base >= 4 && < 5
29+ , QuickCheck == 2.4.*
30+ , path-pieces
31+ , text
32+
20source-repository head
33source-repository head
21 type: git
34 type: git
22 location: git://github.com/snoyberg/path-pieces.git
35 location: git://github.com/snoyberg/path-pieces.git
test/main.hsnew file+70
@@ -0,0 +1,70 @@
1+{-# Language ScopedTypeVariables #-}
2+{-# OPTIONS_GHC -fno-warn-orphans #-}
3+module Main where
4+
5+import Test.Hspec.Monadic (Specs, describe, hspecX)
6+import Test.Hspec.HUnit()
7+import Test.Hspec.QuickCheck(prop)
8+import Test.QuickCheck
9+
10+import Web.PathPieces
11+import qualified Data.Text as T
12+import Data.Maybe (fromJust)
13+
14+-- import FileLocation (debug)
15+
16+instance Arbitrary T.Text where
17+ arbitrary = fmap T.pack arbitrary
18+
19+
20+main :: IO ()
21+main = hspecX specs
22+
23+specs :: Specs
24+specs = do
25+ describe "RoutePiece" $ do
26+ prop "toRoutePiece <=> fromSinglePiece String" $ \(p::String) ->
27+ case (fromRoutePiece . toSinglePiece) p of
28+ Nothing -> null p
29+ Just pConverted -> p == pConverted
30+
31+ prop "toRoutePiece <=> fromSinglePiece String" $ \(p::T.Text) ->
32+ case (fromRoutePiece . toSinglePiece) p of
33+ Nothing -> T.null p
34+ Just pConverted -> p == pConverted
35+
36+ prop "toRoutePiece <=> fromSinglePiece String" $ \(p::Int) ->
37+ case (fromRoutePiece . toSinglePiece) p of
38+ Nothing -> p < 0
39+ Just pConverted -> p == pConverted
40+
41+ describe "RouteMultiPiece" $ do
42+ prop "toRouteMultiPiece <=> fromMultiPiece String" $ \(p::[String]) ->
43+ p == (fromJust . fromRouteMultiPiece . toMultiPiece) p
44+
45+ prop "toRouteMultiPiece <=> fromMultiPiece String" $ \(p::[T.Text]) ->
46+ p == (fromJust . fromRouteMultiPiece . toMultiPiece) p
47+
48+
49+ describe "SinglePiece" $ do
50+ prop "toSinglePiece <=> fromSinglePiece String" $ \(p::String) ->
51+ case (fromSinglePiece . toSinglePiece) p of
52+ Nothing -> null p
53+ Just pConverted -> p == pConverted
54+
55+ prop "toSinglePiece <=> fromSinglePiece String" $ \(p::T.Text) ->
56+ case (fromSinglePiece . toSinglePiece) p of
57+ Nothing -> T.null p
58+ Just pConverted -> p == pConverted
59+
60+ prop "toSinglePiece <=> fromSinglePiece String" $ \(p::Int) ->
61+ case (fromSinglePiece . toSinglePiece) p of
62+ Nothing -> p < 0
63+ Just pConverted -> p == pConverted
64+
65+ describe "MultiPiece" $ do
66+ prop "toMultiPiece <=> fromMultiPiece String" $ \(p::[String]) ->
67+ p == (fromJust . fromMultiPiece . toMultiPiece) p
68+
69+ prop "toMultiPiece <=> fromMultiPiece String" $ \(p::[T.Text]) ->
70+ p == (fromJust . fromMultiPiece . toMultiPiece) p