{-# OPTIONS_HADDOCK hide #-}

module Graphics.Vty.Inline.Unsafe 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 = IO (IORef (Maybe Vty)) -> IORef (Maybe Vty)
forall a. IO a -> a
unsafePerformIO (IO (IORef (Maybe Vty)) -> IORef (Maybe Vty))
-> IO (IORef (Maybe Vty)) -> IORef (Maybe Vty)
forall a b. (a -> b) -> a -> b
$ Maybe Vty -> IO (IORef (Maybe Vty))
forall a. a -> IO (IORef a)
newIORef Maybe Vty
forall a. Maybe a
Nothing

globalOutput :: IORef (Maybe Output)
{-# NOINLINE globalOutput #-}
globalOutput :: IORef (Maybe Output)
globalOutput = IO (IORef (Maybe Output)) -> IORef (Maybe Output)
forall a. IO a -> a
unsafePerformIO (IO (IORef (Maybe Output)) -> IORef (Maybe Output))
-> IO (IORef (Maybe Output)) -> IORef (Maybe Output)
forall a b. (a -> b) -> a -> b
$ Maybe Output -> IO (IORef (Maybe Output))
forall a. a -> IO (IORef a)
newIORef Maybe Output
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 IO Handle -> (Handle -> IO Fd) -> IO Fd
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 IO Handle -> (Handle -> IO Fd) -> IO Fd
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Handle -> IO Fd
handleToFd
    Config -> IO Config
forall (m :: * -> *) a. Monad m => a -> m a
return (Config -> IO Config) -> Config -> IO Config
forall a b. (a -> b) -> a -> b
$ Config
defaultConfig { inputFd :: Maybe Fd
inputFd = Fd -> Maybe Fd
forall a. a -> Maybe a
Just Fd
stdinDupe, outputFd :: Maybe Fd
outputFd = Fd -> Maybe Fd
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 :: (Vty -> IO b) -> IO b
withVty Vty -> IO b
f = do
    Maybe Vty
mvty <- IORef (Maybe Vty) -> IO (Maybe Vty)
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 IO Config -> (Config -> IO Vty) -> IO Vty
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Config -> IO Vty
mkVty
            IORef (Maybe Vty) -> Maybe Vty -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe Vty)
globalVty (Vty -> Maybe Vty
forall a. a -> Maybe a
Just Vty
vty)
            Vty -> IO Vty
forall (m :: * -> *) a. Monad m => a -> m a
return Vty
vty
        Just Vty
vty -> Vty -> IO 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 :: (Output -> IO b) -> IO b
withOutput Output -> IO b
f = do
    Maybe Output
mout <- IORef (Maybe Output) -> IO (Maybe Output)
forall a. IORef a -> IO a
readIORef IORef (Maybe Output)
globalOutput
    Output
out <- case Maybe Output
mout of
        Maybe Output
Nothing -> do
            Config
config <- Config -> Config -> Config
forall a. Monoid a => a -> a -> a
mappend (Config -> Config -> Config) -> IO Config -> IO (Config -> Config)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Config
userConfig IO (Config -> Config) -> IO Config -> IO Config
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO Config
mkDupeConfig
            Output
out <- Config -> IO Output
outputForConfig Config
config
            IORef (Maybe Output) -> Maybe Output -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe Output)
globalOutput (Output -> Maybe Output
forall a. a -> Maybe a
Just Output
out)
            Output -> IO Output
forall (m :: * -> *) a. Monad m => a -> m a
return Output
out
        Just Output
out -> Output -> IO Output
forall (m :: * -> *) a. Monad m => a -> m a
return Output
out
    Output -> IO b
f Output
out