1 files changed, 60 insertions, 0 deletions

diff --git a/ExperimentalCruft.hs b/ExperimentalCruft.hs
index 0c60731..e3c9941 100644
--- a/ExperimentalCruft.hs
+++ b/ExperimentalCruft.hs
@@ -197,3 +197,63 @@ walletInputFormat = todo
 
 -}
 
+
+
+{-----------------------------------------------}
+
+
+{-
+data Kiki a =
+    SinglePass (KeyRingOperation -> KeyRingAction a)
+    | forall b. MultiPass (KeyRingOperation -> KeyRingAction b)
+                          (Kiki (b -> a))
+
+fmapWithRT :: (KeyRingRuntime -> a -> b) -> Kiki a -> Kiki b
+fmapWithRT g (SinglePass pass) = SinglePass pass'
+ where
+    pass' kd = case pass kd of
+                KeyRingAction v -> RunTimeAction (\rt -> g rt v)
+                RunTimeAction f -> RunTimeAction (\rt -> g rt (f rt))
+fmapWithRT g (MultiPass pass0 k) = MultiPass pass0 k'
+ where
+    k' = fmapWithRT (\rt f -> g rt . f) k
+
+instance Functor Kiki where fmap f k = fmapWithRT (const f) k
+
+instance Monad Kiki where
+    return x = SinglePass (const $ KeyRingAction x)
+
+    k >>= f  = eval' $ fmapWithRT (\rt x -> eval rt (f x)) k
+                where (.:) = (.) . (.)
+
+eval :: KeyRingRuntime -> Kiki a -> KeyRingOperation -> a
+eval rt (SinglePass f) kd =
+    case f kd of KeyRingAction v -> v
+                 RunTimeAction g -> g rt
+eval rt (MultiPass p kk) kd = eval rt kk kd $ eval rt (SinglePass p) kd
+
+eval' :: Kiki (KeyRingOperation -> a) -> Kiki a
+eval' k@(SinglePass pass) = SinglePass pass'
+ where
+    pass' kd = case pass kd of
+                KeyRingAction f -> KeyRingAction (f kd)
+                RunTimeAction g -> RunTimeAction (\rt -> g rt kd)
+eval' k@(MultiPass p kk) = MultiPass p kk'
+ where
+    kk' = fmap flip kk
+
+-}
+
+
+
+{-
+fmapWithRT g (SinglePass d@(KeyRingOperation { kAction = KeyRingAction v}))
+    = SinglePass $ d { kAction = RunTimeAction (\rt -> g rt v) }
+fmapWithRT g (SinglePass d@(KeyRingOperation { kAction = RunTimeAction f}))
+    = SinglePass $ d { kAction = RunTimeAction f' }
+    where f' rt = g rt (f rt)
+fmapWithRT g (MultiPass p kk) = MultiPass p (fmapWithRT g' kk)
+    where g' rt h = g rt . h
+-}
+
+