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 +++++++++++++++++++++++++++++++++++++++++++++++++++ KeyRing.hs | 61 ---------------------------------------------------- 2 files changed, 60 insertions(+), 61 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 +-} + + diff --git a/KeyRing.hs b/KeyRing.hs index c3a80d9..229348f 100644 --- a/KeyRing.hs +++ b/KeyRing.hs @@ -2319,64 +2319,3 @@ backsig _ = Nothing socketFamily (SockAddrInet _ _) = AF_INET socketFamily (SockAddrInet6 _ _ _ _) = AF_INET6 socketFamily (SockAddrUnix _) = AF_UNIX - - - -{-----------------------------------------------} - - -{- -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