{-# LANGUAGE UndecidableInstances #-}
module Data.ByteString.IsoBaseFileFormat.Util.FullBox
(FullBox(..), fullBox, BoxFlags(..))
where
import Data.ByteString.IsoBaseFileFormat.Box
import Data.ByteString.IsoBaseFileFormat.ReExports
data FullBox t (version :: Nat) where
FullBox :: (KnownNat version, IsBox t)
=> !(BoxFlags 24)
-> !(BoxContent t)
-> FullBox t version
instance (KnownNat version, IsBox t, Default (BoxContent t))
=> Default (FullBox t version) where
def = FullBox 0 def
instance (KnownNat v, IsBox t) => IsBox (FullBox t v) where
type BoxContent (FullBox t v) = FullBox t v
type instance BoxTypeSymbol (FullBox t v) = BoxTypeSymbol t
instance (IsBox t, KnownNat v) => IsBoxContent (FullBox t v) where
boxSize (FullBox f c) = 1 + boxSize f + boxSize c
boxBuilder (FullBox f c) =
word8 (fromIntegral (natVal (Proxy :: Proxy v)))
<> boxBuilder f
<> boxBuilder c
fullBox
:: (KnownNat v, IsBox t)
=> BoxFlags 24 -> BoxContent t -> Box (FullBox t v)
fullBox f c = Box (FullBox f c)
newtype BoxFlags bits =
BoxFlags Integer
deriving (Eq,Show,Num)
boxFlagBitMask :: KnownNat bits
=> BoxFlags bits -> Integer
boxFlagBitMask px = 2 ^ natVal px - 1
cropBits :: KnownNat bits
=> BoxFlags bits -> BoxFlags bits
cropBits f@(BoxFlags b) = BoxFlags (b .&. boxFlagBitMask f)
instance KnownNat bits => IsBoxContent (BoxFlags bits) where
boxSize f =
let minBytes = fromInteger $ natVal f `div` 8
modBytes = fromInteger $ natVal f `mod` 8
in BoxSize $ minBytes + signum modBytes
boxBuilder f@(BoxFlags b) =
let bytes =
let (BoxSize bytes') = boxSize f
in fromIntegral bytes'
wordSeq n
| n <= bytes =
word8 (fromIntegral (shiftR b ((bytes - n) * 8) .&. 255)) <>
wordSeq (n + 1)
| otherwise = mempty
in wordSeq 1
instance KnownNat bits => Bits (BoxFlags bits) where
(.&.) (BoxFlags l) (BoxFlags r) = cropBits $ BoxFlags $ l .&. r
(.|.) (BoxFlags l) (BoxFlags r) = cropBits $ BoxFlags $ l .&. r
xor (BoxFlags l) (BoxFlags r) = cropBits $ BoxFlags $ xor l r
complement (BoxFlags x) = cropBits $ BoxFlags $ complement x
shift (BoxFlags x) = cropBits . BoxFlags . shift x
rotateL = error "TODO rotateL"
rotateR = error "TODO rotateR"
bitSize = fromInteger . natVal
bitSizeMaybe = Just . fromInteger . natVal
isSigned _ = False
testBit f n =
let (BoxFlags b) = cropBits f
in testBit b n
bit = cropBits . BoxFlags . bit
popCount f =
let (BoxFlags b) = cropBits f
in popCount b
zeroBits = BoxFlags 0