path-pieces 0.0.0 → 0.2.1

raw patch · 5 files changed

Files

ChangeLog.md +7/−0
README.md +6/−0
Web/PathPieces.hs +159/−47
path-pieces.cabal +22/−5
test/main.hs +82/−0

+ ChangeLog.md view

@@ -0,0 +1,7 @@+## 0.2.0++* Make `PathMultiPiece` instance for lists based on `PathPiece` [Yesod issue #932](https://github.com/yesodweb/yesod/issues/932)++## 0.1.5++Added more integral instances, and check bounds on them [#5](https://github.com/yesodweb/path-pieces/pull/5).

+ README.md view

@@ -0,0 +1,6 @@+## path-pieces++Defines two typeclasses used for converting Haskell data types to and from route pieces.+Used in Yesod to automatically marshall data in the request path.++see http://www.yesodweb.com/ for more information.

Web/PathPieces.hs view

@@ -1,55 +1,167 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances, TypeSynonymInstances, OverloadedStrings #-} module Web.PathPieces-    ( SinglePiece (..)-    , MultiPiece (..)+    ( PathPiece (..)+    , PathMultiPiece (..)+    , readFromPathPiece+    , showToPathPiece+    -- * Deprecated+    , toSinglePiece+    , toMultiPiece+    , fromSinglePiece+    , fromMultiPiece     ) where -import Data.Int (Int64)+import Data.Int (Int8, Int16, Int32, Int64)+import Data.Word (Word, Word8, Word16, Word32, Word64) import qualified Data.Text as S import qualified Data.Text.Lazy as L import qualified Data.Text.Read+import Data.Time (Day)+import Control.Exception (assert)+import Text.Read (readMaybe) -class SinglePiece s where-    fromSinglePiece :: S.Text -> Maybe s-    toSinglePiece :: s -> S.Text-instance SinglePiece String where-    fromSinglePiece s = if S.null s then Nothing else Just (S.unpack s)-    toSinglePiece = S.pack-instance SinglePiece S.Text where-    fromSinglePiece s = if S.null s then Nothing else Just s-    toSinglePiece = id-instance SinglePiece L.Text where-    fromSinglePiece s = if S.null s then Nothing else Just (L.fromChunks [s])-    toSinglePiece = S.concat . L.toChunks-instance SinglePiece Integer where-    fromSinglePiece s =-        case Data.Text.Read.decimal s of-            Right (i, _) -> Just i-            Left _ -> Nothing-    toSinglePiece = S.pack . show-instance SinglePiece Int where-    fromSinglePiece s =-        case Data.Text.Read.decimal s of-            Right (i, _) -> Just i-            Left _ -> Nothing-    toSinglePiece = S.pack . show-instance SinglePiece Int64 where-    fromSinglePiece s =-        case Data.Text.Read.decimal s of-            Right (i, _) -> Just i-            Left _ -> Nothing-    toSinglePiece = S.pack . show+class PathPiece s where+    fromPathPiece :: S.Text -> Maybe s+    toPathPiece :: s -> S.Text -class MultiPiece s where-    fromMultiPiece :: [S.Text] -> Maybe s-    toMultiPiece :: s -> [S.Text]-instance MultiPiece [String] where-    fromMultiPiece = Just . map S.unpack-    toMultiPiece = map S.pack-instance MultiPiece [S.Text] where-    fromMultiPiece = Just-    toMultiPiece = id-instance MultiPiece [L.Text] where-    fromMultiPiece = Just . map (L.fromChunks . return)-    toMultiPiece = map $ S.concat . L.toChunks+instance PathPiece () where+    fromPathPiece t = if t == "_" then Just () else Nothing+    toPathPiece () = "_"++instance PathPiece String where+    fromPathPiece = Just . S.unpack+    toPathPiece = S.pack++instance PathPiece S.Text where+    fromPathPiece = Just+    toPathPiece = id++instance PathPiece L.Text where+    fromPathPiece = Just . L.fromChunks . return+    toPathPiece = S.concat . L.toChunks++parseIntegral :: (Integral a, Bounded a, Ord a) => S.Text -> Maybe a+parseIntegral s = n+    where+    n = case Data.Text.Read.signed Data.Text.Read.decimal s of+        Right (i, "") | i <= top && i >= bot -> Just (fromInteger i)+        _ -> Nothing+    Just witness = n+    top = toInteger (maxBound `asTypeOf` witness)+    bot = toInteger (minBound `asTypeOf` witness)++instance PathPiece Integer where+    fromPathPiece s =+        case Data.Text.Read.signed Data.Text.Read.decimal s of+            Right (i, "") -> Just i+            _ -> Nothing+    toPathPiece = S.pack . show++instance PathPiece Int where+    fromPathPiece = parseIntegral+    toPathPiece = S.pack . show++instance PathPiece Int8 where+    fromPathPiece = parseIntegral+    toPathPiece = S.pack . show++instance PathPiece Int16 where+    fromPathPiece = parseIntegral+    toPathPiece = S.pack . show++instance PathPiece Int32 where+    fromPathPiece = parseIntegral+    toPathPiece = S.pack . show++instance PathPiece Int64 where+    fromPathPiece = parseIntegral+    toPathPiece = S.pack . show++instance PathPiece Word where+    fromPathPiece = parseIntegral+    toPathPiece = S.pack . show++instance PathPiece Word8 where+    fromPathPiece = parseIntegral+    toPathPiece = S.pack . show++instance PathPiece Word16 where+    fromPathPiece = parseIntegral+    toPathPiece = S.pack . show++instance PathPiece Word32 where+    fromPathPiece = parseIntegral+    toPathPiece = S.pack . show++instance PathPiece Word64 where+    fromPathPiece = parseIntegral+    toPathPiece = S.pack . show++instance PathPiece Bool where+    fromPathPiece t =+        case filter (null . snd) $ reads $ S.unpack t of+            (a, s):_ -> assert (null s) (Just a)+            _        -> Nothing+    toPathPiece = S.pack . show++instance PathPiece Day where+    fromPathPiece t =+        case reads $ S.unpack t of+            [(a,"")] -> Just a+            _ -> Nothing+    toPathPiece = S.pack . show++instance (PathPiece a) => PathPiece (Maybe a) where+    fromPathPiece s = case S.stripPrefix "Just " s of+        Just r -> Just `fmap` fromPathPiece r+        _ -> case s of+            "Nothing" -> Just Nothing+            _ -> Nothing+    toPathPiece m = case m of+        Just s -> "Just " `S.append` toPathPiece s+        _ -> "Nothing"++class PathMultiPiece s where+    fromPathMultiPiece :: [S.Text] -> Maybe s+    toPathMultiPiece :: s -> [S.Text]++instance PathPiece a => PathMultiPiece [a] where+    fromPathMultiPiece = mapM fromPathPiece+    toPathMultiPiece = map toPathPiece++-- | A function for helping generate free 'PathPiece'+--   instances for enumeration data types +--   that have derived 'Read' and 'Show' instances.+--   Intended to be used like this:+--+--   > data MyData = Foo | Bar | Baz+--   >   deriving (Read,Show)+--   > instance PathPiece MyData where+--   >   fromPathPiece = readFromPathPiece+--   >   toPathPiece = showToPathPiece+--+--  Since 0.2.1. +readFromPathPiece :: Read s => S.Text -> Maybe s+readFromPathPiece = readMaybe . S.unpack++-- | See the documentation for 'readFromPathPiece'.+--+--  Since 0.2.1. +showToPathPiece :: Show s => s -> S.Text+showToPathPiece = S.pack . show++{-# DEPRECATED toSinglePiece "Use toPathPiece instead of toSinglePiece" #-}+toSinglePiece :: PathPiece p => p -> S.Text+toSinglePiece = toPathPiece++{-# DEPRECATED fromSinglePiece "Use fromPathPiece instead of fromSinglePiece" #-}+fromSinglePiece :: PathPiece p => S.Text -> Maybe p+fromSinglePiece = fromPathPiece++{-# DEPRECATED toMultiPiece "Use toPathMultiPiece instead of toMultiPiece" #-}+toMultiPiece :: PathMultiPiece ps => ps -> [S.Text]+toMultiPiece = toPathMultiPiece++{-# DEPRECATED fromMultiPiece "Use fromPathMultiPiece instead of fromMultiPiece" #-}+fromMultiPiece :: PathMultiPiece ps => [S.Text] -> Maybe ps+fromMultiPiece = fromPathMultiPiece

path-pieces.cabal view

@@ -1,22 +1,39 @@ name:            path-pieces-version:         0.0.0+version:         0.2.1 license:         BSD3 license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com> maintainer:      Michael Snoyman <michael@snoyman.com> synopsis:        Components of paths.+description:    Hackage documentation generation is not reliable. For up to date documentation, please see: <http://www.stackage.org/package/path-pieces>. category:        Web, Yesod stability:       unstable-cabal-version:   >= 1.6+cabal-version:   >= 1.8 build-type:      Simple-homepage:        http://github.com/snoyberg/path-pieces+extra-source-files:+  test/main.hs+  ChangeLog.md+  README.md  library     build-depends:   base             >= 4       && < 5-                   , text             >= 0.5     && < 0.12+                   , text             >= 0.5+                   , time     exposed-modules: Web.PathPieces     ghc-options:     -Wall +test-suite test+    type:          exitcode-stdio-1.0+    main-is:       main.hs+    hs-source-dirs: test+    ghc-options:   -Wall+    build-depends:   HUnit+                   , hspec >= 1.3+                   , base >= 4 && < 5+                   , QuickCheck+                   , path-pieces+                   , text+ source-repository head   type:     git-  location: git://github.com/snoyberg/path-pieces.git+  location: https://github.com/yesodweb/path-pieces

+ test/main.hs view

@@ -0,0 +1,82 @@+{-# Language ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Main where++import Test.Hspec+import Test.Hspec.QuickCheck(prop)+import Test.QuickCheck++import Web.PathPieces+import qualified Data.Text as T+import Data.Maybe (fromJust)++-- import FileLocation (debug)++instance Arbitrary T.Text where+  arbitrary = fmap T.pack arbitrary+++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+  describe "PathPiece" $ do+    prop "toPathPiece <=> fromPathPiece String" $ \(p::String) ->+      case (fromPathPiece . toPathPiece) p of+        Nothing -> null p+        Just pConverted -> p == pConverted++    prop "toPathPiece <=> fromPathPiece Text" $ \(p::T.Text) ->+      case (fromPathPiece . toPathPiece) p of+        Nothing -> T.null p+        Just pConverted -> p == pConverted++    prop "toPathPiece <=> fromPathPiece Int" $ \(p::Int) ->+      case (fromPathPiece . toPathPiece) p of+        Nothing -> False+        Just pConverted -> p == pConverted++    prop "toPathPiece <=> fromPathPiece Bool" $ \(p::Bool) ->+      case (fromPathPiece . toPathPiece) p of+        Nothing -> False+        Just pConverted -> p == pConverted++    prop "toPathPiece <=> fromPathPiece Maybe String" $ \(p::Maybe String) ->+      case (fromPathPiece . toPathPiece) p of+        Nothing -> False+        Just pConverted -> p == pConverted++  describe "PathMultiPiece" $ do+    prop "toPathMultiPiece <=> fromPathMultiPiece String" $ \(p::[String]) ->+      p == (fromJust . fromPathMultiPiece . toPathMultiPiece) p++    prop "toPathMultiPiece <=> fromPathMultiPiece Text" $ \(p::[T.Text]) ->+      p == (fromJust . fromPathMultiPiece . toPathMultiPiece) p+++  describe "SinglePiece" $ do+    prop "toPathPiece <=> fromPathPiece String" $ \(p::String) ->+      case (fromPathPiece . toPathPiece) p of+        Nothing -> null p+        Just pConverted -> p == pConverted++    prop "toPathPiece <=> fromPathPiece Text" $ \(p::T.Text) ->+      case (fromPathPiece . toPathPiece) p of+        Nothing -> T.null p+        Just pConverted -> p == pConverted++    prop "toPathPiece <=> fromPathPiece Int" $ \(p::Int) ->+      case (fromPathPiece . toPathPiece) p of+        Nothing -> p < 0+        Just pConverted -> p == pConverted++  describe "MultiPiece" $ do+    prop "toPathMultiPiece <=> fromPathMultiPiece String" $ \(p::[String]) ->+      p == (fromJust . fromPathMultiPiece . toPathMultiPiece) p++    prop "toPathMultiPiece <=> fromPathMultiPiece Text" $ \(p::[T.Text]) ->+      p == (fromJust . fromPathMultiPiece . toPathMultiPiece) p++  it "bad ints are rejected" $ fromPathPiece (T.pack "123hello")+    `shouldBe` (Nothing :: Maybe Int)