Permalink
Browse files

No more multi-param type classes in regular.

  • Loading branch information...
1 parent bd3a6d9 commit e7f873df6f6e56dc18c59c8edceaa90c57c35b52 @sjoerdvisscher sjoerdvisscher committed Dec 9, 2010
Showing with 14 additions and 15 deletions.
  1. +14 −15 Web/Zwaluw/Regular.hs
View
@@ -1,11 +1,10 @@
{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE UndecidableInstances #-}
-module Web.Zwaluw.Regular (mkRouters, Routers, RouterList(..), RouterLhs, deriveAll, PF) where
+module Web.Zwaluw.Regular (mkRouters, Routers, RouterList(..), deriveAll, PF) where
import Web.Zwaluw.Core
import Generics.Regular
@@ -15,19 +14,19 @@ infixr :&
type Routers r = RouterList (PF r) r
-mkRouters :: (f ~ PF r, MkRouters f r, Regular r) => Routers r
+mkRouters :: (MkRouters (PF r), Regular r) => Routers r
mkRouters = mkRouters' to (Just . from)
-class MkRouters (f :: * -> *) (r :: *) where
- data RouterList f r
+data family RouterList f r
+class MkRouters (f :: * -> *) where
mkRouters' :: (f r -> r) -> (r -> Maybe (f r)) -> RouterList f r
-instance MkRouter f r => MkRouters (C c f) r where
- data RouterList (C c f) r = Z (forall t. Router (RouterLhs f r t) (r :- t))
+data instance RouterList (C c f) r = Z (forall t. Router (RouterLhs f r t) (r :- t))
+instance MkRouter f => MkRouters (C c f) where
mkRouters' addLR matchLR = Z $ pure (hdMap (addLR . C) . mkP) (fmap mkS . hdTraverse (fmap unC . matchLR))
-instance (MkRouters f r, MkRouters g r) => MkRouters (f :+: g) r where
- data RouterList (f :+: g) r = RouterList f r :& RouterList g r
+data instance RouterList (f :+: g) r = RouterList f r :& RouterList g r
+instance (MkRouters f, MkRouters g) => MkRouters (f :+: g) where
mkRouters' addLR matchLR = mkRouters' (addLR . L) (matchL matchLR)
:& mkRouters' (addLR . R) (matchR matchLR)
where
@@ -43,27 +42,27 @@ instance (MkRouters f r, MkRouters g r) => MkRouters (f :+: g) r where
type family RouterLhs (f :: * -> *) (r :: *) (t :: *) :: *
-class MkRouter (f :: * -> *) (r :: *) where
+class MkRouter (f :: * -> *) where
mkP :: RouterLhs f r t -> (f r :- t)
mkS :: (f r :- t) -> RouterLhs f r t
type instance RouterLhs U r t = t
-instance MkRouter U r where
+instance MkRouter U where
mkP t = U :- t
mkS (U :- r) = r
type instance RouterLhs (K a) r t = a :- t
-instance MkRouter (K a) r where
+instance MkRouter (K a) where
mkP (a :- t) = K a :- t
mkS (K a :- t) = a :- t
type instance RouterLhs I r t = r :- t
-instance MkRouter I r where
+instance MkRouter I where
mkP (r :- t) = I r :- t
mkS (I r :- t) = r :- t
type instance RouterLhs (f :*: g) r t = RouterLhs f r (RouterLhs g r t)
-instance (MkRouter f r, MkRouter g r) => MkRouter (f :*: g) r where
+instance (MkRouter f, MkRouter g) => MkRouter (f :*: g) where
mkP t = (f :*: g) :- t''
where
f :- t' = mkP t

0 comments on commit e7f873d

Please sign in to comment.