diff --git a/Web/Zwaluw.hs b/Web/Zwaluw.hs index 6276983..8bf95d9 100644 --- a/Web/Zwaluw.hs +++ b/Web/Zwaluw.hs @@ -5,7 +5,7 @@ module Web.Zwaluw ( -- * Types - Router, (:-)(..), (<>), (.~) + Router, (:-)(..), (.~) -- * Running routers , parse, unparse @@ -19,7 +19,7 @@ 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 @@ -27,25 +27,22 @@ module Web.Zwaluw ( , 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) \ No newline at end of file +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 + diff --git a/Web/Zwaluw/Regular.hs b/Web/Zwaluw/Regular.hs index a6bb5e4..e3d0247 100644 --- a/Web/Zwaluw/Regular.hs +++ b/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 diff --git a/Zwaluw.cabal b/Zwaluw.cabal index d3a3047..9b7a898 100644 --- a/Zwaluw.cabal +++ b/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