Walker.hs

 {- }
  
  An interface to the C stuff, as functions that walk up and down the arrays.

 { -}

module Data.Char.CEDICT.C.Walker where

import Data.Char.CEDICT.C.Data
import Data.Char.CEDICT.C.PtrWalker
import Data.Char.CEDICT.C.Declarations

import qualified Data.ByteString.UTF8
import qualified Data.ByteString

import Data.Ord
import Data.List
import System.IO.Unsafe
import Control.Arrow
import Control.Monad
import Foreign
import Foreign.C
import Foreign.Storable
import Foreign.Marshal.Array


searchST                     =  binary st_elements st_length
searchTS                     =  binary ts_elements ts_length
searchPD                     =  trieReference d_trie [d_pins, d_defs]
searchPins                   =  fmap (second head) . searchPD 
searchDefs                   =  fmap (second last) . searchPD


binary                      ::  Ptr CString -> Ptr CInt -> Char -> String
binary listPtrs lenPtr char  =  search' listPtrs len
 where
  search' _ 0                =  [char]
  search' ptrs len =
    case compare char leading of
      LT                    ->  search' ptrs $ halfLen
      GT                    ->  search' ptr $ halfLen + (len `mod` 2)
      EQ                    ->  tail str 
   where
    leading                  =  head str
    halfLen                  =  len `div` 2
    ptr                      =  plusPtr ptrs $ halfLen * advance
    str                      =  toUTF8String . pikachu $ ptr
  len                        =  fromIntegral . pikachu $ lenPtr
  advance                    =  sizeOf listPtrs 


trieReference ::
  Ptr CInt -> [Ptr CString] -> String -> Maybe ((String, String), [[String]])
trieReference _ [] _         =  Nothing
trieReference triePtr dictPtrs s =
  case trieSearch triePtr s of
    Nothing                 ->  Nothing
    Just (strings, i) ->
      if head ptrs == nullPtr then
        Nothing
      else
        Just (strings, map form ptrs)
     where
      ptrs                  ::  [CString]
      ptrs                   =  map peruse dictPtrs 
       where
        peruse ptr           =  pikachu $ plusPtr ptr $ i * sizeOf ptr
      form                   =  splitter "" . toUTF8String
      splitter s' string =
        case string of
          ' ':'/':'/':' ':s ->  reverse s' : splitter [] s
          k:s               ->  splitter (k:s') s
          []                ->  [reverse s'] 


trieSearch :: Ptr CInt -> String -> Maybe ((String, String), Int)
trieSearch triePtr string    =  walkPtr triePtr $ walker "" string


walker _ []                  =  return Nothing
walker s' (k:s)              =  do
  len                       <-  liftM fromIntegral value
  skipF'
  rel                       <-  liftM (binary len (fromEnum k)) pointer
  case rel of
    Just n                  ->  do
      skipF n               --  Now we're at the character.
      case s of
        []                  ->  finish 
        _                   ->  do
          skipF len         --  Now we're at the character's jump entry. 
          jump              <-  liftM fromIntegral value
          skipB len         --  Back to the character.
          case jump of
            0               ->  finish  -- nowhere to go from here
            _               ->  do
              skipB'
              skipB n       --  Time to go all the way back for...
              skipF jump    --  ...our big jump to the next list!
              walker (k:s') s
    Nothing                 ->  return Nothing
 where
  finish                     =  do
    o                       <-  offset
    return $ Just ((reverse (k:s'), s), o)
  binary arrayLen k ptr      =  walkPtr ptr $ jiggle k arrayLen 

jiggle k 0                   =  return Nothing
jiggle k len                 =  do
  skipF halfLen
  v                         <-  value
  case compare k (fromIntegral v) of
    LT                      ->  skipB halfLen >> jiggle k halfLen
    GT                      ->  jiggle k $ halfLen + (len `mod` 2)
    EQ                      ->  return Just `ap` offset
 where
  halfLen                    =  len `div` 2


toUTF8String                ::  CString -> String
toUTF8String =
  Data.ByteString.UTF8.toString . unsafePerformIO . Data.ByteString.packCString