{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}

-- | Implementation of 'DiskBytes' using GHC-specific primitives
-- like 'mkWeak#'. Unfortunately,
-- I have not been able to bring down the RAM size of 'DiskByte'
-- significantly below 100 bytes yet.
module System.Mem.Disk.Bytes
    ( DiskBytes
    , toDiskBytes
    , fromDiskBytes
    ) where

import Data.ByteString
    ( ByteString )
import Data.Int
    ( Int64 )
import System.IO.Unsafe
    ( unsafePerformIO )
import System.Mem.Disk.DiskApi
    ( Disk (..) )

import GHC.Exts (Int#, Int(I#))
import GHC.Base
import GHC.Weak

{-----------------------------------------------------------------------------
    DiskBytes
------------------------------------------------------------------------------}
-- | A sequence of bytes that is stored on disk
-- — if and only if the value is evaluated to WHNF.
--
-- The value is subject to normal garbage collection:
-- When the value is no longer referenced,
-- the disk memory will be freed (eventually).
--
-- For estimating the memory cost:
-- Even though the bulk of the data is kept on disk,
-- each WHNF of 'DiskBytes' occupies roughly @~100@ bytes of RAM;
-- this is due to administrative overhead like weak pointers and finalizers.
data DiskBytes = DiskBytes
    { DiskBytes -> Int#
index :: Int#
    , DiskBytes -> Disk
disk  :: Disk
    }

-- | Make a weak pointer for our purposes.
addFinalizerBytes :: DiskBytes -> IO () -> IO ()
addFinalizerBytes :: DiskBytes -> IO () -> IO ()
addFinalizerBytes v :: DiskBytes
v@(DiskBytes{}) (IO State# RealWorld -> (# State# RealWorld, () #)
finalizer) = forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
    case mkWeak# :: forall a b c.
a
-> b
-> (State# RealWorld -> (# State# RealWorld, c #))
-> State# RealWorld
-> (# State# RealWorld, Weak# b #)
mkWeak# DiskBytes
v DiskBytes
v State# RealWorld -> (# State# RealWorld, () #)
finalizer State# RealWorld
s of (# State# RealWorld
s1, Weak# DiskBytes
w #) -> (# State# RealWorld
s1, () #)

-- | Offload a sequence of bytes onto a 'Disk'.
-- 
-- NOTE: The result must be evaluated to WHNF before the data is actually
-- on disk!
-- Also, the original 'ByteString' needs to be garbage collected
-- in for its RAM to become free.
toDiskBytes :: Disk -> ByteString -> DiskBytes
toDiskBytes :: Disk -> ByteString -> DiskBytes
toDiskBytes Disk
disk = forall a. IO a -> a
unsafePerformIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Disk -> ByteString -> IO DiskBytes
mkDiskBytes Disk
disk

mkDiskBytes :: Disk -> ByteString -> IO DiskBytes
mkDiskBytes :: Disk -> ByteString -> IO DiskBytes
mkDiskBytes Disk
disk ByteString
bytes = do
    I# Int#
index <- forall a. Enum a => a -> Int
fromEnum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Disk -> ByteString -> IO Int64
put Disk
disk ByteString
bytes
    let diskbytes :: DiskBytes
diskbytes = DiskBytes{Int#
index :: Int#
index :: Int#
index,Disk
disk :: Disk
disk :: Disk
disk}
    DiskBytes
diskbytes seq :: forall a b. a -> b -> b
`seq` (DiskBytes -> IO () -> IO ()
addFinalizerBytes DiskBytes
diskbytes forall a b. (a -> b) -> a -> b
$ DiskBytes -> IO ()
finalizerBytes DiskBytes
diskbytes)
    forall (f :: * -> *) a. Applicative f => a -> f a
pure DiskBytes
diskbytes

{-# NOINLINE finalizerBytes #-}
finalizerBytes :: DiskBytes -> IO ()
finalizerBytes :: DiskBytes -> IO ()
finalizerBytes DiskBytes{Int#
index :: Int#
index :: DiskBytes -> Int#
index,Disk
disk :: Disk
disk :: DiskBytes -> Disk
disk} =
    Disk -> Int64 -> IO ()
delete Disk
disk forall a b. (a -> b) -> a -> b
$ forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ Int# -> Int
I# Int#
index

-- | Read the sequence of bytes back into RAM.
fromDiskBytes :: DiskBytes -> ByteString
fromDiskBytes :: DiskBytes -> ByteString
fromDiskBytes = forall a. IO a -> a
unsafePerformIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiskBytes -> IO ByteString
unpackM

unpackM :: DiskBytes -> IO ByteString
unpackM :: DiskBytes -> IO ByteString
unpackM DiskBytes{Int#
index :: Int#
index :: DiskBytes -> Int#
index,Disk
disk :: Disk
disk :: DiskBytes -> Disk
disk} =
    Disk -> Int64 -> IO ByteString
get Disk
disk forall a b. (a -> b) -> a -> b
$ forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ Int# -> Int
I# Int#
index