{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE DataKinds #-}
module Main where

import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import Data.Bifunctor (first)
import GHC.Generics
import GHC.TypeLits
import Data.Proxy
import Data.Word


data a @@ (n :: Nat) = SizedC a
  deriving (Show)

pattern Sized :: KnownNat n => a -> SNat n -> a @@ n
pattern Sized x n <- ((\(SizedC x) -> (x, SNat)) -> (x, n))
  where Sized x SNat = SizedC x

data Foo = Foo (Int @@ 4) (Int @@ 2)
  deriving (Show, Generic)


class Parse a where
  parseAt :: Int -> ByteString -> (Int, a)

  parse :: ByteString -> a
  parse = snd . parseAt 0

  default parseAt :: (Generic a, GParse (Rep a)) => Int -> ByteString -> (Int, a)
  parseAt off bs = to <$> gparseAt off bs

instance Parse Foo

class GParse f where
  gparseAt :: Int -> ByteString -> (Int, f p)

instance GParse f => GParse (M1 k meta f) where
  gparseAt off bs = M1 <$> gparseAt off bs

instance (GParse f, GParse g) => GParse (f :*: g) where
  gparseAt off bs =
    let (xlen, x) = gparseAt off bs
        (ylen, y) = gparseAt (off+xlen) bs
    in (xlen + ylen, x :*: y)

instance (KnownNat n, Integral t) => GParse (Rec0 (t @@ n)) where
  gparseAt off bs =
    let len = fromIntegral @Integer @Int (natVal (Proxy @n))
        bytes = [bs `BS.index` (off + i) | i <- [0 .. len - 1]]
    in (len, K1 (SizedC (sum (zipWith (*) (iterate (*256) 1) (map (fromIntegral @Word8 @t) bytes)))))

main :: IO ()
main = do
  print $ parse @Foo (BS8.pack "\x0a\x00\x00\x00\x05\x06")
  print 0x0605  -- it was correctly parsed