{-# LANGUAGE EmptyDataDecls           #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-|
Module      : Language.Hunspell
Description : Thread-safe bindings to the Hunspell library
Copyright   : (c) Ashutosh Rishi Ranjan, 2018
Maintainer  : ashutoshrishi92 at gmail
-}
module Language.Hunspell
  ( -- * Usage
    -- $usage

    -- * Usage with threads
    -- $threads

    -- * Hunspell FFI requirements
    -- $ffi

    -- * Creation
    createSpellChecker, SpellChecker

    -- * Hunspell API mappings
  , spell, suggest, stem, add, remove

  ) where

import           Control.Concurrent.STM
import           Foreign
import           Foreign.C.String
import           Foreign.C.Types

-- $threads
--
-- Initialise a 'SpellChecker' instance before you spawn your
-- threads. After which, a SpellChecker instance can be used
-- safely across the threads.


-- $usage
--
-- The functions exported try to match the Hunspell API one-to-one.
--
-- >>> checker <- createSpellChecker "en_GB.aff" "en_GB.buf"
-- >>> suggest checker "splling"
-- ["spelling", ...]

-- $ffi
--
-- This library expects that GHC can find the Hunspell shared library.
--
-- On Linux you need to install the @libhunspell-dev@ package from
-- your package manager:
--
-- > sudo apt-get install libhunspell-dev
--
-- On Macos you can install @hunspell@ from brew since the default
-- package config looks into the Homebrew include and lib dirs:
--
-- > brew install hunspell

-- |Initialise a new 'SpellChecker' with the '.aff' and '.dic'
-- dictionary files.
createSpellChecker :: String -- ^ .aff file path
                   -> String -- ^ .dic file path
                   -> IO SpellChecker
createSpellChecker affpath dicpath = do
  withCString affpath $ \aff ->
    withCString dicpath $ \dic -> do
      ptr <- newForeignPtr hunspellDestroy (hunspellCreate aff dic)
      SpellChecker ptr <$> atomically (newTMVar ptr)

-- |Check for correctness of a word.
spell :: SpellChecker -> String -> IO Bool
spell SpellChecker{hunPtrVar=tmvar} word = do
  withCString word $ \word' -> do
    handlePtr <- atomically $ takeTMVar tmvar
    result <- withForeignPtr handlePtr (flip hunspellSpell word')
    atomically $ putTMVar tmvar handlePtr
    return (if result == 0 then False else True)

-- |Return spelling suggestions for a word.
suggest :: SpellChecker -> String -> IO [String]
suggest checker word = do
  withCString word $ \word' ->
    alloca $ \resultsPtr -> do
      len <-
        withHandle checker $ \handle -> hunspellSuggest handle resultsPtr word'
      results <- peekWords len resultsPtr
      freeList checker len resultsPtr
      return results

-- |Hunspell stemmer function
stem :: SpellChecker -> String -> IO [String]
stem checker word = do
  withCString word $ \word' -> do
    alloca $ \resultsPtr -> do
      len <-
        withHandle checker $ \handle -> hunspellStem handle resultsPtr word'
      results <- peekWords len resultsPtr
      freeList checker len resultsPtr
      return results

-- |Add a word to the runtime dictionary.
add :: SpellChecker -> String -> IO ()
add checker word =
  withCString word $ \word' -> withHandle checker (flip hunspellAdd word')

-- |Remove a word from the runtime dictionary.
remove :: SpellChecker -> String -> IO ()
remove checker word =
  withCString word $ \word' -> withHandle checker (flip hunspellRemove word')

--------------------------------------------------------------------
-- Internal                                                       --
--------------------------------------------------------------------

freeList :: SpellChecker -> CInt -> Ptr (Ptr CString) -> IO ()
freeList SpellChecker {hunPtr = handlePtr} len ptr =
  withForeignPtr handlePtr $ \handle -> hunspellFreeList handle ptr len

withHandle :: SpellChecker -> (Hunhandle -> IO a) -> IO a
withHandle SpellChecker {hunPtrVar = tmvar} action = do
  handlePtr <- atomically $ takeTMVar tmvar
  result <- withForeignPtr handlePtr action
  atomically $ putTMVar tmvar handlePtr
  return result

peekWords :: CInt -> Ptr (Ptr CString) -> IO [String]
peekWords 0 _ = return []
peekWords len ptr = do
  arrayPtr <- peek ptr
  cstrings <- peekArray (fromIntegral len) arrayPtr
  mapM peekCString cstrings


--------------------------------------------------------------------
-- Types                                                          --
--------------------------------------------------------------------

-- | Opaque Hunspell struct
data Hunspell

-- | Ptr to the Hunspell struct
type Hunhandle = Ptr Hunspell

-- | Main type to hold a 'TMVar' wrapped reference to the Hunspell
-- handle pointer.
data SpellChecker = SpellChecker
  { hunPtr    :: ForeignPtr Hunspell
  , hunPtrVar :: TMVar (ForeignPtr Hunspell)
  }

--------------------------------------------------------------------
-- FFI                                                            --
--------------------------------------------------------------------

foreign import ccall "Hunspell_create" hunspellCreate
  :: CString -> CString -> Hunhandle

foreign import ccall "&Hunspell_destroy" hunspellDestroy
  :: FunPtr (Hunhandle -> IO ())

foreign import ccall "Hunspell_free_list" hunspellFreeList
  :: Hunhandle -> Ptr (Ptr CString) -> CInt -> IO ()

foreign import ccall "Hunspell_spell" hunspellSpell
  :: Hunhandle -> CString -> IO CInt

foreign import ccall "Hunspell_suggest" hunspellSuggest
  :: Hunhandle -> Ptr (Ptr CString) -> CString -> IO CInt

foreign import ccall "Hunspell_stem" hunspellStem
  :: Hunhandle -> Ptr (Ptr CString) -> CString -> IO CInt

foreign import ccall "Hunspell_add" hunspellAdd :: Hunhandle -> CString -> IO ()

foreign import ccall "Hunspell_remove" hunspellRemove
  :: Hunhandle -> CString -> IO ()