path: root/ExperimentalCruft.hs

{-# 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

-}



{-----------------------------------------------}


{-
data Kiki a =
    SinglePass (KeyRingOperation -> KeyRingAction a)
    | forall b. MultiPass (KeyRingOperation -> KeyRingAction b)
                          (Kiki (b -> a))

fmapWithRT :: (KeyRingRuntime -> a -> b) -> Kiki a -> Kiki b
fmapWithRT g (SinglePass pass) = SinglePass pass'
 where
    pass' kd = case pass kd of
                KeyRingAction v -> RunTimeAction (\rt -> g rt v)
                RunTimeAction f -> RunTimeAction (\rt -> g rt (f rt))
fmapWithRT g (MultiPass pass0 k) = MultiPass pass0 k'
 where
    k' = fmapWithRT (\rt f -> g rt . f) k

instance Functor Kiki where fmap f k = fmapWithRT (const f) k

instance Monad Kiki where
    return x = SinglePass (const $ KeyRingAction x)

    k >>= f  = eval' $ fmapWithRT (\rt x -> eval rt (f x)) k
                where (.:) = (.) . (.)

eval :: KeyRingRuntime -> Kiki a -> KeyRingOperation -> a
eval rt (SinglePass f) kd =
    case f kd of KeyRingAction v -> v
                 RunTimeAction g -> g rt
eval rt (MultiPass p kk) kd = eval rt kk kd $ eval rt (SinglePass p) kd

eval' :: Kiki (KeyRingOperation -> a) -> Kiki a
eval' k@(SinglePass pass) = SinglePass pass'
 where
    pass' kd = case pass kd of
                KeyRingAction f -> KeyRingAction (f kd)
                RunTimeAction g -> RunTimeAction (\rt -> g rt kd)
eval' k@(MultiPass p kk) = MultiPass p kk'
 where
    kk' = fmap flip kk

-}



{-
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
-}