module System.Console.Haskeline.Term where
import System.Console.Haskeline.Monads
import System.Console.Haskeline.LineState
import System.Console.Haskeline.Command
import Control.Concurrent
import Control.Concurrent.STM
import Data.Typeable
class (MonadReader Layout m, MonadException m) => Term m where
reposition :: Layout -> LineChars -> m ()
moveToNextLine :: LineChars -> m ()
printLines :: [String] -> m ()
drawLineDiff :: LineChars -> LineChars -> m ()
clearLayout :: m ()
ringBell :: Bool -> m ()
data RunTerm = RunTerm {
putStrOut :: String -> IO (),
termOps :: Maybe TermOps,
wrapInterrupt :: MonadException m => m a -> m a,
closeTerm :: IO ()
}
data TermOps = TermOps {runTerm :: RunTermType,
getLayout :: IO Layout}
type RunTermType = forall m a . (MonadLayout m, MonadException m)
=> (forall t . (MonadTrans t, Term (t m), MonadException (t m))
=> (t m Event -> t m a)) -> m a
matchInit :: Eq a => [a] -> [a] -> ([a],[a])
matchInit (x:xs) (y:ys) | x == y = matchInit xs ys
matchInit xs ys = (xs,ys)
data Event = WindowResize Layout | KeyInput Key
deriving Show
keyEventLoop :: (TChan Event -> IO ()) -> TChan Event -> IO Event
keyEventLoop readKey eventChan = do
me <- atomically $ tryReadTChan eventChan
case me of
Just e -> return e
Nothing -> do
tid <- forkIO (readKey eventChan)
(atomically $ readTChan eventChan)
`finally` killThread tid
tryReadTChan :: TChan a -> STM (Maybe a)
tryReadTChan chan = fmap Just (readTChan chan) `orElse` return Nothing
class (MonadReader Layout m, MonadIO m) => MonadLayout m where
data Interrupt = Interrupt
deriving (Show,Typeable,Eq)