-- GENERATED by C->Haskell Compiler, version 0.28.1 Switcheroo, 1 April 2016 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/Language/Enchant.chs" #-}
{-# LANGUAGE ForeignFunctionInterface #-}



-- | Binding to the Enchant library.
module Language.Enchant
  ( Broker
  , brokerDescribe
  , brokerDictExists
  , brokerFree
  , brokerFreeDict
  , brokerGetError
  , brokerGetParam
  , brokerInit
  , brokerListDicts
  , brokerRequestDict
  , brokerRequestPwlDict
  , brokerSetOrdering
  , brokerSetParam
  , Dict
  , dictAdd
  , dictAddToSession
  , dictCheck
  , dictDescribe
  , dictGetError
  , dictIsAdded
  , dictIsRemoved
  , dictRemove
  , dictRemoveFromSession
  , dictStoreReplacement
  , dictSuggest
  , getVersion
  , Provider(..)
  , withBroker
  , withDict
  ) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Marshal.Utils as C2HSImp
import qualified Foreign.Ptr as C2HSImp



import Control.Exception
import Control.Monad
import Data.IORef
import Foreign.C.String
import Foreign.C.Types
import Foreign.C.UTF8
import Foreign.Marshal
import Foreign.Ptr
import Foreign.StablePtr
import Foreign.Storable

data Broker'
type Broker = C2HSImp.Ptr (Broker')
{-# LINE 50 "src/Language/Enchant.chs" #-}

data Dict'
type Dict = C2HSImp.Ptr (Dict')
{-# LINE 52 "src/Language/Enchant.chs" #-}


-- | Returns the Enchant version.
getVersion :: IO ((String))
getVersion =
  getVersion'_ >>= \res ->
  peekUTF8String res >>= \res' ->
  return (res')

{-# LINE 55 "src/Language/Enchant.chs" #-}


-- | Creates a new broker object.
brokerInit :: IO ((Broker))
brokerInit =
  brokerInit'_ >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 58 "src/Language/Enchant.chs" #-}


-- | Frees a broker resource with all its dictionaries.
brokerFree :: (Broker) -> IO ()
brokerFree a1 =
  let {a1' = id a1} in 
  brokerFree'_ a1' >>
  return ()

{-# LINE 61 "src/Language/Enchant.chs" #-}


-- | Creates a new dictionary using tag, the non-empty language tag you wish
-- to request a dictionary for ("en_US", "de_DE", ...)
brokerRequestDict :: (Broker) -> (String) -> IO ((Dict))
brokerRequestDict a1 a2 =
  let {a1' = id a1} in 
  withUTF8String a2 $ \a2' -> 
  brokerRequestDict'_ a1' a2' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 65 "src/Language/Enchant.chs" #-}


-- | Creates a dictionary using a PWL file. A PWL file is personal word file
-- one word per line.
brokerRequestPwlDict :: (Broker) -> (String) -> IO ((Dict))
brokerRequestPwlDict a1 a2 =
  let {a1' = id a1} in 
  withUTF8String a2 $ \a2' -> 
  brokerRequestPwlDict'_ a1' a2' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 69 "src/Language/Enchant.chs" #-}


-- | Frees a dictionary resource.
brokerFreeDict :: (Broker) -> (Dict) -> IO ()
brokerFreeDict a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  brokerFreeDict'_ a1' a2' >>
  return ()

{-# LINE 72 "src/Language/Enchant.chs" #-}


-- | Tells if a dictionary exists or not, using a non-empty tags.
brokerDictExists :: (Broker) -> (String) -> IO ((Bool))
brokerDictExists a1 a2 =
  let {a1' = id a1} in 
  withUTF8String a2 $ \a2' -> 
  brokerDictExists'_ a1' a2' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

{-# LINE 75 "src/Language/Enchant.chs" #-}


-- | @brokerSetOrdering tag ordering@ declares a preference of dictionaries to
-- use for the language described/referred to by @tag@. The ordering is a comma
-- delimited list of provider names. As a special exception, the "*" tag can be
-- used as a language tag to declare a default ordering for any language that
-- does not explicitly declare an ordering.
brokerSetOrdering :: (Broker) -> (String) -> (String) -> IO ()
brokerSetOrdering a1 a2 a3 =
  let {a1' = id a1} in 
  withUTF8String a2 $ \a2' -> 
  withUTF8String a3 $ \a3' -> 
  brokerSetOrdering'_ a1' a2' a3' >>
  return ()

{-# LINE 82 "src/Language/Enchant.chs" #-}


-- | Returns the last error which occurred in this broker.
brokerGetError :: (Broker) -> IO ((String))
brokerGetError a1 =
  let {a1' = id a1} in 
  brokerGetError'_ a1' >>= \res ->
  peekUTF8String res >>= \res' ->
  return (res')

{-# LINE 85 "src/Language/Enchant.chs" #-}


brokerGetParam :: (Broker) -> (String) -> IO ((String))
brokerGetParam a1 a2 =
  let {a1' = id a1} in 
  withUTF8String a2 $ \a2' -> 
  brokerGetParam'_ a1' a2' >>= \res ->
  peekUTF8String res >>= \res' ->
  return (res')

{-# LINE 87 "src/Language/Enchant.chs" #-}

brokerSetParam :: (Broker) -> (String) -> (String) -> IO ()
brokerSetParam a1 a2 a3 =
  let {a1' = id a1} in 
  withUTF8String a2 $ \a2' -> 
  withUTF8String a3 $ \a3' -> 
  brokerSetParam'_ a1' a2' a3' >>
  return ()

{-# LINE 88 "src/Language/Enchant.chs" #-}


type BrokerDescribeFn = CString -> CString -> CString -> Ptr () -> IO ()

foreign import ccall "wrapper"
  createBrokerDescriberFn :: BrokerDescribeFn -> IO (FunPtr BrokerDescribeFn)

withBrokerDescribeFn f a = createBrokerDescriberFn f >>= a

_brokerDescribe :: (Broker) -> (BrokerDescribeFn) -> (Ptr ()) -> IO ()
_brokerDescribe a1 a2 a3 =
  let {a1' = id a1} in 
  withBrokerDescribeFn a2 $ \a2' -> 
  let {a3' = id a3} in 
  _brokerDescribe'_ a1' a2' a3' >>
  return ()

{-# LINE 97 "src/Language/Enchant.chs" #-}


-- | Information of the Enchant provider
data Provider = Provider
  { langTag :: String         -- ^ The dictionary's language tag (eg: en_US, de_AT, ...)
  , providerName :: String    -- ^ The provider's name (eg: Aspell)
  , providerDesc :: String    -- ^ The provider's description (eg: Aspell 0.50.3)
  , providerDllName :: String -- ^ The DLL/SO where this dict's provider was loaded from in Glib file encoding
  } deriving (Eq, Show)

-- | Enumerates the Enchant providers and tells you some rudimentary information about them.
brokerDescribe :: Broker -> IO [Provider]
brokerDescribe b = do
  acc <- newIORef []
  let cb pName pDesc pDllFile _ = do name <- peekUTF8String pName
                                     desc <- peekUTF8String pDesc
                                     dllFile <- peekUTF8String pDllFile
                                     let p = Provider "" name desc dllFile
                                     modifyIORef acc (p:)
  _brokerDescribe b cb nullPtr
  readIORef acc

withUTF8StringLenIntConv :: Num n => String -> ((CString, n) -> IO a) -> IO a
withUTF8StringLenIntConv s f = withUTF8StringLen s $ \(p, n) -> f (p, fromIntegral n)

-- | Checks whether a word is correctly spelled or not.
dictCheck :: (Dict) -> (String) -> IO ((Bool))
dictCheck a1 a2 =
  let {a1' = id a1} in 
  withUTF8StringLenIntConv a2 $ \(a2'1, a2'2) -> 
  dictCheck'_ a1' a2'1  a2'2 >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

{-# LINE 123 "src/Language/Enchant.chs" #-}


-- | Adds a word to the given dictionary.
dictAdd :: (Dict) -> (String) -> IO ()
dictAdd a1 a2 =
  let {a1' = id a1} in 
  withUTF8StringLenIntConv a2 $ \(a2'1, a2'2) -> 
  dictAdd'_ a1' a2'1  a2'2 >>
  return ()

{-# LINE 126 "src/Language/Enchant.chs" #-}


-- | Adds a word to the given dictionary. It will be added only for the active
-- spell-checking session.
dictAddToSession :: (Dict) -> (String) -> IO ()
dictAddToSession a1 a2 =
  let {a1' = id a1} in 
  withUTF8StringLenIntConv a2 $ \(a2'1, a2'2) -> 
  dictAddToSession'_ a1' a2'1  a2'2 >>
  return ()

{-# LINE 130 "src/Language/Enchant.chs" #-}


-- | Removes the word from the given dictionary.
dictRemove :: (Dict) -> (String) -> IO ()
dictRemove a1 a2 =
  let {a1' = id a1} in 
  withUTF8StringLenIntConv a2 $ \(a2'1, a2'2) -> 
  dictRemove'_ a1' a2'1  a2'2 >>
  return ()

{-# LINE 133 "src/Language/Enchant.chs" #-}


-- | Removes the word from the given dictionary. It will be only removed from
-- the active spell-checking session.
dictRemoveFromSession :: (Dict) -> (String) -> IO ()
dictRemoveFromSession a1 a2 =
  let {a1' = id a1} in 
  withUTF8StringLenIntConv a2 $ \(a2'1, a2'2) -> 
  dictRemoveFromSession'_ a1' a2'1  a2'2 >>
  return ()

{-# LINE 137 "src/Language/Enchant.chs" #-}


-- | Returns true if the word is added to the given dictionary.
dictIsAdded :: (Dict) -> (String) -> IO ((Bool))
dictIsAdded a1 a2 =
  let {a1' = id a1} in 
  withUTF8StringLenIntConv a2 $ \(a2'1, a2'2) -> 
  dictIsAdded'_ a1' a2'1  a2'2 >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

{-# LINE 140 "src/Language/Enchant.chs" #-}


-- | Returns true if the word is removed from the given dictionary.
dictIsRemoved :: (Dict) -> (String) -> IO ((Bool))
dictIsRemoved a1 a2 =
  let {a1' = id a1} in 
  withUTF8StringLenIntConv a2 $ \(a2'1, a2'2) -> 
  dictIsRemoved'_ a1' a2'1  a2'2 >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

{-# LINE 143 "src/Language/Enchant.chs" #-}


-- | @dictStoreReplacement dict mis cor@ adds a correction for @mis@ using @cor@.
--
-- Notes that you replaced @mis@ with @cor@, so it's possibly more likely that
-- future occurrences of @mis@ will be replaced with @cor@. So it might bump
-- @cor@ up in the suggestion list.
dictStoreReplacement :: (Dict) -> (String) -> (String) -> IO ()
dictStoreReplacement a1 a2 a3 =
  let {a1' = id a1} in 
  withUTF8StringLenIntConv a2 $ \(a2'1, a2'2) -> 
  withUTF8StringLenIntConv a3 $ \(a3'1, a3'2) -> 
  dictStoreReplacement'_ a1' a2'1  a2'2 a3'1  a3'2 >>
  return ()

{-# LINE 150 "src/Language/Enchant.chs" #-}


_dictSuggest :: (Dict) -> (String) -> IO ((Ptr CString), (CULong))
_dictSuggest a1 a2 =
  let {a1' = id a1} in 
  withUTF8StringLenIntConv a2 $ \(a2'1, a2'2) -> 
  alloca $ \a3' -> 
  _dictSuggest'_ a1' a2'1  a2'2 a3' >>= \res ->
  let {res' = id res} in
  peek  a3'>>= \a3'' -> 
  return (res', a3'')

{-# LINE 152 "src/Language/Enchant.chs" #-}

_dictFreeStringList :: (Dict) -> (Ptr CString) -> IO ()
_dictFreeStringList a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  _dictFreeStringList'_ a1' a2' >>
  return ()

{-# LINE 153 "src/Language/Enchant.chs" #-}


-- | Return a list of suggestions if the word is bad spelled.
dictSuggest :: Dict -> String -> IO [String]
dictSuggest d s = bracket (_dictSuggest d s) cleanup go
  where
    go (p, n) = do
      cs <- peekArray ((fromIntegral n) - 1) p
      mapM peekUTF8String cs
    cleanup (p, _) = _dictFreeStringList d p

-- | Returns the last error of the current spelling-session.
dictGetError :: (Dict) -> IO ((String))
dictGetError a1 =
  let {a1' = id a1} in 
  dictGetError'_ a1' >>= \res ->
  peekUTF8String res >>= \res' ->
  return (res')

{-# LINE 165 "src/Language/Enchant.chs" #-}


type DictDescribeFn = CString -> CString -> CString -> CString -> Ptr () -> IO ()

foreign import ccall "wrapper"
  createDictDescriberFn :: DictDescribeFn -> IO (FunPtr DictDescribeFn)

withDictDescribeFn f a = createDictDescriberFn f >>= a

_dictDescribe :: (Dict) -> (DictDescribeFn) -> (Ptr ()) -> IO ()
_dictDescribe a1 a2 a3 =
  let {a1' = id a1} in 
  withDictDescribeFn a2 $ \a2' -> 
  let {a3' = id a3} in 
  _dictDescribe'_ a1' a2' a3' >>
  return ()

{-# LINE 174 "src/Language/Enchant.chs" #-}


-- | Returns the details of the dictionary.
dictDescribe :: Dict -> IO [Provider]
dictDescribe d = do
  acc <- newIORef []
  let cb pLangTag pName pDesc pDllFile _ = do langTag <- peekUTF8String pLangTag
                                              name <- peekUTF8String pName
                                              desc <- peekUTF8String pDesc
                                              dllFile <- peekUTF8String pDllFile
                                              let p = Provider langTag name desc dllFile
                                              modifyIORef acc (p:)
  _dictDescribe d cb nullPtr
  readIORef acc

_brokerListDicts :: (Broker) -> (DictDescribeFn) -> (Ptr ()) -> IO ()
_brokerListDicts a1 a2 a3 =
  let {a1' = id a1} in 
  withDictDescribeFn a2 $ \a2' -> 
  let {a3' = id a3} in 
  _brokerListDicts'_ a1' a2' a3' >>
  return ()

{-# LINE 189 "src/Language/Enchant.chs" #-}


-- | Returns a list of available dictionaries with their details.
brokerListDicts :: Broker -> IO [Provider]
brokerListDicts d = do
  acc <- newIORef []
  let cb pLangTag pName pDesc pDllFile _ = do langTag <- peekUTF8String pLangTag
                                              name <- peekUTF8String pName
                                              desc <- peekUTF8String pDesc
                                              dllFile <- peekUTF8String pDllFile
                                              let p = Provider langTag name desc dllFile
                                              modifyIORef acc (p:)
  _brokerListDicts d cb nullPtr
  readIORef acc

-- | @'withBroker' act@ opens a broker using 'brokerInit'
-- and passes the resulting broker to the computation @act@.  The resource
-- will be freed on exit from 'withBroker', whether by normal
-- termination or by raising an exception.
withBroker :: (Broker -> IO a) -> IO a
withBroker = bracket brokerInit brokerFree

-- | @'withDict' broker tag act@ opens a dict using 'brokerRequestDict'
-- and passes the resulting dict to the computation @act@.  The resource
-- will be freed on exit from 'withDict', whether by normal
-- termination or by raising an exception.
withDict :: Broker -> String -> (Dict -> IO a) -> IO a
withDict broker tag = bracket (brokerRequestDict broker tag) (brokerFreeDict broker)


foreign import ccall unsafe "Language/Enchant.chs.h enchant_get_version"
  getVersion'_ :: (IO (C2HSImp.Ptr C2HSImp.CChar))

foreign import ccall unsafe "Language/Enchant.chs.h enchant_broker_init"
  brokerInit'_ :: (IO (Broker))

foreign import ccall unsafe "Language/Enchant.chs.h enchant_broker_free"
  brokerFree'_ :: ((Broker) -> (IO ()))

foreign import ccall unsafe "Language/Enchant.chs.h enchant_broker_request_dict"
  brokerRequestDict'_ :: ((Broker) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO (Dict))))

foreign import ccall unsafe "Language/Enchant.chs.h enchant_broker_request_pwl_dict"
  brokerRequestPwlDict'_ :: ((Broker) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO (Dict))))

foreign import ccall unsafe "Language/Enchant.chs.h enchant_broker_free_dict"
  brokerFreeDict'_ :: ((Broker) -> ((Dict) -> (IO ())))

foreign import ccall unsafe "Language/Enchant.chs.h enchant_broker_dict_exists"
  brokerDictExists'_ :: ((Broker) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CInt)))

foreign import ccall unsafe "Language/Enchant.chs.h enchant_broker_set_ordering"
  brokerSetOrdering'_ :: ((Broker) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO ()))))

foreign import ccall unsafe "Language/Enchant.chs.h enchant_broker_get_error"
  brokerGetError'_ :: ((Broker) -> (IO (C2HSImp.Ptr C2HSImp.CChar)))

foreign import ccall unsafe "Language/Enchant.chs.h enchant_broker_get_param"
  brokerGetParam'_ :: ((Broker) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO (C2HSImp.Ptr C2HSImp.CChar))))

foreign import ccall unsafe "Language/Enchant.chs.h enchant_broker_set_param"
  brokerSetParam'_ :: ((Broker) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO ()))))

foreign import ccall safe "Language/Enchant.chs.h enchant_broker_describe"
  _brokerDescribe'_ :: ((Broker) -> ((C2HSImp.FunPtr ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr ()) -> (IO ())))))) -> ((C2HSImp.Ptr ()) -> (IO ()))))

foreign import ccall unsafe "Language/Enchant.chs.h enchant_dict_check"
  dictCheck'_ :: ((Dict) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CLong -> (IO C2HSImp.CInt))))

foreign import ccall unsafe "Language/Enchant.chs.h enchant_dict_add"
  dictAdd'_ :: ((Dict) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CLong -> (IO ()))))

foreign import ccall unsafe "Language/Enchant.chs.h enchant_dict_add_to_session"
  dictAddToSession'_ :: ((Dict) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CLong -> (IO ()))))

foreign import ccall unsafe "Language/Enchant.chs.h enchant_dict_remove"
  dictRemove'_ :: ((Dict) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CLong -> (IO ()))))

foreign import ccall unsafe "Language/Enchant.chs.h enchant_dict_remove_from_session"
  dictRemoveFromSession'_ :: ((Dict) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CLong -> (IO ()))))

foreign import ccall unsafe "Language/Enchant.chs.h enchant_dict_is_added"
  dictIsAdded'_ :: ((Dict) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CLong -> (IO C2HSImp.CInt))))

foreign import ccall unsafe "Language/Enchant.chs.h enchant_dict_is_removed"
  dictIsRemoved'_ :: ((Dict) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CLong -> (IO C2HSImp.CInt))))

foreign import ccall unsafe "Language/Enchant.chs.h enchant_dict_store_replacement"
  dictStoreReplacement'_ :: ((Dict) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CLong -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CLong -> (IO ()))))))

foreign import ccall unsafe "Language/Enchant.chs.h enchant_dict_suggest"
  _dictSuggest'_ :: ((Dict) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CLong -> ((C2HSImp.Ptr C2HSImp.CULong) -> (IO (C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)))))))

foreign import ccall unsafe "Language/Enchant.chs.h enchant_dict_free_string_list"
  _dictFreeStringList'_ :: ((Dict) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO ())))

foreign import ccall unsafe "Language/Enchant.chs.h enchant_dict_get_error"
  dictGetError'_ :: ((Dict) -> (IO (C2HSImp.Ptr C2HSImp.CChar)))

foreign import ccall safe "Language/Enchant.chs.h enchant_dict_describe"
  _dictDescribe'_ :: ((Dict) -> ((C2HSImp.FunPtr ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr ()) -> (IO ()))))))) -> ((C2HSImp.Ptr ()) -> (IO ()))))

foreign import ccall safe "Language/Enchant.chs.h enchant_broker_list_dicts"
  _brokerListDicts'_ :: ((Broker) -> ((C2HSImp.FunPtr ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr ()) -> (IO ()))))))) -> ((C2HSImp.Ptr ()) -> (IO ()))))