This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "snap-core".
The branch, 0.5 has been updated
via 6a16a3a3821cd631e7c94b391d902a692f03f401 (commit)
from 2e2adfe0368fa4112e800dc873b4c6de0b00c745 (commit)
Summary of changes:
snap-core.cabal | 3 ++-
src/Snap/Internal/Types.hs | 16 +++++++++++++++-
src/Snap/Types.hs | 1 +
src/Snap/Util/Readable.hs | 36 ++++++++++++++++++++++++++++++++++++
4 files changed, 54 insertions(+), 2 deletions(-)
create mode 100644 src/Snap/Util/Readable.hs
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 6a16a3a3821cd631e7c94b391d902a692f03f401
Author: Mighty Byte <[email protected]>
Date: Fri Apr 15 19:56:17 2011 -0400
Added pathArg and Readable.
diff --git a/snap-core.cabal b/snap-core.cabal
index 5f0fdb0..252b419 100644
--- a/snap-core.cabal
+++ b/snap-core.cabal
@@ -117,7 +117,8 @@ Library
Snap.Internal.Parsing,
Snap.Util.FileServe,
Snap.Util.FileUploads,
- Snap.Util.GZip
+ Snap.Util.GZip,
+ Snap.Util.Readable
other-modules:
Snap.Internal.Instances,
diff --git a/src/Snap/Internal/Types.hs b/src/Snap/Internal/Types.hs
index 9bf24df..eb34c34 100644
--- a/src/Snap/Internal/Types.hs
+++ b/src/Snap/Internal/Types.hs
@@ -32,8 +32,9 @@ import Prelude hiding (catch, take)
------------------------------------------------------------------
import Snap.Internal.Http.Types
-import Snap.Iteratee
import Snap.Internal.Iteratee.Debug
+import Snap.Util.Readable
+import Snap.Iteratee
------------------------------------------------------------------------------
@@ -390,6 +391,19 @@ path = pathWith (==)
------------------------------------------------------------------------------
+-- | Runs a 'Snap' monad action only when the first path component is
+-- successfully parsed as the argument to the supplied handler function.
+pathArg :: (Readable a, MonadSnap m)
+ => (a -> m b)
+ -> m b
+pathArg f = do
+ req <- getRequest
+ let (p,_) = S.break (=='/') (rqPathInfo req)
+ a <- fromBS p
+ localRequest (updateContextPath $ S.length p) (f a)
+
+
+------------------------------------------------------------------------------
-- | Runs a 'Snap' monad action only when 'rqPathInfo' is empty.
ifTop :: MonadSnap m => m a -> m a
ifTop = path ""
diff --git a/src/Snap/Types.hs b/src/Snap/Types.hs
index c8a71a6..f40d2c2 100644
--- a/src/Snap/Types.hs
+++ b/src/Snap/Types.hs
@@ -22,6 +22,7 @@ module Snap.Types
, method
, methods
, path
+ , pathArg
, dir
, ifTop
, route
diff --git a/src/Snap/Util/Readable.hs b/src/Snap/Util/Readable.hs
new file mode 100644
index 0000000..2129049
--- /dev/null
+++ b/src/Snap/Util/Readable.hs
@@ -0,0 +1,36 @@
+module Snap.Util.Readable
+ ( Readable(..)
+ ) where
+
+------------------------------------------------------------------------------
+import Data.ByteString.Char8 (ByteString)
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Text.Encoding
+import Data.Text.Read
+
+
+------------------------------------------------------------------------------
+-- | Runs a 'Snap' monad action only when 'rqPathInfo' is empty.
+class Readable a where
+ fromBS :: Monad m => ByteString -> m a
+
+
+------------------------------------------------------------------------------
+-- | Fails if the input wasn't parsed completely.
+checkComplete :: Monad m => (t, Text) -> m t
+checkComplete (a,rest)
+ | T.null rest = return a
+ | otherwise = fail "Readable: could not parse completely"
+
+
+instance Readable ByteString where
+ fromBS = return
+instance Readable Text where
+ fromBS = return . decodeUtf8
+instance Readable Int where
+ fromBS = either fail checkComplete . decimal . decodeUtf8
+instance Readable Integer where
+ fromBS = either fail checkComplete . decimal . decodeUtf8
+instance Readable Double where
+ fromBS = either fail checkComplete . double . decodeUtf8
-----------------------------------------------------------------------
hooks/post-receive
--
snap-core
_______________________________________________
Snap mailing list
[email protected]
http://mailman-mail5.webfaction.com/listinfo/snap
