{- | Efficient type-level bytestring serialization.

@['Natural']@s have a convenient syntax, and we can use them as a type-level
bytestring by asserting that each 'Natural' is <=255 when reifying. This module
provides type classes which give you a serializer for a given @['Natural']@.

We maximize efficiency by grouping bytes into machine words. We have to be
pretty verbose to achieve this. Each type class attempts to group bytes into its
machine word type, and if it can't (i.e. not enough bytes remain), it hands off
to the next type class which handles the next smaller machine word.

I did a quick Core check and found that GHC seems to successfully generate
minimal code for this e.g. for an 8-byte magic, GHC will do one
@writeWord64OffAddr#@ of a constant. Great!

The only way I can think of to make this faster is to somehow obtain an 'Addr#'
with a known length. With that, we could @memcpy@. But that would be slower for
small magics, and maybe others. And I doubt we can conjure up an 'Addr#' at
compile time. So I'm fairly confident that this is the best you're gonna get.
-}

{-# LANGUAGE AllowAmbiguousTypes, UndecidableInstances #-}

module Bytezap.Struct.TypeLits.Bytes where

import Data.Type.Byte
import Bytezap.Struct ( Poke, sequencePokes, emptyPoke, prim )
import Numeric.Natural ( Natural )

-- | Serialize a type-level bytestring, largest grouping 'Word64'.
class ReifyBytesW64 (ns :: [Natural]) where reifyBytesW64 :: Poke s

-- | Enough bytes to make a 'Word64'.
instance {-# OVERLAPPING #-}
  ( ReifyW8 n1
  , ReifyW8 n2
  , ReifyW8 n3
  , ReifyW8 n4
  , ReifyW8 n5
  , ReifyW8 n6
  , ReifyW8 n7
  , ReifyW8 n8
  , ReifyBytesW64 ns
  ) => ReifyBytesW64 (n1 ': n2 ': n3 ': n4 ': n5 ': n6 ': n7 ': n8 ': ns) where
    {-# INLINE reifyBytesW64 #-}
    reifyBytesW64 :: forall s. Poke s
reifyBytesW64 = Poke s -> Int -> Poke s -> Poke s
forall s. Poke s -> Int -> Poke s -> Poke s
sequencePokes
        (Word64 -> Poke s
forall a s. Prim' a => a -> Poke s
prim (forall (n1 :: Natural) (n2 :: Natural) (n3 :: Natural)
       (n4 :: Natural) (n5 :: Natural) (n6 :: Natural) (n7 :: Natural)
       (n8 :: Natural).
(ReifyW8 n1, ReifyW8 n2, ReifyW8 n3, ReifyW8 n4, ReifyW8 n5,
 ReifyW8 n6, ReifyW8 n7, ReifyW8 n8) =>
Word64
reifyW64 @n1 @n2 @n3 @n4 @n5 @n6 @n7 @n8)) Int
8 (forall (ns :: [Natural]) s. ReifyBytesW64 ns => Poke s
reifyBytesW64 @ns)

-- | Try to group 'Word32's next.
instance ReifyBytesW32 ns => ReifyBytesW64 ns where
    {-# INLINE reifyBytesW64 #-}
    reifyBytesW64 :: forall s. Poke s
reifyBytesW64 = forall (ns :: [Natural]) s. ReifyBytesW32 ns => Poke s
reifyBytesW32 @ns

-- | Serialize a type-level bytestring, largest grouping 'Word32'.
class ReifyBytesW32 (ns :: [Natural]) where reifyBytesW32 :: Poke s

-- | Enough bytes to make a 'Word32'.
instance {-# OVERLAPPING #-}
  ( ReifyW8 n1
  , ReifyW8 n2
  , ReifyW8 n3
  , ReifyW8 n4
  , ReifyBytesW32 ns
  ) => ReifyBytesW32 (n1 ': n2 ': n3 ': n4 ': ns) where
    {-# INLINE reifyBytesW32 #-}
    reifyBytesW32 :: forall s. Poke s
reifyBytesW32 = Poke s -> Int -> Poke s -> Poke s
forall s. Poke s -> Int -> Poke s -> Poke s
sequencePokes
        (Word32 -> Poke s
forall a s. Prim' a => a -> Poke s
prim (forall (n1 :: Natural) (n2 :: Natural) (n3 :: Natural)
       (n4 :: Natural).
(ReifyW8 n1, ReifyW8 n2, ReifyW8 n3, ReifyW8 n4) =>
Word32
reifyW32 @n1 @n2 @n3 @n4)) Int
4 (forall (ns :: [Natural]) s. ReifyBytesW32 ns => Poke s
reifyBytesW32 @ns)

-- | Try to group 'Word16's next.
instance ReifyBytesW16 ns => ReifyBytesW32 ns where
    {-# INLINE reifyBytesW32 #-}
    reifyBytesW32 :: forall s. Poke s
reifyBytesW32 = forall (ns :: [Natural]) s. ReifyBytesW16 ns => Poke s
reifyBytesW16 @ns

-- | Serialize a type-level bytestring, largest grouping 'Word16'.
class ReifyBytesW16 (ns :: [Natural]) where reifyBytesW16 :: Poke s

-- | Enough bytes to make a 'Word16'.
instance {-# OVERLAPPING #-}
  ( ReifyW8 n1
  , ReifyW8 n2
  , ReifyBytesW16 ns
  ) => ReifyBytesW16 (n1 ': n2 ': ns) where
    {-# INLINE reifyBytesW16 #-}
    reifyBytesW16 :: forall s. Poke s
reifyBytesW16 = Poke s -> Int -> Poke s -> Poke s
forall s. Poke s -> Int -> Poke s -> Poke s
sequencePokes
        (Word16 -> Poke s
forall a s. Prim' a => a -> Poke s
prim (forall (n1 :: Natural) (n2 :: Natural).
(ReifyW8 n1, ReifyW8 n2) =>
Word16
reifyW16 @n1 @n2)) Int
2 (forall (ns :: [Natural]) s. ReifyBytesW16 ns => Poke s
reifyBytesW16 @ns)

-- | Reify byte-by-byte next.
instance ReifyBytesW8 ns => ReifyBytesW16 ns where
    {-# INLINE reifyBytesW16 #-}
    reifyBytesW16 :: forall s. Poke s
reifyBytesW16 = forall (ns :: [Natural]) s. ReifyBytesW8 ns => Poke s
reifyBytesW8 @ns

-- | Serialize a type-level bytestring, byte-by-byte.
class ReifyBytesW8 (ns :: [Natural]) where reifyBytesW8 :: Poke s

-- | Reify the next byte.
instance
  ( ReifyW8 n1
  , ReifyBytesW8 ns
  ) => ReifyBytesW8 (n1 ': ns) where
    {-# INLINE reifyBytesW8 #-}
    reifyBytesW8 :: forall s. Poke s
reifyBytesW8 = Poke s -> Int -> Poke s -> Poke s
forall s. Poke s -> Int -> Poke s -> Poke s
sequencePokes
        (Word8 -> Poke s
forall a s. Prim' a => a -> Poke s
prim (forall (n :: Natural). ReifyW8 n => Word8
reifyW8 @n1)) Int
1 (forall (ns :: [Natural]) s. ReifyBytesW8 ns => Poke s
reifyBytesW8 @ns)

-- | End of the line.
instance ReifyBytesW8 '[] where
    {-# INLINE reifyBytesW8 #-}
    reifyBytesW8 :: forall s. Poke s
reifyBytesW8 = Poke s
forall s. Poke s
emptyPoke