summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--ExperimentalCruft.hs60
-rw-r--r--KeyRing.hs61
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
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
diff --git a/KeyRing.hs b/KeyRing.hs
index c3a80d9..229348f 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -2319,64 +2319,3 @@ backsig _ = Nothing
2319socketFamily (SockAddrInet _ _) = AF_INET 2319socketFamily (SockAddrInet _ _) = AF_INET
2320socketFamily (SockAddrInet6 _ _ _ _) = AF_INET6 2320socketFamily (SockAddrInet6 _ _ _ _) = AF_INET6
2321socketFamily (SockAddrUnix _) = AF_UNIX 2321socketFamily (SockAddrUnix _) = AF_UNIX
2322
2323
2324
2325{-----------------------------------------------}
2326
2327
2328{-
2329data Kiki a =
2330 SinglePass (KeyRingOperation -> KeyRingAction a)
2331 | forall b. MultiPass (KeyRingOperation -> KeyRingAction b)
2332 (Kiki (b -> a))
2333
2334fmapWithRT :: (KeyRingRuntime -> a -> b) -> Kiki a -> Kiki b
2335fmapWithRT g (SinglePass pass) = SinglePass pass'
2336 where
2337 pass' kd = case pass kd of
2338 KeyRingAction v -> RunTimeAction (\rt -> g rt v)
2339 RunTimeAction f -> RunTimeAction (\rt -> g rt (f rt))
2340fmapWithRT g (MultiPass pass0 k) = MultiPass pass0 k'
2341 where
2342 k' = fmapWithRT (\rt f -> g rt . f) k
2343
2344instance Functor Kiki where fmap f k = fmapWithRT (const f) k
2345
2346instance Monad Kiki where
2347 return x = SinglePass (const $ KeyRingAction x)
2348
2349 k >>= f = eval' $ fmapWithRT (\rt x -> eval rt (f x)) k
2350 where (.:) = (.) . (.)
2351
2352eval :: KeyRingRuntime -> Kiki a -> KeyRingOperation -> a
2353eval rt (SinglePass f) kd =
2354 case f kd of KeyRingAction v -> v
2355 RunTimeAction g -> g rt
2356eval rt (MultiPass p kk) kd = eval rt kk kd $ eval rt (SinglePass p) kd
2357
2358eval' :: Kiki (KeyRingOperation -> a) -> Kiki a
2359eval' k@(SinglePass pass) = SinglePass pass'
2360 where
2361 pass' kd = case pass kd of
2362 KeyRingAction f -> KeyRingAction (f kd)
2363 RunTimeAction g -> RunTimeAction (\rt -> g rt kd)
2364eval' k@(MultiPass p kk) = MultiPass p kk'
2365 where
2366 kk' = fmap flip kk
2367
2368-}
2369
2370
2371
2372{-
2373fmapWithRT g (SinglePass d@(KeyRingOperation { kAction = KeyRingAction v}))
2374 = SinglePass $ d { kAction = RunTimeAction (\rt -> g rt v) }
2375fmapWithRT g (SinglePass d@(KeyRingOperation { kAction = RunTimeAction f}))
2376 = SinglePass $ d { kAction = RunTimeAction f' }
2377 where f' rt = g rt (f rt)
2378fmapWithRT g (MultiPass p kk) = MultiPass p (fmapWithRT g' kk)
2379 where g' rt h = g rt . h
2380-}
2381
2382