Added 'text' Router

Web/Zwaluw.hs

@@ -5,7 +5,7 @@
 
 module Web.Zwaluw (
     -- * Types
-    Router, (:-)(..), (<>), (.~)
+    Router, (:-)(..), (.~)
 
     -- * Running routers
   , parse, unparse
@@ -19,33 +19,30 @@ module Web.Zwaluw (
   , manyl, somel, chainl, chainl1
 
     -- * Built-in routers
-  , int, integer, string, char, digit, hexDigit
+  , int, integer, string, text, char, digit, hexDigit
   , (/), part
 
   , rNil, rCons, rList, rListSep
   , rPair
   , rLeft, rRight, rEither
   , rNothing, rJust, rMaybe
   , rTrue, rFalse
+
+  -- * FilePath data type and router
+  , FilePath, filePath
   ) where
 
-import Prelude hiding ((.), id, (/))
+import Prelude hiding ((.), id, (/), FilePath)
 import Control.Monad (guard)
 import Control.Category
 import Data.Monoid
 import Data.Char (isDigit, isHexDigit, intToDigit, digitToInt)
+import qualified Data.Text as T
 
 import Web.Zwaluw.Core
 import Web.Zwaluw.TH
 
 
-infixr 8 <>
-
--- | Infix operator for 'mappend'.
-(<>) :: Monoid m => m -> m -> m
-(<>) = mappend
-
-
 -- | Make a router optional.
 opt :: Router r r -> Router r r
 opt = (id <>)
@@ -108,9 +105,25 @@ int = readshow
 integer :: Router r (Integer :- r)
 integer = readshow
 
--- | Routes any string.
+-- | Routes any non-empty string, upto a slash ("/").
 string :: Router r (String :- r)
-string = val (\s -> [(s, "")]) (return . (++))
+string = val parse' serialize
+  where
+    parse' "" = []
+    parse' s  = [( takeWhile (/= '/') s
+                 , dropWhile (/= '/') s
+                 )]
+    serialize = return . (++)
+
+-- | Routes any non-empty text, upto a slash ("/").
+text :: Router r (T.Text :- r)
+text = val parse' serialize
+  where
+    parse' "" = []
+    parse' s  = [( T.pack . takeWhile (/= '/') $ s
+                 , dropWhile (/= '/') s
+                 )]
+    serialize = return . (++) . T.unpack
 
 -- | Routes one character satisfying the given predicate.
 satisfy :: (Char -> Bool) -> Router r (Char :- r)
@@ -175,4 +188,18 @@ rMaybe r = rJust . r <> rNothing
 
 $(deriveRouters ''Bool)
 rTrue  :: Router r (Bool :- r)
-rFalse :: Router r (Bool :- r)
+rFalse :: Router r (Bool :- r)
+
+-- | Represents a file path, including slashes
+newtype FilePath = FilePath { unFilePath :: T.Text }
+
+instance Show FilePath where
+  showsPrec p (FilePath t) r = showsPrec p t r
+
+filePath :: Router r (FilePath :- r)
+filePath = val parse' serialize
+  where
+    parse' "" = []
+    parse' s  = [(FilePath . T.pack $ s, "")]
+    serialize = return . (++) . T.unpack . unFilePath
+

Web/Zwaluw/Regular.hs

@@ -29,7 +29,7 @@ type Routers r = RouterList (PF r) r
 mkRouters :: (MkRouters (PF r), Regular r) => Routers r
 mkRouters = mkRouters' to (Just . from)
 
-data family RouterList f r
+data family RouterList (f :: * -> *) r
 class MkRouters (f :: * -> *) where
   mkRouters' :: (f r -> r) -> (r -> Maybe (f r)) -> RouterList f r
 

Zwaluw.cabal

@@ -1,5 +1,5 @@
 Name:           Zwaluw
-Version:        0.2
+Version:        0.2.2
 Synopsis:       Combinators for bidirectional URL routing
 Description:   	Combinators for bidirectional URL routing
 
@@ -24,4 +24,7 @@ Library
                     Web.Zwaluw.Core, 
                     Web.Zwaluw.TH, 
                     Web.Zwaluw.Regular
-  Build-Depends:    base >= 4 && < 5, template-haskell >= 2.4 && < 2.6, regular >= 0.3 && < 0.4
+  Build-Depends:    base >= 4.5 && < 5,
+                    template-haskell >= 2.4 && < 2.9,
+                    regular >= 0.3 && < 0.4,
+                    text >= 0.11 && < 0.12