{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE UndecidableInstances #-} module Binrep.Example.Tiff where import Binrep import Binrep.Generic import Binrep.Generic qualified as BR 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 brCfgNoSum :: BR.Cfg W8 brCfgNoSum :: Cfg W8 brCfgNoSum = BR.Cfg { cSumTag :: String -> W8 BR.cSumTag = String -> W8 forall a. HasCallStack => a undefined } data Tiff where Tiff :: (Put (I 'U 'I4 end), bs ~ MagicVals (TiffMagic end), ByteVals bs, KnownNat (Length bs)) => TiffBody end -> Tiff instance Show Tiff where show :: Tiff -> String show (Tiff TiffBody end body) = String "Tiff " String -> ShowS forall a. Semigroup a => a -> a -> a <> TiffBody end -> String 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 x. TiffBody end -> Rep (TiffBody end) x) -> (forall x. Rep (TiffBody end) x -> TiffBody end) -> Generic (TiffBody end) forall x. Rep (TiffBody end) x -> TiffBody end forall x. TiffBody end -> Rep (TiffBody end) x 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 [TiffBody end] -> ShowS TiffBody end -> String (Int -> TiffBody end -> ShowS) -> (TiffBody end -> String) -> ([TiffBody end] -> ShowS) -> Show (TiffBody end) 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 (TiffBody end -> TiffBody end -> Bool) -> (TiffBody end -> TiffBody end -> Bool) -> Eq (TiffBody end) 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 ~ MagicVals (TiffMagic end), KnownNat (Length bs)) => BLen (TiffBody end) where blen :: TiffBody end -> Int blen = Cfg W8 -> TiffBody end -> Int forall a w. (Generic a, GBLen (Rep a), BLen w) => Cfg w -> a -> Int blenGeneric Cfg W8 brCfgNoSum instance (bs ~ MagicVals (TiffMagic end), ByteVals bs, irep ~ I 'U 'I4 end, Put irep) => Put (TiffBody end) where put :: TiffBody end -> Builder put = Cfg W8 -> TiffBody end -> Builder forall a w. (Generic a, GPut (Rep a), Put w) => Cfg w -> a -> Builder putGeneric Cfg W8 brCfgNoSum instance (bs ~ MagicVals (TiffMagic end), ByteVals bs, irep ~ I 'U 'I4 end, Get irep) => Get (TiffBody end) where get :: Getter (TiffBody end) get = Cfg W8 -> Getter (TiffBody end) forall a w. (Generic a, GGet (Rep a), Get w, Eq w, Show w) => Cfg w -> Parser String a getGeneric Cfg W8 brCfgNoSum instance BLen Tiff where blen :: Tiff -> Int blen (Tiff TiffBody end body) = TiffBody end -> Int forall a. BLen a => a -> Int blen TiffBody end body instance Put Tiff where put :: Tiff -> Builder put (Tiff TiffBody end body) = TiffBody end -> Builder forall a. Put a => a -> Builder put TiffBody end body instance Get Tiff where get :: Getter Tiff get = (TiffBody 'LE -> Tiff) -> Parser String (TiffBody 'LE) -> Getter Tiff forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap TiffBody 'LE -> Tiff forall (end :: Endianness) (bs :: [Natural]). (Put (I 'U 'I4 end), bs ~ MagicVals (TiffMagic end), ByteVals bs, KnownNat (Length bs)) => TiffBody end -> Tiff Tiff (forall a. Get a => Getter a get @(TiffBody 'LE)) Getter Tiff -> Getter Tiff -> Getter Tiff forall e a. Parser e a -> Parser e a -> Parser e a <|> (TiffBody 'BE -> Tiff) -> Parser String (TiffBody 'BE) -> Getter Tiff forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap TiffBody 'BE -> Tiff forall (end :: Endianness) (bs :: [Natural]). (Put (I 'U 'I4 end), bs ~ MagicVals (TiffMagic end), ByteVals 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]