Skip to content

Instantly share code, notes, and snippets.

@raehik
Created May 1, 2022 13:56
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save raehik/b92f4f524aa866dd21e3f1c069345cf6 to your computer and use it in GitHub Desktop.
Save raehik/b92f4f524aa866dd21e3f1c069345cf6 to your computer and use it in GitHub Desktop.
module Binrep.Example.Tiff where
import Binrep
import Binrep qualified as BR
import Binrep.Type.Common ( Endianness(..) )
import Binrep.Type.Int
import GHC.Generics ( Generic )
import Data.Data ( Typeable, Data )
import Data.ByteString qualified as B
type W8 = I 'U 'I1 'LE
brCfgNoSum :: BR.Cfg W8
brCfgNoSum = BR.Cfg { BR.cSumTag = undefined }
data Tiff where
Tiff :: TiffBody e -> Tiff
deriving stock (Typeable)
instance Show Tiff where
show (Tiff body) = "Tiff " <> show body
data TiffBody (end :: Endianness) = TiffBody
{ tiffBodyExInt :: I 'U 'I4 end
} deriving stock (Generic, Typeable, Data, Show, Eq)
instance BLen (TiffBody end) where
blen = blenGeneric brCfgNoSum
instance (irep ~ I 'U 'I4 end, Put irep) => Put (TiffBody end) where
put = putGeneric brCfgNoSum
instance (irep ~ I 'U 'I4 end, Get irep) => Get (TiffBody end) where
get = getGeneric brCfgNoSum
instance Get Tiff where
get = do
c1 <- get @W8
c2 <- get @W8
case (c1, c2) of
(0x49, 0x49) -> do
body <- get @(TiffBody 'LE)
return $ Tiff body
(0x4d, 0x4d) -> do
body <- get @(TiffBody 'BE)
return $ Tiff body
_ -> fail "bad TIFF header"
tiffLEbs :: B.ByteString
tiffLEbs = B.pack [0x49, 0x49, 0xFF, 0x00, 0x00, 0x00]
tiffBEbs :: B.ByteString
tiffBEbs = B.pack [0x4d, 0x4d, 0x00, 0x00, 0x00, 0xFF]
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment