{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE QualifiedDo #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE UndecidableInstances #-}

module Data.Packed.Unpackable (
    Unpackable (..),
    PackedReader,
    unpack,
    unpack',
    runReader,
    readerWithoutShift,
) where

import Control.Monad.Identity
import Data.Packed.Packed
import Data.Packed.Reader hiding (return)
import Foreign (Storable (peek, sizeOf), castPtr, plusPtr)
import GHC.Exts
import GHC.IO

-- | An 'Unpackable' is a value that can be read (i.e. deserialised) from a 'Data.Packed' value
class Unpackable a where
    -- | The 'Data.Packed.Reader.PackedReader' to unpack a value of that type
    reader :: PackedReader '[a] r a

instance (Storable a) => Unpackable a where
    {-# INLINE reader #-}
    reader :: forall (r :: [*]). PackedReader '[a] r a
reader = (PackedFragment ('[a] :++: r) -> Identity (a, PackedFragment r))
-> PackedReader '[a] r a
forall (p :: [*]) (r :: [*]) v.
(PackedFragment (p :++: r) -> Identity (v, PackedFragment r))
-> PackedReader p r v
PackedReader ((PackedFragment ('[a] :++: r) -> Identity (a, PackedFragment r))
 -> PackedReader '[a] r a)
-> (PackedFragment ('[a] :++: r) -> Identity (a, PackedFragment r))
-> PackedReader '[a] r a
forall a b. (a -> b) -> a -> b
$ \(PF Ptr Word8
ptr Int
int) -> case (State# RealWorld -> (# State# RealWorld, a #))
-> (# State# RealWorld, a #)
forall o. (State# RealWorld -> o) -> o
runRW# (IO a -> State# RealWorld -> (# State# RealWorld, a #)
forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #)
unIO (Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek (Ptr a -> IO a) -> Ptr a -> IO a
forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptr)) of
        (# State# RealWorld
_, !a
n #) ->
            let
                !sizeOfN :: Int
sizeOfN = a -> Int
forall a. Storable a => a -> Int
sizeOf a
n
                !shiftedPtr :: Ptr Word8
shiftedPtr = Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
sizeOfN
                !shiftedSize :: Int
shiftedSize = Int
int Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sizeOfN
             in
                (a, PackedFragment r) -> Identity (a, PackedFragment r)
forall a. a -> Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
n, Ptr Word8 -> Int -> PackedFragment r
forall (p :: [*]). Ptr Word8 -> Int -> PackedFragment p
PF Ptr Word8
shiftedPtr Int
shiftedSize)

{-# INLINE readerWithoutShift #-}

-- | In a `PackedReader`, reads a value without moving the cursor
readerWithoutShift :: (Unpackable a) => PackedReader '[] (a ': r) a
readerWithoutShift :: forall a (r :: [*]). Unpackable a => PackedReader '[] (a : r) a
readerWithoutShift = (PackedFragment ('[] :++: (a : r))
 -> Identity (a, PackedFragment (a : r)))
-> PackedReader '[] (a : r) a
forall (p :: [*]) (r :: [*]) v.
(PackedFragment (p :++: r) -> Identity (v, PackedFragment r))
-> PackedReader p r v
mkPackedReader ((PackedFragment ('[] :++: (a : r))
  -> Identity (a, PackedFragment (a : r)))
 -> PackedReader '[] (a : r) a)
-> (PackedFragment ('[] :++: (a : r))
    -> Identity (a, PackedFragment (a : r)))
-> PackedReader '[] (a : r) a
forall a b. (a -> b) -> a -> b
$ \PackedFragment ('[] :++: (a : r))
pf ->
    let
        Identity !(!a
a, !PackedFragment r
_) = PackedReader '[a] r a
-> PackedFragment ('[a] :++: r) -> Identity (a, PackedFragment r)
forall (p :: [*]) (r :: [*]) v.
PackedReader p r v
-> PackedFragment (p :++: r) -> Identity (v, PackedFragment r)
runReaderStep PackedReader '[a] r a
forall (r :: [*]). PackedReader '[a] r a
forall a (r :: [*]). Unpackable a => PackedReader '[a] r a
reader PackedFragment ('[a] :++: r)
PackedFragment ('[] :++: (a : r))
pf
     in
        (a, PackedFragment (a : r)) -> Identity (a, PackedFragment (a : r))
forall a. a -> Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, PackedFragment (a : r)
PackedFragment ('[] :++: (a : r))
pf)

{-# INLINE unpack #-}

-- | Deserialise a value from a 'Data.Packed.Packed'.
--
-- Returns the unconsumed 'Data.Packed.Packed' portion
unpack :: (Unpackable a) => Packed (a ': r) -> (a, Packed r)
unpack :: forall a (r :: [*]).
Unpackable a =>
Packed (a : r) -> (a, Packed r)
unpack = PackedReader '[a] r a -> Packed ('[a] :++: r) -> (a, Packed r)
forall (p :: [*]) (r :: [*]) v.
PackedReader p r v -> Packed (p :++: r) -> (v, Packed r)
runReader PackedReader '[a] r a
forall (r :: [*]). PackedReader '[a] r a
forall a (r :: [*]). Unpackable a => PackedReader '[a] r a
reader

{-# INLINE unpack' #-}

-- | Same as 'unpack', but throws away the unconsumed bytes
unpack' :: (Unpackable a) => Packed (a : r) -> a
unpack' :: forall a (r :: [*]). Unpackable a => Packed (a : r) -> a
unpack' Packed (a : r)
p = (a, Packed r) -> a
forall a b. (a, b) -> a
fst ((a, Packed r) -> a) -> (a, Packed r) -> a
forall a b. (a -> b) -> a -> b
$ Packed (a : r) -> (a, Packed r)
forall a (r :: [*]).
Unpackable a =>
Packed (a : r) -> (a, Packed r)
unpack Packed (a : r)
p