diff options
author | joe <joe@jerkface.net> | 2013-06-15 15:07:19 -0400 |
---|---|---|
committer | joe <joe@jerkface.net> | 2013-06-15 15:07:19 -0400 |
commit | 9fd2107e6a7469fe7ba51448e4fe195bf54d7d29 (patch) | |
tree | bb37572b478170e461990695e7d9e6ab823f7606 /Presence/FGConsole.hs |
started project
Diffstat (limited to 'Presence/FGConsole.hs')
-rw-r--r-- | Presence/FGConsole.hs | 62 |
1 files changed, 62 insertions, 0 deletions
diff --git a/Presence/FGConsole.hs b/Presence/FGConsole.hs new file mode 100644 index 00000000..fc1ece65 --- /dev/null +++ b/Presence/FGConsole.hs | |||
@@ -0,0 +1,62 @@ | |||
1 | {-# LANGUAGE ForeignFunctionInterface #-} | ||
2 | {-# LANGUAGE ScopedTypeVariables #-} | ||
3 | module FGConsole where | ||
4 | |||
5 | import Data.Word | ||
6 | import System.Posix.IO | ||
7 | import System.Posix.Types | ||
8 | import Control.Concurrent | ||
9 | -- import GHC.IO.Handle | ||
10 | import Unsafe.Coerce | ||
11 | import Control.Exception as E | ||
12 | -- import Prelude as E | ||
13 | import Control.Monad | ||
14 | import Foreign.C.Error | ||
15 | import Foreign.C | ||
16 | |||
17 | import Todo | ||
18 | import Debug.Trace | ||
19 | import System.Posix.Signals | ||
20 | |||
21 | -- c_monitorTTY fd = trace "c_monitorTTY" (return ()) -- (trace "WTF" todo) | ||
22 | |||
23 | foreign import ccall "monitorTTY" c_monitorTTY :: Fd -> IO () | ||
24 | foreign import ccall "closeTTY" c_closeTTY :: IO () | ||
25 | |||
26 | monitorTTY :: (Word8 -> IO ()) -> IO (Fd,ThreadId) | ||
27 | monitorTTY handler = do | ||
28 | (rfd,wfd) <- createPipe | ||
29 | thread <- forkIO $ do | ||
30 | let cleanup = do | ||
31 | trace "quitting monitorTTY thread." (return ()) | ||
32 | closeFd wfd `E.catch` \(e::IOException) -> return () | ||
33 | closeFd rfd `E.catch` \(e::IOException) -> return () | ||
34 | c_closeTTY | ||
35 | -- rh <- fdToHandle rfd | ||
36 | c_monitorTTY wfd | ||
37 | let monitor = | ||
38 | (do | ||
39 | threadWaitRead rfd | ||
40 | (cs,cnt) <- fdRead rfd 1 | ||
41 | forM_ cs (handler . unsafeCoerce . trace "read byte") | ||
42 | monitor) | ||
43 | `E.catch` | ||
44 | \(e :: IOException) -> do | ||
45 | err <- getErrno | ||
46 | case () of | ||
47 | _ | err==eAGAIN -> monitor | ||
48 | _ | otherwise -> cleanup | ||
49 | `E.catch` | ||
50 | \(e :: AsyncException) -> cleanup | ||
51 | monitor | ||
52 | return (rfd,thread) | ||
53 | |||
54 | unmonitorTTY (rfd,thread) = do | ||
55 | closeFd rfd | ||
56 | yield | ||
57 | killThread thread | ||
58 | raiseSignal sigUSR1 | ||
59 | -- threadDelay 1000000 | ||
60 | |||
61 | |||
62 | -- vim:ft=haskell: | ||