PtrWalker.hs

 {- }
  
  A Monadic interface to pointer navigation. 

 { -}


{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE OverlappingInstances #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE FlexibleContexts #-}



module Data.Char.CEDICT.C.PtrWalker where

import System.IO.Unsafe
import Foreign.Ptr
import Foreign.Storable
import Control.Monad.State


type PtrWalker a b           =  (Storable a) => State (Ptr a, Int, Int) b

walkPtr                     ::  (Storable a) => Ptr a -> PtrWalker a b -> b
walkPtr ptr walker           =  evalState walker (ptr, 0, sizeOf $ pikachu ptr)


skipF                       ::  Int -> PtrWalker a ()
skipF n                      =  do
  (ptr, offset, skip)       <-  get
  put (plusPtr ptr $ n * skip, offset + n, skip) 

skipB                       ::  Int -> PtrWalker a ()
skipB n                      =  skipF (-n)

skipF'                       =  skipF 1
skipB'                       =  skipB 1


pointer                     ::  PtrWalker a (Ptr a)
pointer                      =  do
  (ptr, _, _)               <-  get
  return ptr


value                       ::  PtrWalker a a
value                        =  do
  ptr                       <-  pointer
  return $ pikachu ptr 


offset                      ::  PtrWalker a Int
offset                       =  do
  (_, offset, _)            <-  get
  return offset


pikachu                     ::  (Storable a) => Ptr a -> a
pikachu                      =  unsafePerformIO . peek