c command...

1 files changed, 35 insertions, 3 deletions

diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index df36f5d8..ede203bf 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -131,9 +131,17 @@ data DHTAnnouncable = forall dta tok ni r.
     , announceSendData :: dta -> tok -> Maybe ni -> IO (Maybe r)
     }
 
-data DHTLink = forall status linkid. (Show status, Typeable status, Show linkid, Typeable linkid) => DHTLink
-    { linkInit    :: String -> IO (Either String status)
+data DHTLink = forall status linkid params.
+                ( Show status
+                , Show linkid
+                , Typeable status
+                , Typeable linkid
+                , Typeable params
+                ) => DHTLink
+    { linkInit    :: params -> IO (Either String status)
+    , linkParamParser :: [String] -> Either String params
     , linkStatus  :: IO (Either String status)
+    , showLinkStatus :: status -> String
     , linkNewPipe :: String -> linkid -> IO (Either String status)
     , linkUnPipe  :: linkid -> IO (Either String status)
     }
@@ -667,7 +675,31 @@ clientSession s@Session{..} sock cnum h = do
                             mkentry (k :-> Down tm) = [ show cnt, show k, show (now - tm) ]
                                 where Just (_,(cnt,_)) = MM.lookup' k (Tox.keyAssoc keydb)
                         hPutClient h $ showColumns entries
-
+        ("c", s) | "" <- strp s -> cmd0 $ do
+                        let combinedLinkMap = Map.unions $map (dhtLinks . snd) (Map.toList dhts)
+                        -- TODO: list all connections
+                        let connections =  [[{-TODO-}]]
+                        hPutClient h $ showColumns connections
+        ("c", s) -> cmd0 $ do
+                        let combinedLinkMap = Map.unions $map (dhtLinks . snd) (Map.toList dhts)
+                        -- form new connection according of type corresponding to parameter
+                        let ws = words s
+                        result
+                          <- case ws of
+                              (linktype:rest)
+                                -> case (Map.lookup (head ws) combinedLinkMap) of
+                                    Nothing -> return . Left $ "I don't know a '" ++ head ws ++ "' link type."
+                                    Just l@(DHTLink
+                                              { linkInit        {- :: params -> IO (Either String status) -}
+                                              , linkParamParser {- :: [String] -> Either String params    -}
+                                              , showLinkStatus  {- :: status -> String                    -}
+                                              }) -> case linkParamParser rest of
+                                                        Left er -> return $ Left er
+                                                        Right params -> fmap showLinkStatus <$> linkInit params
+                              _ -> return $ Left "parse error"
+                        case result of
+                            Left er -> hPutClient h er
+                            Right statusstr -> hPutClient h statusstr
         (n, _) | n `elem` Map.keys dhts -> switchNetwork n
 
         _    -> cmd0 $ hPutClient h "error."