Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Deal with #close, change disconnect behavior and fix a bug about PhiV…

…ty.Socket close.
  • Loading branch information...
commit 121eaa0ec3bdaf00ecd82e67c48b9f67a59318d5 1 parent df3d183
napthats authored
Showing with 11 additions and 9 deletions.
  1. +2 −0  PhiVty/Protocol.hs
  2. +5 −4 PhiVty/Socket.hs
  3. +4 −5 PhiVty/UI.hs
2  PhiVty/Protocol.hs
View
@@ -16,6 +16,7 @@ data ServerProtocol =
| ExNotice (String, String)
| PhiList [String]
| SEdit
+ | Close
| Unfinished ServerProtocol
| Unknown String
@@ -65,6 +66,7 @@ parse u_mes ('#':protocol) =
Just (PhiList x) -> PhiList x
_ -> Unknown ""
"s-edit" -> SEdit
+ "close" -> Close
_ -> Unknown protocol
parse (Just (PhiList list)) mes = Unfinished $ PhiList $ list ++ [phiDecode mes]
parse _ mes =
9 PhiVty/Socket.hs
View
@@ -46,11 +46,12 @@ connect soc recv_handler = do
close :: PhiSocket -> IO ()
close soc = do
maybe_tid <- tryTakeMVar $ recvThreadId soc
+ _ <- tryTakeMVar $ internalHandle soc
case maybe_tid of
Nothing -> return ()
Just tid -> do
killThread tid
- _ <- takeMVar (internalHandle soc)
+-- _ <- takeMVar (internalHandle soc)
return ()
send :: String -> PhiSocket -> IO ()
@@ -58,7 +59,7 @@ send mes soc = do
maybe_handle <- tryTakeMVar $ internalHandle soc
case maybe_handle of
Nothing -> return ()
- Just internal_handle -> do {
- hPutStrLn internal_handle mes;
- putMVar (internalHandle soc) internal_handle}
+ Just internal_handle ->
+ hPutStrLn internal_handle mes
`catch` (\(SomeException _) -> return ())
+ `finally` putMVar (internalHandle soc) internal_handle
9 PhiVty/UI.hs
View
@@ -146,9 +146,7 @@ makeWindowWithChara menu_item c chara_id host_name port_num collection = do
let menu_item_innner = case menu_item of MultiStringListData list -> list
menu <- makeMultiStringList $ MultiStringListData $ menu_item_innner ++ [
("Connect", Left $ do {action <- readMVar connect_action_mvar; action}),
- ("Disconnect", Left $ do {
- send "exit" soc;
- close soc})]
+ ("Disconnect", Left $ send "exit" soc)]
upper_left_box_wmenu <- centered menu <--> ((return title <--> return mp) >>= centered)
setBoxChildSizePolicy upper_left_box_wmenu $ Percentage 50
upper_box_wmenu <- (return upper_left_box_wmenu <++> return mes)
@@ -175,6 +173,7 @@ makeWindowWithChara menu_item c chara_id host_name port_num collection = do
m_u_mes <- newMVar Nothing
let recv_handler new_mes = do
u_mes <- takeMVar m_u_mes
+ putMVar m_u_mes Nothing
do {case parse u_mes new_mes of
NormalMessage n_mes -> do
addMessage uidata c n_mes
@@ -194,12 +193,12 @@ makeWindowWithChara menu_item c chara_id host_name port_num collection = do
snd (foldl (\(ord, acc) elm -> (ord+1, (acc ++ [("(" ++ show ord ++ ")" ++ elm)]))) (1 :: Integer, []) list) ++ ["---------------"]
SEdit -> cdo c $ do
setUIState UISEdit
- Unfinished u -> putMVar m_u_mes $ Just u
+ Close -> close soc
+ Unfinished u -> modifyMVar_ m_u_mes $ const $ return $ Just u
Unknown "" -> return ()
Unknown un_mes -> do
addMessage uidata c $ '#' : un_mes
}
- _ <- tryPutMVar m_u_mes Nothing
return ()
putMVar connect_action_mvar $ do {
connect soc recv_handler;
Please sign in to comment.
Something went wrong with that request. Please try again.