{-# OPTIONS_HADDOCK hide #-}

module Graphics.Vty.Inline.Unsafe
  ( withOutput
  , withVty
  )
where

import Graphics.Vty

import Data.IORef

import GHC.IO.Handle (hDuplicate)

import System.IO (stdin, stdout, hSetBuffering, BufferMode(NoBuffering))

import System.IO.Unsafe

import System.Posix.IO (handleToFd)

globalVty :: IORef (Maybe Vty)
{-# NOINLINE globalVty #-}
globalVty :: IORef (Maybe Vty)
globalVty = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef forall a. Maybe a
Nothing

globalOutput :: IORef (Maybe Output)
{-# NOINLINE globalOutput #-}
globalOutput :: IORef (Maybe Output)
globalOutput = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef forall a. Maybe a
Nothing

mkDupeConfig :: IO Config
mkDupeConfig :: IO Config
mkDupeConfig = do
    Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdout BufferMode
NoBuffering
    Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdin BufferMode
NoBuffering
    Fd
stdinDupe <- Handle -> IO Handle
hDuplicate Handle
stdin forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Handle -> IO Fd
handleToFd
    Fd
stdoutDupe <- Handle -> IO Handle
hDuplicate Handle
stdout forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Handle -> IO Fd
handleToFd
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Config
defaultConfig { inputFd :: Maybe Fd
inputFd = forall a. a -> Maybe a
Just Fd
stdinDupe, outputFd :: Maybe Fd
outputFd = forall a. a -> Maybe a
Just Fd
stdoutDupe }

-- | This will create a Vty instance using 'mkVty' and execute an IO
-- action provided that instance. The created Vty instance will be
-- stored to the unsafe 'IORef' 'globalVty'.
--
-- This instance will use duplicates of the stdin and stdout Handles.
withVty :: (Vty -> IO b) -> IO b
withVty :: forall b. (Vty -> IO b) -> IO b
withVty Vty -> IO b
f = do
    Maybe Vty
mvty <- forall a. IORef a -> IO a
readIORef IORef (Maybe Vty)
globalVty
    Vty
vty <- case Maybe Vty
mvty of
        Maybe Vty
Nothing -> do
            Vty
vty <- IO Config
mkDupeConfig forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Config -> IO Vty
mkVty
            forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe Vty)
globalVty (forall a. a -> Maybe a
Just Vty
vty)
            forall (m :: * -> *) a. Monad m => a -> m a
return Vty
vty
        Just Vty
vty -> forall (m :: * -> *) a. Monad m => a -> m a
return Vty
vty
    Vty -> IO b
f Vty
vty

withOutput :: (Output -> IO b) -> IO b
withOutput :: forall b. (Output -> IO b) -> IO b
withOutput Output -> IO b
f = do
    Maybe Output
mout <- forall a. IORef a -> IO a
readIORef IORef (Maybe Output)
globalOutput
    Output
out <- case Maybe Output
mout of
        Maybe Output
Nothing -> do
            Config
config <- forall a. Monoid a => a -> a -> a
mappend forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Config
userConfig forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO Config
mkDupeConfig
            Output
out <- Config -> IO Output
outputForConfig Config
config
            forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe Output)
globalOutput (forall a. a -> Maybe a
Just Output
out)
            forall (m :: * -> *) a. Monad m => a -> m a
return Output
out
        Just Output
out -> forall (m :: * -> *) a. Monad m => a -> m a
return Output
out
    Output -> IO b
f Output
out