lib/Terminal.hs


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41

{-# LANGUAGE RecordWildCards #-}
module Terminal
    ( Config(..)
    , setConfig
    , withConfig
    )
  where

import Control.Exception
import Data.List
import System.IO

data Config = Config
    { hin :: Handle
    , hout :: Handle
    , hinEcho :: Bool
    , hinBufferMode :: BufferMode
    , houtBufferMode :: BufferMode
    , decsetPm :: [Int]
    , decrstPm :: [Int]
    }

setConfig :: Config -> IO Config
setConfig Config{..} = get <* set where
  get = Config <$> pure hin
               <*> pure hout
               <*> hGetEcho hin
               <*> hGetBuffering hin
               <*> hGetBuffering hout
               <*> pure decrstPm
               <*> pure decsetPm
  set = do
      hSetEcho hin hinEcho
      hSetBuffering hin hinBufferMode
      hSetBuffering hout houtBufferMode
      hPutStr hout $ "\ESC[?" <> intercalate ";" (map show decsetPm) <> "h"
      hPutStr hout $ "\ESC[?" <> intercalate ";" (map show decrstPm) <> "l"
      hFlush hout

withConfig :: Config -> IO a -> IO a
withConfig s = bracket (setConfig s) setConfig . const