Permalink
Browse files

Removed need for RankNTypes, which required duck1, which needs a bett…

…er name.
  • Loading branch information...
1 parent 223ec93 commit f1220630217a4d1ed17a383eda1538af648c295d @sjoerdvisscher sjoerdvisscher committed Dec 16, 2010
Showing with 12 additions and 7 deletions.
  1. +5 −6 Web/Zwaluw.hs
  2. +7 −1 Web/Zwaluw/Core.hs
View
@@ -1,4 +1,3 @@
-{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
@@ -65,8 +64,8 @@ chainr p op = opt (manyr (p .~ op) . p)
-- | @chainr1 p op@ repeats @p@ one or more times, separated by @op@.
-- The result is a right associative fold of the results of @p@ with the results of @op@.
-chainr1 :: (forall r. Router r (a :- r)) -> (forall r. Router (a :- a :- r) (a :- r)) -> forall r. Router r (a :- r)
-chainr1 p op = manyr (p .~ op) . p
+chainr1 :: Router r (a :- r) -> Router (a :- a :- r) (a :- r) -> Router r (a :- r)
+chainr1 p op = manyr (duck1 p .~ op) . p
-- | Repeat a router zero or more times, combining the results from right to left.
manyl :: Router r r -> Router r r
@@ -83,7 +82,7 @@ chainl p op = opt (p .~ manyl (op . p))
-- | @chainl1 p op@ repeats @p@ one or more times, separated by @op@.
-- The result is a left associative fold of the results of @p@ with the results of @op@.
-chainl1 :: (forall r. Router r (a :- r)) -> (forall r. Router (a :- a :- r) (a :- r)) -> forall r. Router r (a :- r)
+chainl1 :: Router r (a :- r) -> Router (a :- a :- r) (a :- r) -> Router r (a :- r)
chainl1 p op = p .~ manyl (op . duck p)
-- | Filtering on routers.
@@ -141,8 +140,8 @@ rCons :: Router (a :- [a] :- r) ([a] :- r)
rCons = pure (arg (arg (:-)) (:)) $ \(xs :- t) -> do a:as <- Just xs; Just (a :- as :- t)
-- | Converts a router for a value @a@ to a router for a list of @a@.
-rList :: (forall r. Router r (a :- r)) -> forall r. Router r ([a] :- r)
-rList r = manyr (rCons . r) . rNil
+rList :: Router r (a :- r) -> Router r ([a] :- r)
+rList r = manyr (rCons . duck1 r) . rNil
rPair :: Router (f :- s :- r) ((f, s) :- r)
rPair = pure (arg (arg (:-)) (,)) $ \(ab :- t) -> do (a,b) <- Just ab; Just (a :- b :- t)
View
@@ -12,7 +12,7 @@ module Web.Zwaluw.Core (
, xmap, pure, lit, xmaph
, hhead, htail, hdMap, hdTraverse, pop, arg
- , val, duck, printAs
+ , val, duck, duck1, printAs
) where
import Prelude hiding ((.), id, (/))
@@ -129,6 +129,12 @@ duck r = Router
(map (first (\f (h :- t) -> h :- f t)) . prs r)
(\(h :- t) -> map (second (h :-)) $ ser r t)
+-- | Convert a router to do what it does on the tail of the stack.
+duck1 :: Router r1 (a :- r2) -> Router (h :- r1) (a :- h :- r2)
+duck1 r = Router
+ (map (first (\f (h :- t) -> let a :- t' = f t in a :- h :- t')) . prs r)
+ (\(a :- h :- t) -> map (second (h :-)) $ ser r (a :- t))
+
-- | @r \`printAs\` s@ uses ther serializer of @r@ to test if serializing succeeds,
-- and if it does, instead serializes as @s@.
printAs :: Router a b -> String -> Router a b

0 comments on commit f122063

Please sign in to comment.