{-# LINE 1 "Data/Text/ICU/CharsetDetection/Internal.hsc" #-}
{-# LANGUAGE DeriveDataTypeable, ForeignFunctionInterface, EmptyDataDecls #-}
-- |
-- Module      : Data.Text.ICU.CharsetDetection.Internal
-- Copyright   : (c) 2017 Zac Slade
--
-- License     : BSD-style
-- Maintainer  : bos@serpentine.com
-- Stability   : experimental
-- Portability : GHC
--
-- Access to the Unicode Character Set Detection facilities, implemented in
-- the International Components for Unicode (ICU) libraries.
--
-- For more information see the \"Character Set Detection\" chapter
-- in the ICU User Guide
-- <http://userguide.icu-project.org/conversion/detection>.
module Data.Text.ICU.CharsetDetection.Internal
    (
      UCharsetDetector
    , UCharsetMatch
    , CharsetMatch(..)
    , CharsetDetector(..)
    , withCharsetDetector
    , wrapUCharsetDetector
    , wrapUCharsetMatch
    , mkCharsetDetector
    , withCharsetMatch
    ) where

import Data.Typeable (Typeable)
import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)
import Foreign.Ptr (FunPtr, Ptr)

import Data.Text.ICU.Error.Internal (UErrorCode, handleError)
import Data.Text.ICU.Internal (newICUPtr)



-- | Opaque handle to a character set detector
data UCharsetDetector

-- | Handy wrapper for the pointer to the 'UCharsetDetector'. We must
-- always call ucsdet_close on any UCharsetDetector when we are done. The
-- 'withCharsetDetector' and 'wrapUCharsetDetector' functions simplify
-- management of the pointers.
data CharsetDetector = CharsetDetector {
    CharsetDetector -> ForeignPtr UCharsetDetector
charsetDetectorPtr :: {-# UNPACK #-} !(ForeignPtr UCharsetDetector)
} deriving (Typeable)

mkCharsetDetector :: IO CharsetDetector
mkCharsetDetector :: IO CharsetDetector
mkCharsetDetector = IO (Ptr UCharsetDetector) -> IO CharsetDetector
wrapUCharsetDetector (IO (Ptr UCharsetDetector) -> IO CharsetDetector)
-> IO (Ptr UCharsetDetector) -> IO CharsetDetector
forall a b. (a -> b) -> a -> b
$ (Ptr UErrorCode -> IO (Ptr UCharsetDetector))
-> IO (Ptr UCharsetDetector)
forall a. (Ptr UErrorCode -> IO a) -> IO a
handleError Ptr UErrorCode -> IO (Ptr UCharsetDetector)
ucsdet_open

-- | Temporarily unwraps an 'CharsetDetector' to perform operations on its
-- raw 'UCharsetDetector' handle.
withCharsetDetector :: CharsetDetector -> (Ptr UCharsetDetector -> IO a) -> IO a
withCharsetDetector :: forall a. CharsetDetector -> (Ptr UCharsetDetector -> IO a) -> IO a
withCharsetDetector (CharsetDetector ForeignPtr UCharsetDetector
ucsd) = ForeignPtr UCharsetDetector
-> (Ptr UCharsetDetector -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr UCharsetDetector
ucsd
{-# INLINE withCharsetDetector #-}

-- | Wraps a raw 'UCharsetDetector' in an 'CharsetDetector', closing the
-- handle when the last reference to the object is dropped.
wrapUCharsetDetector :: IO (Ptr UCharsetDetector) -> IO CharsetDetector
wrapUCharsetDetector :: IO (Ptr UCharsetDetector) -> IO CharsetDetector
wrapUCharsetDetector = (ForeignPtr UCharsetDetector -> CharsetDetector)
-> FinalizerPtr UCharsetDetector
-> IO (Ptr UCharsetDetector)
-> IO CharsetDetector
forall a i.
(ForeignPtr a -> i) -> FinalizerPtr a -> IO (Ptr a) -> IO i
newICUPtr ForeignPtr UCharsetDetector -> CharsetDetector
CharsetDetector FinalizerPtr UCharsetDetector
ucsdet_close
{-# INLINE wrapUCharsetDetector #-}

-- | Opaque handle to a character set match
data UCharsetMatch

-- | Opaque character set match handle. The memory backing these objects is
-- managed entirely by the ICU C library.
-- TODO: UCharsetMatch is reset after the setText call. We need to handle it.
data CharsetMatch =
    CharsetMatch
    { CharsetMatch -> Ptr UCharsetMatch
charsetMatchPtr :: {-# UNPACK #-} !(Ptr UCharsetMatch)
    , CharsetMatch -> CharsetDetector
charsetMatchDetector :: CharsetDetector
    -- ^ keep reference since UCharsetMatch object is owned
    -- by the UCharsetDetector.
    }
    deriving (Typeable)

wrapUCharsetMatch :: CharsetDetector -> IO (Ptr UCharsetMatch) -> IO CharsetMatch
wrapUCharsetMatch :: CharsetDetector -> IO (Ptr UCharsetMatch) -> IO CharsetMatch
wrapUCharsetMatch CharsetDetector
cd = (Ptr UCharsetMatch -> CharsetMatch)
-> IO (Ptr UCharsetMatch) -> IO CharsetMatch
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Ptr UCharsetMatch -> CharsetMatch)
 -> IO (Ptr UCharsetMatch) -> IO CharsetMatch)
-> (Ptr UCharsetMatch -> CharsetMatch)
-> IO (Ptr UCharsetMatch)
-> IO CharsetMatch
forall a b. (a -> b) -> a -> b
$ (Ptr UCharsetMatch -> CharsetDetector -> CharsetMatch)
-> CharsetDetector -> Ptr UCharsetMatch -> CharsetMatch
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ptr UCharsetMatch -> CharsetDetector -> CharsetMatch
CharsetMatch CharsetDetector
cd

withCharsetMatch :: CharsetMatch -> (Ptr UCharsetMatch -> IO a) -> IO a
withCharsetMatch :: forall a. CharsetMatch -> (Ptr UCharsetMatch -> IO a) -> IO a
withCharsetMatch (CharsetMatch Ptr UCharsetMatch
ucsm CharsetDetector
_) Ptr UCharsetMatch -> IO a
f = Ptr UCharsetMatch -> IO a
f Ptr UCharsetMatch
ucsm

foreign import ccall unsafe "hs_text_icu.h &__hs_ucsdet_close" ucsdet_close
    :: FunPtr (Ptr UCharsetDetector -> IO ())

foreign import ccall unsafe "hs_text_icu.h __hs_ucsdet_open" ucsdet_open
    :: Ptr UErrorCode -> IO (Ptr UCharsetDetector)