{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE UndecidableInstances #-}

module Binrep.Example.Tiff where

import Binrep
import Binrep.Generic
import Binrep.Type.Common ( Endianness(..) )
import Binrep.Type.Int
import Binrep.Type.Magic
import Binrep.Type.Byte
import FlatParse.Basic ( (<|>) )

import GHC.Generics ( Generic )
import Data.Data ( Data, Typeable )
import GHC.TypeLits

import Data.ByteString qualified as B

type W8 = I 'U 'I1 'LE

data Tiff where
    Tiff :: (Put (I 'U 'I4 end), bs ~ MagicBytes (TiffMagic end), ReifyBytes bs, KnownNat (Length bs)) => TiffBody end -> Tiff

instance Show Tiff where
    show :: Tiff -> String
show (Tiff TiffBody end
body) = String
"Tiff " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show TiffBody end
body

data TiffBody (end :: Endianness) = TiffBody
  { forall (end :: Endianness). TiffBody end -> Magic (TiffMagic end)
tiffBodyMagic :: Magic (TiffMagic end)
  , forall (end :: Endianness). TiffBody end -> I 'U 'I4 end
tiffBodyExInt :: I 'U 'I4 end
  } deriving stock (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (end :: Endianness) x. Rep (TiffBody end) x -> TiffBody end
forall (end :: Endianness) x. TiffBody end -> Rep (TiffBody end) x
$cto :: forall (end :: Endianness) x. Rep (TiffBody end) x -> TiffBody end
$cfrom :: forall (end :: Endianness) x. TiffBody end -> Rep (TiffBody end) x
Generic, Int -> TiffBody end -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (end :: Endianness). Int -> TiffBody end -> ShowS
forall (end :: Endianness). [TiffBody end] -> ShowS
forall (end :: Endianness). TiffBody end -> String
showList :: [TiffBody end] -> ShowS
$cshowList :: forall (end :: Endianness). [TiffBody end] -> ShowS
show :: TiffBody end -> String
$cshow :: forall (end :: Endianness). TiffBody end -> String
showsPrec :: Int -> TiffBody end -> ShowS
$cshowsPrec :: forall (end :: Endianness). Int -> TiffBody end -> ShowS
Show, TiffBody end -> TiffBody end -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (end :: Endianness). TiffBody end -> TiffBody end -> Bool
/= :: TiffBody end -> TiffBody end -> Bool
$c/= :: forall (end :: Endianness). TiffBody end -> TiffBody end -> Bool
== :: TiffBody end -> TiffBody end -> Bool
$c== :: forall (end :: Endianness). TiffBody end -> TiffBody end -> Bool
Eq)
deriving stock instance (KnownSymbol (TiffMagic end), Typeable end) => Data (TiffBody end)

instance (bs ~ MagicBytes (TiffMagic end), KnownNat (Length bs)) => BLen (TiffBody end) where
    blen :: TiffBody end -> Int
blen = forall a w. (Generic a, GBLen (Rep a), BLen w) => Cfg w -> a -> Int
blenGeneric Cfg Void
cNoSum
instance (bs ~ MagicBytes (TiffMagic end), ReifyBytes bs, irep ~ I 'U 'I4 end, Put irep) => Put  (TiffBody end) where
    put :: TiffBody end -> Builder
put  = forall a w.
(Generic a, GPut (Rep a), Put w) =>
Cfg w -> a -> Builder
putGeneric  Cfg Void
cNoSum
instance (bs ~ MagicBytes (TiffMagic end), ReifyBytes bs, irep ~ I 'U 'I4 end, Get irep) => Get  (TiffBody end) where
    get :: Getter (TiffBody end)
get  = forall a w. (Generic a, GGetD (Rep a), Get w) => Cfg w -> Getter a
getGeneric  Cfg Void
cNoSum

instance BLen Tiff where
    blen :: Tiff -> Int
blen (Tiff TiffBody end
body) = forall a. BLen a => a -> Int
blen TiffBody end
body

instance Put Tiff where
    put :: Tiff -> Builder
put (Tiff TiffBody end
body) = forall a. Put a => a -> Builder
put TiffBody end
body

instance Get Tiff where
    get :: Getter Tiff
get = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (end :: Endianness) (bs :: [Natural]).
(Put (I 'U 'I4 end), bs ~ MagicBytes (TiffMagic end),
 ReifyBytes bs, KnownNat (Length bs)) =>
TiffBody end -> Tiff
Tiff (forall a. Get a => Getter a
get @(TiffBody 'LE)) forall e a. Parser e a -> Parser e a -> Parser e a
<|> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (end :: Endianness) (bs :: [Natural]).
(Put (I 'U 'I4 end), bs ~ MagicBytes (TiffMagic end),
 ReifyBytes bs, KnownNat (Length bs)) =>
TiffBody end -> Tiff
Tiff (forall a. Get a => Getter a
get @(TiffBody 'BE))

type family TiffMagic (end :: Endianness) :: Symbol where
    TiffMagic 'LE = "II"
    TiffMagic 'BE = "MM"

tiffLEbs :: B.ByteString
tiffLEbs :: ByteString
tiffLEbs = [Word8] -> ByteString
B.pack [Word8
0x49, Word8
0x49, Word8
0xFF, Word8
0x00, Word8
0x00, Word8
0x00]

tiffBEbs :: B.ByteString
tiffBEbs :: ByteString
tiffBEbs = [Word8] -> ByteString
B.pack [Word8
0x4D, Word8
0x4D, Word8
0x00, Word8
0x00, Word8
0x00, Word8
0xFF]