diff options
-rw-r--r-- | ExperimentalCruft.hs | 60 | ||||
-rw-r--r-- | 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 | |||
197 | 197 | ||
198 | -} | 198 | -} |
199 | 199 | ||
200 | |||
201 | |||
202 | {-----------------------------------------------} | ||
203 | |||
204 | |||
205 | {- | ||
206 | data Kiki a = | ||
207 | SinglePass (KeyRingOperation -> KeyRingAction a) | ||
208 | | forall b. MultiPass (KeyRingOperation -> KeyRingAction b) | ||
209 | (Kiki (b -> a)) | ||
210 | |||
211 | fmapWithRT :: (KeyRingRuntime -> a -> b) -> Kiki a -> Kiki b | ||
212 | fmapWithRT 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)) | ||
217 | fmapWithRT g (MultiPass pass0 k) = MultiPass pass0 k' | ||
218 | where | ||
219 | k' = fmapWithRT (\rt f -> g rt . f) k | ||
220 | |||
221 | instance Functor Kiki where fmap f k = fmapWithRT (const f) k | ||
222 | |||
223 | instance 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 | |||
229 | eval :: KeyRingRuntime -> Kiki a -> KeyRingOperation -> a | ||
230 | eval rt (SinglePass f) kd = | ||
231 | case f kd of KeyRingAction v -> v | ||
232 | RunTimeAction g -> g rt | ||
233 | eval rt (MultiPass p kk) kd = eval rt kk kd $ eval rt (SinglePass p) kd | ||
234 | |||
235 | eval' :: Kiki (KeyRingOperation -> a) -> Kiki a | ||
236 | eval' 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) | ||
241 | eval' k@(MultiPass p kk) = MultiPass p kk' | ||
242 | where | ||
243 | kk' = fmap flip kk | ||
244 | |||
245 | -} | ||
246 | |||
247 | |||
248 | |||
249 | {- | ||
250 | fmapWithRT g (SinglePass d@(KeyRingOperation { kAction = KeyRingAction v})) | ||
251 | = SinglePass $ d { kAction = RunTimeAction (\rt -> g rt v) } | ||
252 | fmapWithRT g (SinglePass d@(KeyRingOperation { kAction = RunTimeAction f})) | ||
253 | = SinglePass $ d { kAction = RunTimeAction f' } | ||
254 | where f' rt = g rt (f rt) | ||
255 | fmapWithRT g (MultiPass p kk) = MultiPass p (fmapWithRT g' kk) | ||
256 | where g' rt h = g rt . h | ||
257 | -} | ||
258 | |||
259 | |||
@@ -2319,64 +2319,3 @@ backsig _ = Nothing | |||
2319 | socketFamily (SockAddrInet _ _) = AF_INET | 2319 | socketFamily (SockAddrInet _ _) = AF_INET |
2320 | socketFamily (SockAddrInet6 _ _ _ _) = AF_INET6 | 2320 | socketFamily (SockAddrInet6 _ _ _ _) = AF_INET6 |
2321 | socketFamily (SockAddrUnix _) = AF_UNIX | 2321 | socketFamily (SockAddrUnix _) = AF_UNIX |
2322 | |||
2323 | |||
2324 | |||
2325 | {-----------------------------------------------} | ||
2326 | |||
2327 | |||
2328 | {- | ||
2329 | data Kiki a = | ||
2330 | SinglePass (KeyRingOperation -> KeyRingAction a) | ||
2331 | | forall b. MultiPass (KeyRingOperation -> KeyRingAction b) | ||
2332 | (Kiki (b -> a)) | ||
2333 | |||
2334 | fmapWithRT :: (KeyRingRuntime -> a -> b) -> Kiki a -> Kiki b | ||
2335 | fmapWithRT 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)) | ||
2340 | fmapWithRT g (MultiPass pass0 k) = MultiPass pass0 k' | ||
2341 | where | ||
2342 | k' = fmapWithRT (\rt f -> g rt . f) k | ||
2343 | |||
2344 | instance Functor Kiki where fmap f k = fmapWithRT (const f) k | ||
2345 | |||
2346 | instance 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 | |||
2352 | eval :: KeyRingRuntime -> Kiki a -> KeyRingOperation -> a | ||
2353 | eval rt (SinglePass f) kd = | ||
2354 | case f kd of KeyRingAction v -> v | ||
2355 | RunTimeAction g -> g rt | ||
2356 | eval rt (MultiPass p kk) kd = eval rt kk kd $ eval rt (SinglePass p) kd | ||
2357 | |||
2358 | eval' :: Kiki (KeyRingOperation -> a) -> Kiki a | ||
2359 | eval' 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) | ||
2364 | eval' k@(MultiPass p kk) = MultiPass p kk' | ||
2365 | where | ||
2366 | kk' = fmap flip kk | ||
2367 | |||
2368 | -} | ||
2369 | |||
2370 | |||
2371 | |||
2372 | {- | ||
2373 | fmapWithRT g (SinglePass d@(KeyRingOperation { kAction = KeyRingAction v})) | ||
2374 | = SinglePass $ d { kAction = RunTimeAction (\rt -> g rt v) } | ||
2375 | fmapWithRT g (SinglePass d@(KeyRingOperation { kAction = RunTimeAction f})) | ||
2376 | = SinglePass $ d { kAction = RunTimeAction f' } | ||
2377 | where f' rt = g rt (f rt) | ||
2378 | fmapWithRT g (MultiPass p kk) = MultiPass p (fmapWithRT g' kk) | ||
2379 | where g' rt h = g rt . h | ||
2380 | -} | ||
2381 | |||
2382 | |||