module Control.Monad.STLike.IO
(
IOS, io, runIOS
,Regioned, runRegion, region, unfoldRegion
,RegionMonad, (:<), withRIOR, try, rbsFromPtr,rbsToBS,withRbsPtr,rbsMapLookup
) where
import qualified Control.Exception as E
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
try :: IOS s t -> IOS s (Either E.SomeException t)
try (STLike x) = STLike (E.try x)
runIOS :: (forall s. IOS s t) -> IO t
runIOS x = let STLike v = x in v
withRIOR :: IOS o resource
-> (resource -> IOS o ())
-> (forall s. Regioned (s:<o) resource -> IOS (s:<o) result)
-> IOS o result
withRIOR (STLike open) close work = STLike (E.bracket open ioclose iowork)
where iowork x = let STLike w = work (R x) in w
ioclose x = let STLike w = close x in w
rbsFromPtr :: Ptr a -> Int -> IOS s (Regioned s B.ByteString)
rbsFromPtr ptr len = io $ fmap R $ B.unsafePackCStringLen (castPtr ptr,len)
rbsToBS :: RegionMonad m s reg => Regioned s B.ByteString -> STLike m reg 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 :: (RegionMonad m s reg, Ord key) => Regioned s key -> M.Map key value -> STLike m reg (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