{-# 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]