Permalink
Browse files

Flipped order of fields in Router.

  • Loading branch information...
1 parent 689febf commit 5b9de3d8c61eaac92728247786431f564c3ac98c @sjoerdvisscher sjoerdvisscher committed Dec 4, 2010
Showing with 21 additions and 19 deletions.
  1. +8 −8 Web/Zwaluw.hs
  2. +13 −11 Web/Zwaluw/Core.hs
View
@@ -77,22 +77,22 @@ chainl1 p op = p .~ manyl (op . duck p)
apply :: Router ((b -> a) :- r) ((a -> b) :- r) -> Router (a :- r) (b :- r)
apply r = Router
- (\(b :- t) -> map (second (\(f :- r) -> f b :- r)) $ ser r (const b :- t))
(\s -> map (first (\f (a :- r) -> let (g :- t) = f (const a :- r) in g a :- t)) $ prs r s)
+ (\(b :- t) -> map (second (\(f :- r) -> f b :- r)) $ ser r (const b :- t))
having :: (forall r. Router r (a :- r)) -> (a -> Bool) -> Router r (a :- r)
having r p = Router
- (\(a :- t) -> if (p a) then ser r (a :- t) else mzero)
(\s -> map (first ((:-) . hhead . ($ ()))) $ filter (p . hhead . ($ ()) . fst) $ prs r s)
+ (\(a :- t) -> if (p a) then ser r (a :- t) else mzero)
satisfy :: (Char -> Bool) -> Router r (Char :- r)
satisfy p = Router
- (\(c :- a) -> if (p c) then return ((c :), a) else mzero)
(\s -> case s of
[] -> mzero
(c:cs) -> if (p c) then return ((c :-), cs) else mzero)
+ (\(c :- a) -> if (p c) then return ((c :), a) else mzero)
char :: Router r (Char :- r)
char = satisfy (const True)
@@ -102,20 +102,20 @@ digit = maph ((\a -> do [h] <- Just a; Just h) . show) (read . (:[])) $ satisfy
push :: Eq h => h -> Router r (h :- r)
push h = Router
- (\(h' :- t) -> do guard (h == h'); return (id, t))
(\s -> return ((h :-), s))
+ (\(h' :- t) -> do guard (h == h'); return (id, t))
duck :: Router r1 r2 -> Router (h :- r1) (h :- r2)
duck r = Router
- (\(h :- t) -> map (second (h :-)) $ ser r t)
(map (first (\f (h :- t) -> h :- f t)) . prs r)
+ (\(h :- t) -> map (second (h :-)) $ ser r t)
printAs :: Router a b -> String -> Router a b
printAs r s = Router
+ (prs r)
(\b -> case ser r b of
[] -> []
(_, a) : _ -> [((s ++), a)])
- (prs r)
rNil :: Router r ([a] :- r)
@@ -154,8 +154,8 @@ int = val
-- | Routes any string.
string :: Router r (String :- r)
string = Router
- (\(s :- r) -> return ((s ++), r))
(\s -> return ((s :-), ""))
+ (\(s :- r) -> return ((s ++), r))
-- | Routes part of a URL, i.e. a String not containing '/' or '?'.
part :: Router r (String :- r)
@@ -164,5 +164,5 @@ part = rList (satisfy (\c -> c /= '/' && c /= '?'))
-- | Routes any value that has a Show and Read instance.
val :: (Show a, Read a) => Router r (a :- r)
val = Router
- (\(a :- r) -> return ((show a ++), r))
(map (first (:-)) . reads)
+ (\(a :- r) -> return ((show a ++), r))
View
@@ -30,21 +30,21 @@ infixr 9 .~
data Router a b = Router
- { ser :: b -> [(String -> String, a)]
- , prs :: String -> [(a -> b, String)] }
+ { prs :: String -> [(a -> b, String)]
+ , ser :: b -> [(String -> String, a)] }
instance Category Router where
id = Router
(\x -> [(id, x)])
(\x -> [(id, x)])
- ~(Router sf pf) . ~(Router sg pg) = Router
- (compose (.) sf sg)
+ ~(Router pf sf) . ~(Router pg sg) = Router
(compose (.) pf pg)
+ (compose (.) sf sg)
(.~) :: Router a b -> Router b c -> Router a c
-~(Router sf pf) .~ ~(Router sg pg) = Router
- (compose (flip (.)) sg sf)
+~(Router pf sf) .~ ~(Router pg sg) = Router
(compose (flip (.)) pf pg)
+ (compose (flip (.)) sg sf)
compose
:: (a -> b -> c)
@@ -57,13 +57,15 @@ compose op mf mg s = do
return (f `op` g, s'')
instance Monoid (Router a b) where
- mempty = Router (const mzero) (const mzero)
- ~(Router sf pf) `mappend` ~(Router sg pg) = Router
- (\s -> sg s `mplus` sf s)
+ mempty = Router
+ (const mzero)
+ (const mzero)
+ ~(Router pf sf) `mappend` ~(Router pg sg) = Router
(\s -> pf s `mplus` pg s)
+ (\s -> sg s `mplus` sf s)
xmap :: (a -> b) -> (b -> Maybe a) -> Router r a -> Router r b
-xmap f g (Router s p) = Router (maybe mzero s . g) ((fmap . fmap . first . fmap) f p)
+xmap f g (Router p s) = Router ((fmap . fmap . first . fmap) f p) (maybe mzero s . g)
-- | Lift a constructor-destructor pair to a pure router.
pure :: (a -> b) -> (b -> Maybe a) -> Router a b
@@ -72,8 +74,8 @@ pure f g = xmap f g id
-- | Routes a constant string.
lit :: String -> Router r r
lit l = Router
- (\b -> return ((l ++), b))
(\s -> let (s1, s2) = splitAt (length l) s in if s1 == l then return (id, s2) else mzero)
+ (\b -> return ((l ++), b))
data a :- b = a :- b deriving (Eq, Show)

0 comments on commit 5b9de3d

Please sign in to comment.