module Control.Monad.STLike.IO
(
IOS, io, runIOS
,Regioned, runRegion, region
,rbsFromPtr,rbsToBS,withRbsPtr,rbsMapLookup
) where
import Control.Monad.STLike.Internal
import Control.Monad.Trans
import qualified Data.ByteString as B
import qualified Data.ByteString.Unsafe as B
import qualified Data.Map as M
import Foreign
type IOS s t = STLike IO s t
instance STLikeImpl IO
instance MonadIO (STLike IO s) where
liftIO x = io x
io :: IO t -> IOS s t
io x = STLike x
runIOS :: (forall s. IOS s t) -> IO t
runIOS x = let STLike v = x in v
rbsFromPtr :: Ptr a -> Int -> IOS s (Regioned s B.ByteString)
rbsFromPtr ptr len = io $ fmap R $ B.unsafePackCStringLen (castPtr ptr,len)
rbsToBS :: STLikeImpl m => Regioned s B.ByteString -> STLike m s B.ByteString
rbsToBS (R b) = return $! B.copy b
withRbsPtr :: Regioned s B.ByteString -> (Ptr any -> Int -> IOS s t) -> IOS s t
withRbsPtr (R b) act = io $ B.unsafeUseAsCStringLen b (\(p,l) -> let STLike v = (act (castPtr p) l) in v)
rbsMapLookup :: (STLikeImpl m, Ord key) => Regioned s key -> M.Map key value -> STLike m s (Maybe value)
rbsMapLookup (R k) m = case M.lookup k m of
Just x -> return (Just x)
Nothing -> return Nothing
region :: t -> Regioned s t
region = R