From 3b4c266da5ca78bb47fbfd84e47046b068704905 Mon Sep 17 00:00:00 2001 From: joe Date: Mon, 21 Apr 2014 20:41:34 -0400 Subject: Moved commented experimental code --- ExperimentalCruft.hs | 60 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 60 insertions(+) (limited to 'ExperimentalCruft.hs') 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 +-} + + -- cgit v1.2.3