    {-# 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 :: MVar ()
    installLock = IO (MVar ()) -> MVar ()
    forall a. IO a -> a
    unsafePerformIO (IO (MVar ()) -> MVar ()) -> IO (MVar ()) -> MVar ()
    forall a b. (a -> b) -> a -> b
    $ () -> IO (MVar ())
    forall a. a -> IO (MVar a)
    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 :: IO Bool
    isCustomTableReady = IO Bool -> IO Bool
    forall a. IO a -> IO a
    withInstallLock (IO Bool -> IO Bool) -> IO Bool -> IO Bool
    forall a b. (a -> b) -> a -> b
    $ (Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    1) (Int -> Bool) -> IO Int -> IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO Int
    c_isCustomTableReady

    withInstallLock :: IO a -> IO a
    withInstallLock :: forall a. IO a -> IO a
    withInstallLock IO a
    act = MVar () -> (() -> IO a) -> IO a
    forall a b. MVar a -> (a -> IO b) -> IO b
    withMVar MVar ()
    installLock ((() -> IO a) -> IO a) -> (() -> IO a) -> IO a
    forall a b. (a -> b) -> a -> b
    $ IO a -> () -> IO a
    forall a b. a -> b -> a
    const IO a
    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 :: Int
    tableSize = Int
    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 (TableInstallException -> TableInstallException -> Bool
    (TableInstallException -> TableInstallException -> Bool)
    -> (TableInstallException -> TableInstallException -> Bool)
    -> Eq TableInstallException
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: TableInstallException -> TableInstallException -> Bool
    == :: TableInstallException -> TableInstallException -> Bool
    $c/= :: TableInstallException -> TableInstallException -> Bool
    /= :: TableInstallException -> TableInstallException -> Bool
    Eq, Int -> TableInstallException -> ShowS
    [TableInstallException] -> ShowS
    TableInstallException -> String
    (Int -> TableInstallException -> ShowS)
    -> (TableInstallException -> String)
    -> ([TableInstallException] -> ShowS)
    -> Show TableInstallException
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> TableInstallException -> ShowS
    showsPrec :: Int -> TableInstallException -> ShowS
    $cshow :: TableInstallException -> String
    show :: TableInstallException -> String
    $cshowList :: [TableInstallException] -> ShowS
    showList :: [TableInstallException] -> ShowS
    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 :: UnicodeWidthTable -> IO ()
    installUnicodeWidthTable UnicodeWidthTable
    table = IO () -> IO ()
    forall a. IO a -> IO a
    withInstallLock (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
        initResult <- Int -> IO Int
    initCustomTable Int
    tableSize
        when (initResult /= 0) $
            E.throwIO $ TableInitFailure initResult tableSize

        forM_ (unicodeWidthTableRanges table) $ \WidthTableRange
    r -> do
            result <- Word32 -> Word32 -> Word8 -> IO Int
    setCustomTableRange (WidthTableRange -> Word32
    rangeStart WidthTableRange
    r)
                                          (WidthTableRange -> Word32
    rangeSize WidthTableRange
    r)
                                          (WidthTableRange -> Word8
    rangeColumns WidthTableRange
    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 ()