{-# LANGUAGE ForeignFunctionInterface #-}

-- | Simple Haskell bindings for Foma.
--
-- Here's a simple example on how to use it.
--
-- @
-- import "Language.Foma"
--
-- main = do
--    fsm <- "fsmReadBinaryFile" "../TRmorph/trmorph.fst"
--    let handle = 'applyInit' fsm
--    'print' ('applyUp' handle "okudum")
-- @
module Language.Foma
  ( FSM ()
  , ApplyHandle ()
  , fsmReadBinaryFile
  , applyInit
  , applyClear
  , applyDown
  , applyUp
  ) where

import Foreign.C
import Foreign.Ptr
import System.IO.Unsafe (unsafePerformIO)

-- | The type for a finite state machine. Wrapper for a pointer.
newtype FSM = FSM (Ptr ())
-- | The low level handle. Wrapper for a pointer.
newtype ApplyHandle = ApplyHandle (Ptr ())

foreign import ccall unsafe "fomalib.h fsm_read_binary_file"
  fsmReadBinaryFile' :: CString -> IO FSM

-- | The function to read the binary file with.
fsmReadBinaryFile :: FilePath -> IO FSM
fsmReadBinaryFile p = do
    FSM ptr <- newCString p >>= fsmReadBinaryFile'
    if ptr /= nullPtr then return (FSM ptr) else error "Couldn't read file"

-- | To be called before applying words.
foreign import ccall unsafe "fomalib.h apply_init"
  applyInit :: FSM -> ApplyHandle

-- | Frees memory alloced by applyInit.
foreign import ccall unsafe "fomalib.h apply_clear"
  applyClear :: ApplyHandle -> IO ()

-- | Low level generalization for applying in directions.
applyDir' :: (ApplyHandle -> CString -> CString) -> ApplyHandle -> CString -> [CString]
applyDir' dir h s = if ptr /= nullPtr then ptr : applyDir' dir h nullPtr else []
  where ptr = dir h s

-- | Low level generalization without CString.
applyDir :: (ApplyHandle -> CString -> CString) -> ApplyHandle -> String -> [String]
applyDir dir h s = unsafePerformIO $ do
    cs <- newCString s
    mapM peekCString $ applyDir' dir h cs

foreign import ccall unsafe "fomalib.h apply_down"
  applyDown' :: ApplyHandle -> CString -> CString

-- | Words entered are applied against the network on the top of the stack.
applyDown :: ApplyHandle -> String -> [String]
applyDown = applyDir applyDown'

foreign import ccall unsafe "fomalib.h apply_up"
  applyUp' :: ApplyHandle -> CString -> CString

-- | Words entered are applied against the network on the top of the stack in inverse direction.
applyUp :: ApplyHandle -> String -> [String]
applyUp = applyDir applyUp'