summaryrefslogtreecommitdiff
path: root/ExperimentalCruft.hs
diff options
context:
space:
mode:
Diffstat (limited to 'ExperimentalCruft.hs')
-rw-r--r--ExperimentalCruft.hs60
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
197 197
198-} 198-}
199 199
200
201
202{-----------------------------------------------}
203
204
205{-
206data Kiki a =
207 SinglePass (KeyRingOperation -> KeyRingAction a)
208 | forall b. MultiPass (KeyRingOperation -> KeyRingAction b)
209 (Kiki (b -> a))
210
211fmapWithRT :: (KeyRingRuntime -> a -> b) -> Kiki a -> Kiki b
212fmapWithRT g (SinglePass pass) = SinglePass pass'
213 where
214 pass' kd = case pass kd of
215 KeyRingAction v -> RunTimeAction (\rt -> g rt v)
216 RunTimeAction f -> RunTimeAction (\rt -> g rt (f rt))
217fmapWithRT g (MultiPass pass0 k) = MultiPass pass0 k'
218 where
219 k' = fmapWithRT (\rt f -> g rt . f) k
220
221instance Functor Kiki where fmap f k = fmapWithRT (const f) k
222
223instance Monad Kiki where
224 return x = SinglePass (const $ KeyRingAction x)
225
226 k >>= f = eval' $ fmapWithRT (\rt x -> eval rt (f x)) k
227 where (.:) = (.) . (.)
228
229eval :: KeyRingRuntime -> Kiki a -> KeyRingOperation -> a
230eval rt (SinglePass f) kd =
231 case f kd of KeyRingAction v -> v
232 RunTimeAction g -> g rt
233eval rt (MultiPass p kk) kd = eval rt kk kd $ eval rt (SinglePass p) kd
234
235eval' :: Kiki (KeyRingOperation -> a) -> Kiki a
236eval' k@(SinglePass pass) = SinglePass pass'
237 where
238 pass' kd = case pass kd of
239 KeyRingAction f -> KeyRingAction (f kd)
240 RunTimeAction g -> RunTimeAction (\rt -> g rt kd)
241eval' k@(MultiPass p kk) = MultiPass p kk'
242 where
243 kk' = fmap flip kk
244
245-}
246
247
248
249{-
250fmapWithRT g (SinglePass d@(KeyRingOperation { kAction = KeyRingAction v}))
251 = SinglePass $ d { kAction = RunTimeAction (\rt -> g rt v) }
252fmapWithRT g (SinglePass d@(KeyRingOperation { kAction = RunTimeAction f}))
253 = SinglePass $ d { kAction = RunTimeAction f' }
254 where f' rt = g rt (f rt)
255fmapWithRT g (MultiPass p kk) = MultiPass p (fmapWithRT g' kk)
256 where g' rt h = g rt . h
257-}
258
259