content: {-# LANGUAGE CPP #-}
  {-# LANGUAGE ForeignFunctionInterface #-}
  module Graphics.Vty.UnicodeWidthTable.Install
    ( TableInstallException(..)
    , installUnicodeWidthTable
    , isCustomTableReady
    )
  where
  
  import Control.Monad (when, forM_)
  import qualified Control.Exception as E
  import GHC.Conc.Sync (withMVar)
  import Control.Concurrent.MVar (MVar, newMVar)
  import Data.Word (Word8, Word32)
  #if !(MIN_VERSION_base(4,11,0))
  import Data.Semigroup ((<>))
  #endif
  import System.IO.Unsafe (unsafePerformIO)
  
  import Graphics.Vty.UnicodeWidthTable.Types
  
  -- | The lock used to make functions in this module thread-safe.
  installLock :: MVar ()
  {-# NOINLINE installLock #-}
  installLock = unsafePerformIO $ newMVar ()
  
  -- | Returns True if and only if a custom table has been allocated and
  -- marked as ready for use.
  --
  -- This function is thread-safe.
  isCustomTableReady :: IO Bool
  isCustomTableReady = withInstallLock $ (== 1) <$> c_isCustomTableReady
  
  withInstallLock :: IO a -> IO a
  withInstallLock act = withMVar installLock $ const act
  
  -- This is the size of the allocated custom character width table, in
  -- character slots. It's important that this be large enough to hold all
  -- possible Unicode character values. At the time of this writing, the
  -- valid Unicode range is 0 - 0x10ffff, hence this value.
  tableSize :: Int
  tableSize = 0x110000
  
  -- | Exception type raised by 'installUnicodeWidthTable'.
  data TableInstallException =
      TableInitFailure Int Int
      -- ^ The width table could not be initialized. Args: failure status,
      -- requested table size.
      | TableRangeFailure Int WidthTableRange
      -- ^ A code point range could not be configured. Args: failure
      -- status, offending range.
      | TableActivationFailure Int
      -- ^ The table could not be activated. Args: failure status.
      deriving (Eq, Show)
  
  instance E.Exception TableInstallException
  
  -- | Install a custom unicode character width
  -- table. Such tables are obtained with
  -- 'Graphics.Vty.UnicodeWidthTable.Query.buildUnicodeWidthTable' and
  -- 'Graphics.Vty.UnicodeWidthTable.IO.readUnicodeWidthTable'.
  --
  -- ALERT! This function is probably not what you want to use because
  -- it is automatically called by 'Graphics.Vty.mkVty'. You will only
  -- ever need to call this function if you want to use functions
  -- in 'Graphics.Text.Width' without controlling the terminal with
  -- 'Graphics.Vty.mkVty'.
  --
  -- This affects the behavior of the 'Graphics.Vty.Image.wcwidth'
  -- function and functions that call it. It does so by
  -- changing global state available to the C implementation
  -- of 'Graphics.Vty.Image.wcwidth'. To ensure that your
  -- program gets consistent results from evaluating calls to
  -- 'Graphics.Vty.Image.wcwidth', the installation of a custom table
  -- should be performed before you call 'Graphics.Vty.Image.wcwidth' in
  -- your program.
  --
  -- This is best done at Vty startup, and if you use
  -- 'Graphics.Vty.mkVty', that function calls this automatically based on
  -- the Vty configuration's declared width tables. It is exposed as part
  -- of the public API so that applications can call this as needed if
  -- they don't want to control the terminal with 'mkVty' but do want to
  -- make calls to 'Graphics.Vty.Image.wcwidth'.
  --
  -- It's also important to note that once a custom table has been
  -- installed, it is permanent for the life of the process. No new table
  -- can be installed, and the new custom table cannot be removed.
  --
  -- If this function fails for any reason -- if the table cannot be
  -- installed or is invalid, or if a custom table already exists -- this
  -- will raise a 'TableInstallException' exception.
  --
  -- This function is thread-safe.
  installUnicodeWidthTable :: UnicodeWidthTable -> IO ()
  installUnicodeWidthTable table = withInstallLock $ do
      initResult <- initCustomTable tableSize
      when (initResult /= 0) $
          E.throwIO $ TableInitFailure initResult tableSize
  
      forM_ (unicodeWidthTableRanges table) $ \r -> do
          result <- setCustomTableRange (rangeStart r)
                                        (rangeSize r)
                                        (rangeColumns r)
  
          when (result /= 0) $ do
              deallocateCustomTable
              E.throwIO $ TableRangeFailure result r
  
      actResult <- activateCustomTable
      when (actResult /= 0) $
          E.throwIO $ TableActivationFailure actResult
  
  ------------------------------------------------------------------------
  -- C imports
  
  foreign import ccall unsafe "vty_init_custom_table"
      initCustomTable :: Int -> IO Int
  
  foreign import ccall unsafe "vty_set_custom_table_range"
      setCustomTableRange :: Word32 -> Word32 -> Word8 -> IO Int
  
  foreign import ccall unsafe "vty_activate_custom_table"
      activateCustomTable :: IO Int
  
  foreign import ccall unsafe "vty_custom_table_ready"
      c_isCustomTableReady :: IO Int
  
  foreign import ccall unsafe "vty_deallocate_custom_table"
      deallocateCustomTable :: IO ()
  