module Vgrep.App.Internal where
import Control.Concurrent.Async
import Control.Exception
import Graphics.Vty (Vty)
import qualified Graphics.Vty as Vty
import Pipes
import System.Posix.IO
import System.Posix.Types (Fd)
import Vgrep.Type
data EventPriority = User | System deriving (Eq, Ord, Enum)
viewportHack :: IO Viewport
viewportHack = withVty $ \vty -> do
(width, height) <- Vty.displayBounds (Vty.outputIface vty)
pure Viewport { _vpWidth = width , _vpHeight = height }
withEvThread :: Consumer Vty.Event IO () -> Vty -> VgrepT s IO a -> VgrepT s IO a
withEvThread sink vty =
vgrepBracket createEvThread cancel . const
where
createEvThread = (async . runEffect) $ lift (Vty.nextEvent vty) >~ sink
withVty :: (Vty -> IO a) -> IO a
withVgrepVty :: (Vty -> VgrepT s IO a) -> VgrepT s IO a
(withVty, withVgrepVty) =
let initVty fd = do
cfg <- Vty.standardIOConfig
Vty.mkVty cfg { Vty.inputFd = Just fd
, Vty.outputFd = Just fd }
in ( \action -> withTty $ \fd -> bracket (initVty fd) Vty.shutdown action
, \action -> withVgrepTty $ \fd -> vgrepBracket (initVty fd) Vty.shutdown action)
withTty :: (Fd -> IO a) -> IO a
withVgrepTty :: (Fd -> VgrepT s IO a) -> VgrepT s IO a
(withTty, withVgrepTty) = (bracket before after, vgrepBracket before after)
where
before = tty
after fd = closeFd fd `catch` ignoreIOException
ignoreIOException :: IOException -> IO ()
ignoreIOException _ = pure ()
tty :: IO Fd
tty = openFd "/dev/tty" ReadWrite Nothing defaultFileFlags