Memory.hs

{-# LANGUAGE ScopedTypeVariables, BangPatterns #-}
module System.Device.Memory(
         newMemoryBlockDevice
       )
 where

import Data.Array.IO
import Data.ByteString(ByteString)
import qualified Data.ByteString as BS
import Data.Word

import System.Device.BlockDevice

-- Create a new in-memory block device, with the given number of
-- sectors and sector size.
newMemoryBlockDevice :: Word64 -> Word64 -> IO (Maybe (BlockDevice IO))
newMemoryBlockDevice numSectors sectorSize
  | mostW <= sectorSize = return Nothing
  | otherwise           = do
      arr :: IOArray Word64 ByteString <- newArray (0, numSectors - 1) empty
      return $! Just BlockDevice {
        bdBlockSize  = sectorSize
      , bdNumBlocks  = numSectors
      , bdReadBlock  = \ i -> readArray arr i
      , bdWriteBlock = \ i !v -> do
                        let v' = BS.take secSize64 $ v `BS.append` empty
                        writeArray arr i v'
      , bdFlush      = return ()
      , bdShutdown   = return () -- JS: was 'undefined' for a reason?
      }
 where
  mostW       = fromIntegral (maxBound :: Int)
  secSizeI    = fromIntegral sectorSize
  secSize64   = fromIntegral sectorSize
  empty       = BS.replicate secSizeI 0