{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Data.IPCVar.Shm where
import Control.Applicative
import Control.Exception
import Data.Binary
import Data.ByteString.Lazy.Char8 as BS
import Data.IPCVar.Backend
import Data.Text.Lazy as T
import Data.Text.Lazy.Encoding
import Data.UUID.V4
import System.Posix.Files
import System.Posix.IO
import System.Posix.SharedMem
shmIPCBackend :: Binary a => String -> IPCVarBackend a
shmIPCBackend name = IPCVarBackend
{ readValue = bracket
(shmOpen name (ShmOpenFlags False False False False) ownerModes)
closeFd decodeFd
, writeValue = bracket
(shmOpen name (ShmOpenFlags True True False False) ownerModes)
closeFd . flip encodeFd
, swapValue = \x -> bracket
(shmOpen name (ShmOpenFlags True False False False) ownerModes)
closeFd (\fd -> decodeFd fd <* encodeFd fd x)
, deleteValue = shmUnlink name
, encodeState = encodeUtf8 (T.pack name)
}
decodeState :: Binary a => ByteString -> IPCVarBackend a
decodeState = shmIPCBackend . T.unpack . decodeUtf8
newIPCVar :: Binary a => a -> IO (IPCVar a)
newIPCVar x = do
uuid <- nextRandom
let name = Prelude.take 30 (show uuid)
var = IPCVar (shmIPCBackend name)
writeValue (getIPCVarBackend var) x
return var