[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