content: {-# LANGUAGE Rank2Types          #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  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
  
  
  -- | 'User' events do have higher priority than 'System' events, so that
  -- the application stays responsive even in case of event queue congestion.
  data EventPriority = User | System deriving (Eq, Ord, Enum)
  
  
  -- | We need the viewport in order to initialize the app, which in turn will
  -- start 'Vty.Vty'. To resolve this circular dependency, we start once 'Vty.Vty'
  -- in order to determine the display viewport, and shut it down again
  -- immediately.
  viewportHack :: IO Viewport
  viewportHack = withVty $ \vty -> do
      (width, height) <- Vty.displayBounds (Vty.outputIface vty)
      pure Viewport { _vpWidth = width , _vpHeight = height }
  
  -- | Spawns a thread parallel to the action that listens to 'Vty' events and
  -- redirects them to the 'Consumer'.
  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
  
  
  -- | Passes a 'Vty' instance to the action and shuts it down properly after the
  -- action finishes. The 'Vty.inputFd' and 'Vty.outputFd' handles are connected
  -- to @\/dev\/tty@ (see 'tty').
  withVty :: (Vty -> IO a) -> IO a
  -- | Like 'withVty', but lifted to @'VgrepT' s 'IO'@.
  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)
  
  
  -- | Passes two file descriptors for read and write access to @\/dev\/tty@ to
  -- the action, and closes them after the action has finished.
  withTty :: (Fd -> IO a) -> IO a
  -- | Like 'withTty', but lifted to @'VgrepT' s 'IO'@.
  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 ()
  
  -- | Opens @\/dev\/tty@ in Read/Write mode. Should be connected to the @stdin@ and
  -- @stdout@ of a GUI process (e. g. 'Vty.Vty').
  tty :: IO Fd
  tty = openFd "/dev/tty" ReadWrite Nothing defaultFileFlags
  