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

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

import Data.Packed.Packed
import Data.Packed.Reader
import Foreign (Storable (peek, sizeOf), castPtr, plusPtr)
import GHC.IO (unsafePerformIO)

-- | An 'Unpackable' is a value that can be read (i.e. deserialised) from a 'Data.Packed' value
class Unpackable a where
    -- | The '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 = (ReaderPtr ('[a] :++: r)
 -> Int -> IO (a, ReaderPtr ('[a] :++: r), Int))
-> PackedReader '[a] r a
forall (p :: [*]) (r :: [*]) v.
(ReaderPtr ('[a] :++: r)
 -> Int -> IO (v, ReaderPtr ('[a] :++: r), Int))
-> PackedReader p r v
mkPackedReader ((ReaderPtr ('[a] :++: r)
  -> Int -> IO (a, ReaderPtr ('[a] :++: r), Int))
 -> PackedReader '[a] r a)
-> (ReaderPtr ('[a] :++: r)
    -> Int -> IO (a, ReaderPtr ('[a] :++: r), Int))
-> PackedReader '[a] r a
forall a b. (a -> b) -> a -> b
$ \ReaderPtr ('[a] :++: r)
ptr Int
l -> do
        !n <- Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
Foreign.peek (ReaderPtr ('[a] :++: r) -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr ReaderPtr ('[a] :++: r)
ptr)
        let !shiftedCount = a -> Int
forall a. Storable a => a -> Int
sizeOf a
n
            !l1 = Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
shiftedCount
            !ptr1 = ReaderPtr ('[a] :++: r)
ptr ReaderPtr ('[a] :++: r) -> Int -> ReaderPtr ('[a] :++: r)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
shiftedCount
        Prelude.return (n, ptr1, l1)

{-# INLINE readerWithoutShift #-}

-- | In a `PackedReader`, reads a value without moving the cursor
readerWithoutShift :: (Unpackable a) => PackedReader (a ': r) (a ': r) a
readerWithoutShift :: forall a (r :: [*]). Unpackable a => PackedReader (a : r) (a : r) a
readerWithoutShift = (ReaderPtr ('[a] :++: r)
 -> Int -> IO (a, ReaderPtr ('[a] :++: r), Int))
-> PackedReader (a : r) (a : r) a
forall (p :: [*]) (r :: [*]) v.
(ReaderPtr ('[a] :++: r)
 -> Int -> IO (v, ReaderPtr ('[a] :++: r), Int))
-> PackedReader p r v
mkPackedReader ((ReaderPtr ('[a] :++: r)
  -> Int -> IO (a, ReaderPtr ('[a] :++: r), Int))
 -> PackedReader (a : r) (a : r) a)
-> (ReaderPtr ('[a] :++: r)
    -> Int -> IO (a, ReaderPtr ('[a] :++: r), Int))
-> PackedReader (a : r) (a : r) a
forall a b. (a -> b) -> a -> b
$ \ReaderPtr ('[a] :++: r)
ptr Int
len -> do
    (!a, _, _) <- PackedReader '[a] Any a
-> ReaderPtr ('[a] :++: r)
-> Int
-> IO (a, ReaderPtr ('[a] :++: r), Int)
forall (p :: [*]) (r :: [*]) v.
PackedReader p r v
-> ReaderPtr ('[a] :++: r)
-> Int
-> IO (v, ReaderPtr ('[a] :++: r), Int)
runPackedReader PackedReader '[a] Any a
forall (r :: [*]). PackedReader '[a] r a
forall a (r :: [*]). Unpackable a => PackedReader '[a] r a
reader ReaderPtr ('[a] :++: r)
ptr Int
len
    Prelude.return (a, ptr, len)

{-# 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 = IO (a, Packed r) -> (a, Packed r)
forall a. IO a -> a
unsafePerformIO (IO (a, Packed r) -> (a, Packed r))
-> (Packed (a : r) -> IO (a, Packed r))
-> Packed (a : r)
-> (a, Packed r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackedReader '[a] r a -> Packed ('[a] :++: r) -> IO (a, Packed r)
forall (p :: [*]) (r :: [*]) v.
PackedReader p r v -> Packed (p :++: r) -> IO (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