70 lines
2.3 KiB
Haskell
70 lines
2.3 KiB
Haskell
{-# LANGUAGE ForeignFunctionInterface #-}
|
|
|
|
{-
|
|
$ ghc -o my_program haskell.hs -L. -ltrie_loader
|
|
-}
|
|
|
|
module Xcdaths (lookupPhrase) where
|
|
|
|
import Foreign
|
|
import Foreign.C
|
|
import Control.Monad (when)
|
|
import System.Directory (doesFileExist)
|
|
import qualified Data.Text as T
|
|
import qualified Data.Text.Encoding as E
|
|
import qualified Data.ByteString as B
|
|
import System.Environment (getArgs)
|
|
|
|
-- Declare the C functions
|
|
foreign import ccall "load_trie" loadTrie :: CString -> IO (Ptr ())
|
|
foreign import ccall "perform_search" performSearch :: Ptr () -> CString -> Ptr CSize -> IO (Ptr (Ptr CChar))
|
|
foreign import ccall "free_trie" freeTrie :: Ptr () -> IO ()
|
|
foreign import ccall "free_search_results" freeSearchResults :: Ptr (Ptr CChar) -> IO ()
|
|
|
|
-- Convert CString to UTF-8 Text
|
|
cStringToText :: CString -> IO T.Text
|
|
cStringToText cstr = do
|
|
bytes <- B.packCString cstr -- Load as ByteString
|
|
return $ E.decodeUtf8 bytes -- Decode to Text
|
|
|
|
-- Get Results from the pointer
|
|
getResults :: Ptr (Ptr CChar) -> IO [T.Text]
|
|
getResults ptr =
|
|
if ptr == nullPtr
|
|
then return []
|
|
else do
|
|
currentPtr <- peek ptr
|
|
if currentPtr == nullPtr
|
|
then return []
|
|
else do
|
|
current <- cStringToText currentPtr
|
|
rest <- getResults (ptr `plusPtr` sizeOf (undefined :: Ptr CChar))
|
|
return (current : rest)
|
|
|
|
lookupPhrase :: FilePath -> String -> IO [String]
|
|
lookupPhrase dictPath searchPhrase = do
|
|
fileExists <- doesFileExist dictPath
|
|
if not fileExists
|
|
then pure []
|
|
else do
|
|
dictFile <- newCString dictPath
|
|
trieHandle <- loadTrie dictFile
|
|
if trieHandle == nullPtr
|
|
then pure []
|
|
else do
|
|
searchStr <- newCString searchPhrase
|
|
resultCount <- malloc :: IO (Ptr CSize)
|
|
resultsPtr <- performSearch trieHandle searchStr resultCount
|
|
|
|
results <- if resultsPtr == nullPtr
|
|
then pure []
|
|
else do
|
|
r <- getResults resultsPtr
|
|
freeSearchResults resultsPtr
|
|
pure r
|
|
|
|
free resultCount
|
|
freeTrie trieHandle
|
|
pure $ map T.unpack results
|
|
|
|
|