binrep
Safe HaskellNone
LanguageGHC2021

Binrep.Type.Magic

Description

Magic numbers (also just magic): short constant bytestrings usually found at the top of a file, often used as an early sanity check.

There are two main flavors of magics:

  • byte magics e.g. Zstandard: 28 B5 2F FD
  • printable magics e.g. Ogg: 4F 67 67 53 -> OggS (in ASCII)

For byte magics, use type-level Natural lists e.g. Magic @'[0xFF, 0x01] For printable (UTF-8) magics, use Symbols e.g. Magic @"hello".

Synopsis

Documentation

data Magic (a :: k) where Source #

A unit data type representing a "magic number" via a phantom type.

The phantom type unambiguously defines a bytestring at compile time. This depends on the type's kind. See MagicBytes for details.

This is defined using GADT syntax to permit labelling the phantom type kind as inferred, which effectively means hidden (not available for visible type applications). That kind is always evident from the type, so it's just nicer.

Constructors

Magic :: forall {k} (a :: k). Magic a 

Instances

Instances details
IsCBLen (Magic a :: Type) Source #

The byte length of a magic is known at compile time.

Instance details

Defined in Binrep.Type.Magic

Associated Types

type CBLen (Magic a :: Type) 
Instance details

Defined in Binrep.Type.Magic

type CBLen (Magic a :: Type) = Length (MagicBytes a)
(Typeable a, Typeable k) => Data (Magic a) Source # 
Instance details

Defined in Binrep.Type.Magic

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Magic a -> c (Magic a) #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Magic a) #

toConstr :: Magic a -> Constr #

dataTypeOf :: Magic a -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (Magic a)) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Magic a)) #

gmapT :: (forall b. Data b => b -> b) -> Magic a -> Magic a #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Magic a -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Magic a -> r #

gmapQ :: (forall d. Data d => d -> u) -> Magic a -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Magic a -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Magic a -> m (Magic a) #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Magic a -> m (Magic a) #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Magic a -> m (Magic a) #

Generic (Magic a) Source # 
Instance details

Defined in Binrep.Type.Magic

Associated Types

type Rep (Magic a) 
Instance details

Defined in Binrep.Type.Magic

type Rep (Magic a) = D1 ('MetaData "Magic" "Binrep.Type.Magic" "binrep-1.1.0-inplace" 'False) (C1 ('MetaCons "Magic" 'PrefixI 'False) (U1 :: Type -> Type))

Methods

from :: Magic a -> Rep (Magic a) x #

to :: Rep (Magic a) x -> Magic a #

Show (Magic a) Source # 
Instance details

Defined in Binrep.Type.Magic

Methods

showsPrec :: Int -> Magic a -> ShowS #

show :: Magic a -> String #

showList :: [Magic a] -> ShowS #

KnownNat (Length (MagicBytes a)) => BLen (Magic a) Source # 
Instance details

Defined in Binrep.Type.Magic

Methods

blen :: Magic a -> Int Source #

(bs ~ MagicBytes a, ParseReifyBytesW64 0 bs, ReifyBytesW64 bs, KnownNat (Length bs)) => Get (Magic a) Source # 
Instance details

Defined in Binrep.Type.Magic

Methods

get :: Getter (Magic a) Source #

(bs ~ MagicBytes a, ParseReifyBytesW64 0 bs) => GetC (Magic a) Source #

Efficiently parse a Magic a. Serialization constraints are included as we emit the expected bytestring in errors.

Instance details

Defined in Binrep.Type.Magic

Methods

getC :: GetterC (Magic a) Source #

(bs ~ MagicBytes a, ReifyBytesW64 bs, KnownNat (Length bs)) => Put (Magic a) Source # 
Instance details

Defined in Binrep.Type.Magic

Methods

put :: Magic a -> Putter Source #

(bs ~ MagicBytes a, ReifyBytesW64 bs) => PutC (Magic a) Source #

Efficiently serialize a Magic a.

Instance details

Defined in Binrep.Type.Magic

Methods

putC :: Magic a -> PutterC Source #

Eq (Magic a) Source # 
Instance details

Defined in Binrep.Type.Magic

Methods

(==) :: Magic a -> Magic a -> Bool #

(/=) :: Magic a -> Magic a -> Bool #

type CBLen (Magic a :: Type) Source # 
Instance details

Defined in Binrep.Type.Magic

type CBLen (Magic a :: Type) = Length (MagicBytes a)
type Rep (Magic a) Source # 
Instance details

Defined in Binrep.Type.Magic

type Rep (Magic a) = D1 ('MetaData "Magic" "Binrep.Type.Magic" "binrep-1.1.0-inplace" 'False) (C1 ('MetaCons "Magic" 'PrefixI 'False) (U1 :: Type -> Type))

class Magical (a :: k) Source #

Types which define a magic value.

Associated Types

type MagicBytes (a :: k) :: [Natural] Source #

How to turn the type into a list of bytes (stored using Naturals).

Instances

Instances details
Magical (sym :: Symbol) Source #

Type-level symbols are converted to UTF-8.

Instance details

Defined in Binrep.Type.Magic

Associated Types

type MagicBytes (sym :: Symbol) 
Instance details

Defined in Binrep.Type.Magic

type MagicBytes (sym :: Symbol) = SymbolToUtf8 sym
Magical (bs :: [Natural]) Source #

Type-level naturals go as-is. (Make sure you don't go over 255, though!)

Instance details

Defined in Binrep.Type.Magic

Associated Types

type MagicBytes (bs :: [Natural]) 
Instance details

Defined in Binrep.Type.Magic

type MagicBytes (bs :: [Natural]) = bs

type family Length (a :: [k]) :: Natural where ... Source #

The length of a type-level list.

Equations

Length (a ': as :: [k]) = 1 + Length as 
Length ('[] :: [k]) = 0