[Fencommits] fenfire-hs: add utilities related to functions of type (Endo inner -> Endo outer) to Utils; includes 'puts' and 'modifies' functions for state monads and monadic versions of gets, puts, etc. (e.g. mgets takes a function (state -> m a) where gets takes a function (state -> a))

Benja Fallenstein benja.fallenstein at gmail.com
Tue Apr 3 21:19:11 EEST 2007


Tue Apr  3 21:18:19 EEST 2007  Benja Fallenstein <benja.fallenstein at gmail.com>
  * add utilities related to functions of type (Endo inner -> Endo outer) to Utils; includes 'puts' and 'modifies' functions for state monads and monadic versions of gets, puts, etc. (e.g. mgets takes a function (state -> m a) where gets takes a function (state -> a))
diff -rN -u old-fenfire-hs/Fenfire/Cache.hs new-fenfire-hs/Fenfire/Cache.hs
--- old-fenfire-hs/Fenfire/Cache.hs	2007-04-03 21:19:10.000000000 +0300
+++ new-fenfire-hs/Fenfire/Cache.hs	2007-04-03 21:19:10.000000000 +0300
@@ -20,7 +20,7 @@
 -- Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
 -- MA  02111-1307  USA
 
-import Fenfire.Utils
+import Fenfire.Utils hiding (access)
 
 import Data.Bits
 import Data.HashTable (HashTable)
diff -rN -u old-fenfire-hs/Fenfire/Utils.hs new-fenfire-hs/Fenfire/Utils.hs
--- old-fenfire-hs/Fenfire/Utils.hs	2007-04-03 21:19:10.000000000 +0300
+++ new-fenfire-hs/Fenfire/Utils.hs	2007-04-03 21:19:10.000000000 +0300
@@ -44,6 +44,63 @@
 type EndoM m a = a -> m a
 type Op a      = a -> a -> a
 
+
+type Changer inner outer = Endo inner -> Endo outer
+data Accessor inner outer = Accessor { access :: outer -> inner,
+                                       change :: Changer inner outer }
+                                       
+write :: Accessor inner outer -> inner -> Endo outer
+write acc x = change acc (const x)
+
+gets' :: MonadState outer m => Accessor inner outer -> m inner
+gets' = gets . access
+
+puts :: MonadState outer m => Changer inner outer -> inner -> m ()
+puts chg x = modify (chg $ const x)
+
+puts' :: MonadState outer m => Accessor inner outer -> inner -> m ()
+puts' = puts . change
+
+modifies :: MonadState outer m => Changer inner outer -> Endo inner -> m ()
+modifies chg f = modify (chg f)
+
+modifies' :: MonadState outer m => Accessor inner outer -> Endo inner -> m ()
+modifies' = modifies . change
+
+type ChangerM m inner outer = EndoM m inner -> EndoM m outer
+data AccessorM m inner outer = AccessorM { maccess :: outer -> m inner,
+                                           mchange :: ChangerM m inner outer }
+                                       
+mwrite :: MonadState outer m =>
+          AccessorM m inner outer -> inner -> EndoM m outer
+mwrite acc x = mchange acc (const $ return x)
+
+mgets :: MonadState outer m => (outer -> m inner) -> m inner
+mgets f = get >>= f
+
+mgets' :: MonadState outer m => AccessorM m inner outer -> m inner
+mgets' = mgets . maccess
+
+mputs :: MonadState outer m => ChangerM m inner outer -> inner -> m ()
+mputs chg x = mmodify (chg $ const $ return x)
+
+mputs' :: MonadState outer m => AccessorM m inner outer -> inner -> m ()
+mputs' = mputs . mchange
+
+mmodify :: MonadState state m => EndoM m state -> m ()
+mmodify f = get >>= f >>= put
+
+mmodifies :: MonadState outer m =>
+             ChangerM m inner outer -> EndoM m inner -> m ()
+mmodifies chg f = mmodify (chg f)
+
+mmodifies' :: MonadState outer m => 
+              AccessorM m inner outer -> EndoM m inner -> m ()
+mmodifies' = mmodifies . mchange
+                                       
+
+
+
 type Time     = Double -- seconds since the epoch
 type TimeDiff = Double -- in seconds
 
diff -rN -u old-fenfire-hs/Fenfire.fhs new-fenfire-hs/Fenfire.fhs
--- old-fenfire-hs/Fenfire.fhs	2007-04-03 21:19:10.000000000 +0300
+++ new-fenfire-hs/Fenfire.fhs	2007-04-03 21:19:10.000000000 +0300
@@ -167,9 +167,9 @@
     
 findChange :: (?vs :: ViewSettings, ?graph :: Graph) =>
               Rotation -> Int -> Maybe Rotation
-findChange rot@(Rotation n r) dir = fmap (Rotation n . (r+)) change where
-    change = listToMaybe $ List.sortBy (\x y -> abs x `compare` abs y)
-                 $ catMaybes [findChange' Neg, findChange' Pos]
+findChange rot@(Rotation n r) dir = fmap (Rotation n . (r+)) change_ where
+    change_ = listToMaybe $ List.sortBy (\x y -> abs x `compare` abs y)
+                  $ catMaybes [findChange' Neg, findChange' Pos]
     findChange' dir' = fmap (subtract r) r' where
         len = length $ conns n dir'
         index = r + min (len `div` 2) (maxCenter ?vs)




More information about the Fencommits mailing list