Permalink
Browse files

Reversing representation of StaredStore.

  • Loading branch information...
1 parent 6ebbc3f commit fa98bad054f828024aa7b6ba59195777d58f308e @roconnor committed Jun 3, 2012
Showing with 11 additions and 16 deletions.
  1. +7 −12 src/Control/Comonad/StaredStore.hs
  2. +4 −4 src/Data/Lens/Multi/Common.hs
@@ -5,6 +5,7 @@ import Control.Comonad
import Control.Comonad.Trans.Store
import Data.Functor.Coproduct
import Data.Functor.Identity
+import Data.Functor.Constant
newtype StaredStore s a = StaredStore {runStaredStore :: Coproduct Identity (StoreT s (StaredStore s)) a}
@@ -20,26 +21,20 @@ instance Comonad (StaredStore s) where
instance Applicative (StaredStore s) where
pure = StaredStore . left . pure
- f <*> (StaredStore x) = coproduct l r x
+ (StaredStore f) <*> x = coproduct l r f
where
- l (Identity y) = fmap ($ y) f
- r y = StaredStore (right (StoreT ((.) <$> f <*> v) s))
+ l (Identity g) = fmap g x
+ r g = StaredStore (right (StoreT (flip <$> h <*> x) s))
where
- (v, s) = runStoreT y
+ (h, s) = runStoreT g
fromStore :: Store b a -> StaredStore b a
fromStore st = StaredStore (right (StoreT (pure g) v))
where
(g,v) = runStore st
poss :: StaredStore b a -> [b]
-poss x = go x []
- where
- go :: StaredStore b a -> [b] -> [b]
- go = coproduct (const id) h . runStaredStore
- h s = go g . (v:)
- where
- (g, v) = runStoreT s
+poss = getConstant . eekss (Constant . (:[]))
seekss :: (b -> b) -> StaredStore b a -> StaredStore b a
seekss f = coproduct (pure . runIdentity) h . runStaredStore
@@ -55,6 +50,6 @@ peekss f = extract . seekss f
eekss :: Applicative f => (b -> f b) -> (StaredStore b a) -> f a
eekss f (StaredStore s) = coproduct (pure . runIdentity) h s
where
- h st = eekss f g <*> f v
+ h st = f v <**> eekss f g
where
(g, v) = runStoreT st
@@ -41,15 +41,15 @@ infixr 4 ^%%=
(^%%=) :: Applicative f => MultiLens a b -> (b -> f b) -> a -> f a
MLens f ^%%= g = eekss g . f
-backPL :: MultiLens a b -> PartialLens a b
-backPL (MLens f) = pLens $
+frontPL :: MultiLens a b -> PartialLens a b
+frontPL (MLens f) = pLens $
coproduct left (right . uncurry store . (extract *** id) . runStoreT) . runStaredStore . f
reverseML :: MultiLens a b -> MultiLens a b
reverseML l = MLens (forwards . (l ^%%= (Backwards . runMLens id)))
-frontPL :: MultiLens a b -> PartialLens a b
-frontPL = backPL . reverseML
+backPL :: MultiLens a b -> PartialLens a b
+backPL = frontPL . reverseML
-- Stock Multilenses

0 comments on commit fa98bad

Please sign in to comment.