Added a Route data type that packages up the routing function and an identifier (to provide equality)
This commit is contained in:
parent
d12b2178de
commit
d6b102838a
|
@ -28,9 +28,10 @@ module GenericUtils (
|
|||
, containsTypes
|
||||
, gmapMFor
|
||||
, gmapMForRoute
|
||||
, routeModify, routeGet, routeSet, Route
|
||||
) where
|
||||
|
||||
import Control.Monad.Identity()
|
||||
import Control.Monad.Identity
|
||||
import Control.Monad.State
|
||||
import Data.Generics
|
||||
import Data.IntMap (IntMap)
|
||||
|
@ -158,28 +159,51 @@ gmapMFor typeset f = gmapM (each f)
|
|||
Just Miss -> return x
|
||||
Nothing -> return x
|
||||
|
||||
|
||||
data Route inner outer = Route [Int] (forall m. Monad m => (inner -> m inner) -> (outer -> m outer))
|
||||
|
||||
instance Eq (Route inner outer) where
|
||||
(==) (Route xns _) (Route yns _) = xns == yns
|
||||
|
||||
instance Ord (Route inner outer) where
|
||||
compare (Route xns _) (Route yns _) = compare xns yns
|
||||
|
||||
routeModify :: Monad m => Route inner outer -> (inner -> m inner) -> (outer -> m
|
||||
outer)
|
||||
routeModify (Route _ wrap) = wrap
|
||||
|
||||
routeGet :: Route inner outer -> outer -> inner
|
||||
routeGet route = flip execState undefined . routeModify route (\x -> put x >> return x)
|
||||
|
||||
routeSet :: Route inner outer -> inner -> outer -> outer
|
||||
routeSet route x = runIdentity . routeModify route (const $ return x)
|
||||
|
||||
(@->) :: Route mid outer -> Route inner mid -> Route inner outer
|
||||
(@->) (Route outInds outF) (Route inInds inF) = Route (outInds ++ inInds) (outF
|
||||
. inF)
|
||||
|
||||
gmapMForRoute :: forall m t. (Monad m, Data t) =>
|
||||
TypeSet ->
|
||||
(forall s. Data s => (s, (forall n. Monad n => (s -> n s) -> (t -> n t))) -> m s)
|
||||
(forall s. Data s => (s, Route s t) -> m s)
|
||||
-> (t -> m t)
|
||||
gmapMForRoute typeset f = gmapMWithRoute (each f)
|
||||
where
|
||||
each :: Data u => (forall s. Data s => (s, (forall n. Monad n => (s -> n s) -> (t -> n t))) -> m s)
|
||||
-> ((u, (forall n. Monad n => (u -> n u) -> (t -> n t))) -> m u)
|
||||
each :: Data u => (forall s. Data s => (s, Route s t) -> m s)
|
||||
-> ((u, Route u t) -> m u)
|
||||
each f (x, route)
|
||||
= case IntMap.lookup (typeKey x) typeset of
|
||||
Just Hit -> f (x, route)
|
||||
Just Through -> gmapMWithRoute (\(y, route') -> each f (y, route . route')) x
|
||||
Just Through -> gmapMWithRoute (\(y, route') -> each f (y, route @-> route')) x
|
||||
Just Miss -> return x
|
||||
Nothing -> return x
|
||||
|
||||
gmapMWithRoute :: forall a m. (Monad m, Data a) => (forall b. Data b => (b, (forall n. Monad n => (b -> n b) ->
|
||||
(a -> n a))) -> m b) -> a -> m a
|
||||
gmapMWithRoute :: forall a m. (Monad m, Data a) => (forall b. Data b => (b, Route
|
||||
b a) -> m b) -> a -> m a
|
||||
gmapMWithRoute f = gmapFuncs [GM {unGM = f' n} | n <- [0..]]
|
||||
where
|
||||
f' :: Int -> (forall b. Data b => b -> m b)
|
||||
f' n x = f (x, makeRoute n)
|
||||
|
||||
-- Given a number, makes a route function for that child:
|
||||
makeRoute :: (Data s, Data t, Monad m) => Int -> (s -> m s) -> (t -> m t)
|
||||
makeRoute target f = gmapFuncs [mkM' (if n == target then f else return) | n <- [0..]]
|
||||
makeRoute :: (Data s, Data t) => Int -> Route s t
|
||||
makeRoute target = Route [target] (\f -> gmapFuncs [mkM' (if n == target then f else return) | n <- [0..]])
|
||||
|
|
Loading…
Reference in New Issue
Block a user