Added 'text' Router #7

Open
wants to merge 6 commits into
from
View
@@ -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
+
View
@@ -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
View
@@ -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