    -- Copyright 2009-2010 Corey O'Connor
    -- The standard Mac OS X terminals Terminal.app and iTerm both declare themselves to be
    -- "xterm-color" by default. However the terminfo database for xterm-color included with OS X is
    -- incomplete.
    --
    -- This terminal implementation modifies the standard terminfo terminal as required for complete OS
    -- X support.
    {-# LANGUAGE ForeignFunctionInterface #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE MagicHash #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE TypeFamilies #-}
    module Graphics.Vty.Terminal.MacOSX ( terminal_instance
                                        )
        where

    import Graphics.Vty.Terminal.Generic
    import qualified Graphics.Vty.Terminal.TerminfoBased as TerminfoBased

    import Control.Applicative
    import Control.Monad.Trans

    import System.IO

    data Term = Term
        { super_term :: TerminalHandle
        , term_app :: String
        }

    -- for Terminal.app use "xterm". For iTerm.app use "xterm-256color"
    terminal_instance :: ( Applicative m, MonadIO m ) => String -> m Term
    terminal_instance v = do
        let base_term "iTerm.app" = "xterm-256color"
            base_term _ = "xterm"
        t <- TerminfoBased.terminal_instance (base_term v) >>= new_terminal_handle
        return $ Term t v

    flushed_put :: MonadIO m => String -> m ()
    flushed_put str = do
        liftIO $ hPutStr stdout str
        liftIO $ hFlush stdout

    -- Terminal.app really does want the xterm-color smcup and rmcup caps. Not the generic xterm ones.
    smcup_str, rmcup_str :: String
    smcup_str = "\ESC7\ESC[?47h"
    rmcup_str = "\ESC[2J\ESC[?47l\ESC8"

    -- iTerm needs a clear screen after smcup as well?
    clear_screen_str :: String
    clear_screen_str = "\ESC[H\ESC[2J"

    instance Terminal Term where
        terminal_ID t = term_app t ++ " :: MacOSX"

        release_terminal t = do
            release_terminal $ super_term t

        reserve_display _t = do
            flushed_put smcup_str
            flushed_put clear_screen_str

        release_display _t = do
            flushed_put rmcup_str

        display_terminal_instance t b c = do
            d <- display_context (super_term t) b
            return $ c (DisplayContext d)

        display_bounds t = display_bounds (super_term t)

        output_byte_buffer t = output_byte_buffer (super_term t)

        output_handle t = output_handle (super_term t)

    data DisplayContext = DisplayContext
        { super_display :: DisplayHandle
        }

    instance DisplayTerminal DisplayContext where
        context_region d = context_region (super_display d)
        context_color_count d = context_color_count (super_display d)

        move_cursor_required_bytes d = move_cursor_required_bytes (super_display d)
        serialize_move_cursor d = serialize_move_cursor (super_display d)

        show_cursor_required_bytes d = show_cursor_required_bytes (super_display d)
        serialize_show_cursor d = serialize_show_cursor (super_display d)

        hide_cursor_required_bytes d = hide_cursor_required_bytes (super_display d)
        serialize_hide_cursor d = serialize_hide_cursor (super_display d)

        attr_required_bytes d = attr_required_bytes (super_display d)
        serialize_set_attr d = serialize_set_attr (super_display d)

        default_attr_required_bytes d = default_attr_required_bytes (super_display d)
        serialize_default_attr d = serialize_default_attr (super_display d)