summaryrefslogtreecommitdiff
path: root/KeyRing.hs
diff options
context:
space:
mode:
Diffstat (limited to 'KeyRing.hs')
-rw-r--r--KeyRing.hs135
1 files changed, 54 insertions, 81 deletions
diff --git a/KeyRing.hs b/KeyRing.hs
index 6d1ff3b..71d4bd1 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -51,14 +51,13 @@ data KeyRingRuntime = KeyRingRuntime
51 51
52data KeyRingAction a = KeyRingAction a | RunTimeAction (KeyRingRuntime -> a) 52data KeyRingAction a = KeyRingAction a | RunTimeAction (KeyRingRuntime -> a)
53 53
54data KeyRingData a = KeyRingData 54data KeyRingData = KeyRingData
55 { kFiles :: Map.Map InputFile (RefType,FileType) 55 { kFiles :: Map.Map InputFile (RefType,FileType)
56 , homeSpec :: Maybe String 56 , homeSpec :: Maybe String
57 , kAction :: KeyRingAction a
58 } 57 }
59 58
60kret :: a -> KeyRingData a 59-- kret :: a -> KeyRingData a
61kret x = KeyRingData Map.empty Nothing (KeyRingAction x) 60-- kret x = KeyRingData Map.empty Nothing (KeyRingAction x)
62 61
63todo = error "unimplemented" 62todo = error "unimplemented"
64 63
@@ -383,6 +382,56 @@ merge_ db filename qs = foldl mergeit db (zip [0..] qs)
383 mergeSubSig n sig Nothing = error $ 382 mergeSubSig n sig Nothing = error $
384 "Unable to merge subkey signature: "++(words (show sig) >>= take 1) 383 "Unable to merge subkey signature: "++(words (show sig) >>= take 1)
385 384
385data Kiki a =
386 SinglePass (KeyRingData -> KeyRingAction a)
387 | forall b. MultiPass (KeyRingData -> KeyRingAction b)
388 (Kiki (b -> a))
389
390fmapWithRT :: (KeyRingRuntime -> a -> b) -> Kiki a -> Kiki b
391fmapWithRT g (SinglePass pass) = SinglePass pass'
392 where
393 pass' kd = case pass kd of
394 KeyRingAction v -> RunTimeAction (\rt -> g rt v)
395 RunTimeAction f -> RunTimeAction (\rt -> g rt (f rt))
396fmapWithRT g (MultiPass pass0 k) = MultiPass pass0 k'
397 where
398 k' = fmapWithRT (\rt f -> g rt . f) k
399
400instance Functor Kiki where fmap f k = fmapWithRT (const f) k
401
402instance Monad Kiki where
403 return x = SinglePass (const $ KeyRingAction x)
404
405 k >>= f = eval' $ fmapWithRT (\rt x -> eval rt (f x)) k
406
407eval :: KeyRingRuntime -> Kiki a -> KeyRingData -> a
408eval rt (SinglePass f) kd =
409 case f kd of KeyRingAction v -> v
410 RunTimeAction g -> g rt
411eval rt (MultiPass p kk) kd = eval rt kk kd $ eval rt (SinglePass p) kd
412
413eval' :: Kiki (KeyRingData -> a) -> Kiki a
414eval' k@(SinglePass pass) = SinglePass pass'
415 where
416 pass' kd = case pass kd of
417 KeyRingAction f -> KeyRingAction (f kd)
418 RunTimeAction g -> RunTimeAction (\rt -> g rt kd)
419eval' k@(MultiPass p kk) = MultiPass p kk'
420 where
421 kk' = eval' $ fmap flip kk
422
423{-
424fmapWithRT g (SinglePass d@(KeyRingData { kAction = KeyRingAction v}))
425 = SinglePass $ d { kAction = RunTimeAction (\rt -> g rt v) }
426fmapWithRT g (SinglePass d@(KeyRingData { kAction = RunTimeAction f}))
427 = SinglePass $ d { kAction = RunTimeAction f' }
428 where f' rt = g rt (f rt)
429fmapWithRT g (MultiPass p kk) = MultiPass p (fmapWithRT g' kk)
430 where g' rt h = g rt . h
431-}
432
433
434{-
386data Kiki a = SinglePass (KeyRingData a) 435data Kiki a = SinglePass (KeyRingData a)
387 | forall b. MultiPass (KeyRingData b) (Kiki (b -> a)) 436 | forall b. MultiPass (KeyRingData b) (Kiki (b -> a))
388 437
@@ -416,92 +465,16 @@ passCount (SinglePass {}) = 1
416instance Monad Kiki where 465instance Monad Kiki where
417 return x = SinglePass (kret x) 466 return x = SinglePass (kret x)
418 k >>= f = kjoin (fmap f k) 467 k >>= f = kjoin (fmap f k)
419
420{-
421kjoin :: Kiki (Kiki a) -> Kiki a
422kjoin (SinglePass d) =
423 case kAction d of
424 KeyRingAction v -> v
425 RunTimeAction g -> SinglePass (d { kAction = RunTimeAction g' })
426 where g' rt = eval rt (g rt)
427
428kjoin (MultiPass p k)= MultiPass p (fmapWithRT f k)
429 where
430 {-
431 k' = case k of
432 SinglePass (d { kAction
433 k :: Kiki (b -> Kiki a)
434 k' :: Kiki (b -> a)
435 -}
436 {-
437 f :: (b->Kiki a) -> Kiki (b -> a)
438 f g = SinglePass (p { kAction = RunTimeAction g' })
439 where g' rt = \b -> eval rt (g b)
440 -}
441 f :: KeyRingRuntime -> (b->Kiki a) -> (b -> a)
442 f rt g b = eval rt (g b)
443-} 468-}
444 469
445 470
446ktrav :: Kiki (x -> y) -> x -> Kiki y
447ktrav (SinglePass kk) x = SinglePass $ case kAction kk of KeyRingAction f -> kk { kAction = KeyRingAction (f x) }
448
449{-
450instance Monad Kiki where
451 return x = SinglePass (kret x)
452
453 kiki >>= f
454 = join (fmap f kiki)
455 where
456 join (SinglePass kd) =
457 case kAction kd of
458 KeyRingAction kiki -> kiki
459 RunTimeAction g ->
460 let go rt = case g rt of
461 SinglePass q -> todo
462 in SinglePass (kd { kAction = RunTimeAction go })
463 join (MultiPass x y) = MultiPass x (join y)
464-}
465
466
467{-
468data Kiki a = SinglePass (KeyRingData a)
469 | MultiPass (KeyRingData (Kiki a))
470lastPass :: Kiki a -> KeyRingRuntime -> KeyRingData a
471lastPass (SinglePass d) rt = d
472lastPass (MultiPass k) rt = case kAction k of
473 KeyRingAction v -> lastPass v rt
474 RunTimeAction f -> lastPass (f rt) rt
475
476instance Monad Kiki where
477 return x = SinglePass (kret x)
478 SinglePass (kd@(KeyRingData { kAction = KeyRingAction x })) >>= f
479 = f x
480 SinglePass (kd@(KeyRingData { kAction = RunTimeAction g })) >>= f
481 = SinglePass (kd { kAction = RunTimeAction g' })
482 where
483 g' rt = case f (g rt) of
484 SinglePass d ->
485 case kAction d of
486 KeyRingAction y -> y
487 RunTimeAction h -> h rt
488 {-
489 MultiPass d ->
490 case kAction d of
491 KeyRingAction k' -> k' >>= f
492 -}
493
494runKiki :: KeyRingRuntime -> Kiki a -> a
495runKiki = todo
496-}
497
498-- Kiki a -> a -> Kiki b 471-- Kiki a -> a -> Kiki b
499 472
500atRuntime :: (KeyRingRuntime -> IO (a,KeyRingRuntime)) -> Kiki a 473atRuntime :: (KeyRingRuntime -> IO (a,KeyRingRuntime)) -> Kiki a
501atRuntime = todo 474atRuntime = todo
502 475
503goHome :: Maybe FilePath -> Kiki () 476goHome :: Maybe FilePath -> Kiki ()
504goHome p = SinglePass $ (kret ()) { homeSpec = p } 477goHome p = todo -- SinglePass $ (kret ()) { homeSpec = p }
505 478
506syncRing :: InputFile -> Kiki () 479syncRing :: InputFile -> Kiki ()
507syncRing = todo 480syncRing = todo