removed experimental code

1 files changed, 199 insertions, 0 deletions

diff --git a/ExperimentalCruft.hs b/ExperimentalCruft.hs
new file mode 100644
index 0000000..0c60731
--- /dev/null
+++ b/ExperimentalCruft.hs
@@ -0,0 +1,199 @@
+{-# LANGUAGE ExistentialQuantification #-}
+module ExperimentalCruft where
+
+import KeyRing
+
+data KeyRingAction a = KeyRingAction a | RunTimeAction (KeyRingRuntime -> a)
+
+data Kiki a =
+    SinglePass { passInfo :: KeyRingOperation
+               , rtAction :: KeyRingAction a }
+    | forall b.
+       MultiPass { passInfo :: KeyRingOperation
+                 , passAction :: KeyRingAction b
+                 , nextPass :: Kiki (b -> a)
+                 }
+
+
+
+evalAction :: KeyRingRuntime -> KeyRingAction a -> a
+evalAction rt (KeyRingAction v) = v
+evalAction rt (RunTimeAction g) = g rt
+
+instance Monad KeyRingAction where
+    return x = KeyRingAction x
+    m >>= g  = case m of
+        KeyRingAction v -> g v
+        RunTimeAction f -> RunTimeAction $ \rt -> evalAction rt (g $ f rt)
+
+instance Functor KeyRingAction where
+    fmap g (KeyRingAction v) = KeyRingAction $ g v
+    fmap g (RunTimeAction f) = RunTimeAction $ \rt -> g (f rt)
+
+{-
+argOut :: (KeyRingAction (a -> b)) -> a -> KeyRingAction b
+argOut = todo
+argIn :: (a -> KeyRingAction b) -> KeyRingAction (a->b)
+-}
+
+{-
+fmapWithRT :: (a -> KeyRingAction b) -> Kiki a -> Kiki b
+fmapWithRT g k@(SinglePass {}) = k { rtAction = action }
+ where
+    action = rtAction k >>= g
+fmapWithRT g (MultiPass p atn next) = MultiPass p atn next'
+ where
+    next' = fmapWithRT g' next {- next :: Kiki (x -> a) -}
+    -- g' :: ( (x->a) -> KeyRingAction b)
+    g' h = RunTimeAction $
+            \rt x -> case g (h x) of
+                        KeyRingAction v -> v
+                        RunTimeAction f -> f rt
+-}
+
+fmapWithRT :: KeyRingAction (a -> b) -> Kiki a -> Kiki b
+fmapWithRT g (SinglePass pass atn) = SinglePass pass atn'
+ where
+    atn' = g >>= flip fmap atn
+fmapWithRT g (MultiPass p atn next) = MultiPass p atn next'
+ where
+    next' = fmapWithRT g' next
+    g' = fmap (\gf h -> gf . h) g
+
+instance Functor Kiki where
+    fmap f k = fmapWithRT (return f) k
+
+{-
+instance Monad Kiki where
+    return x = SinglePass todo (return x)
+    k >>= f  = kjoin $ fmap f k
+
+kikiAction :: Kiki a -> KeyRingAction a
+kikiAction (SinglePass _ atn) = atn
+kikiAction (MultiPass _ atn next) = do
+        x <- atn
+        g <- kikiAction next
+        return $ g x
+
+kjoin :: Kiki (Kiki a) -> Kiki a
+kjoin k = fmapWithRT eval' k
+ where
+    eval' :: KeyRingAction (Kiki a -> a)
+    eval' = RunTimeAction (\rt -> evalAction rt . kikiAction )
+
+    {-
+    kjoin :: Kiki (Kiki a) -> Kiki a
+    kjoin k = kjoin' (fmap kikiAction k)
+     where
+        ev rt (KeyRingAction v) = v
+        ev rt (RunTimeAction g) = g rt
+
+        kjoin' :: Kiki (KeyRingAction a) -> Kiki a
+        kjoin' (SinglePass pass atn) = SinglePass pass $ join atn
+        kjoin' (MultiPass pass atn next) = MultiPass pass atn next'
+            where
+                next' = todo
+    -}
+
+
+{-
+instance Functor Kiki where
+    fmap f (SinglePass pass atn)
+        = SinglePass pass (fmap f atn)
+    fmap f (MultiPass pass atn next)
+        = MultiPass pass atn (next >>= g)
+     where
+        g = todo
+-}
+
+{-
+data Kiki a = SinglePass (KeyRingOperation a)
+              | forall b. MultiPass (KeyRingOperation b) (Kiki (b -> a))
+
+instance Functor Kiki where
+    fmap f (SinglePass d) = SinglePass $ case kAction d of
+                                  KeyRingAction v -> d { kAction = KeyRingAction (f v) }
+                                  RunTimeAction g -> d { kAction = RunTimeAction (f . g) }
+    fmap f (MultiPass p k)= MultiPass p (fmap (f .) k)
+
+eval :: KeyRingRuntime -> Kiki a -> a
+eval rt (SinglePass (KeyRingOperation { kAction = KeyRingAction v})) = v
+eval rt (SinglePass (KeyRingOperation { kAction = RunTimeAction f})) = f rt
+eval rt (MultiPass p kk) = eval rt kk $ eval rt (SinglePass p)
+
+fmapWithRT :: (KeyRingRuntime -> a -> b) -> Kiki a -> Kiki b
+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
+
+kjoin :: Kiki (Kiki a) -> Kiki a
+kjoin k = fmapWithRT eval k
+
+passCount :: Kiki a -> Int
+passCount (MultiPass _ k) = 1 + passCount k
+passCount (SinglePass {}) = 1
+
+instance Monad Kiki where
+    return x = SinglePass (kret x)
+    k >>= f  = kjoin (fmap f k)
+-}
+
+
+-- Kiki a -> a -> Kiki b
+
+atRuntime :: (KeyRingRuntime -> IO (a,KeyRingRuntime)) -> Kiki a
+atRuntime = todo
+
+goHome :: Maybe FilePath -> Kiki ()
+goHome p = todo -- SinglePass $ (kret ()) { homeSpec = p }
+
+syncRing :: InputFile -> Kiki ()
+syncRing = todo
+
+syncSubKey :: String -> FilePath -> String -> Kiki ()
+syncSubKey usage path cmd = todo
+
+syncWallet :: FilePath -> Kiki ()
+syncWallet = todo
+
+usePassphraseFD :: Int -> Kiki ()
+usePassphraseFD = todo
+
+{-
+importAll :: Kiki ()
+importAll = todo
+-}
+
+importAllAuthentic :: Kiki ()
+importAllAuthentic = todo
+
+signSelfAuthorized :: Kiki ()
+signSelfAuthorized = todo
+
+showIdentity :: Message -> String
+showIdentity = todo
+
+identities :: Kiki [Message]
+identities = todo
+
+currentIdentity :: Kiki Message
+currentIdentity = todo
+
+identityBySpec :: String -> Kiki Message
+identityBySpec = todo
+
+identityBySSHKey :: String -> Kiki Message
+identityBySSHKey = todo
+
+keyBySpec :: String -> Kiki Packet
+keyBySpec = todo
+
+walletInputFormat :: Packet -> String
+walletInputFormat = todo
+
+-}
+