{-# LANGUAGE
  DerivingStrategies
, GeneralizedNewtypeDeriving
, KindSignatures
, DataKinds
, PolyKinds
, ScopedTypeVariables
, TypeApplications
, TypeFamilies
, UndecidableInstances
, MultiParamTypeClasses
, TypeSynonymInstances
, FlexibleInstances
, TypeOperators
, FlexibleContexts
, AllowAmbiguousTypes
, StandaloneDeriving
, DerivingVia
, CPP
, ConstraintKinds
, DefaultSignatures
#-}
{-# OPTIONS_GHC
  -Wno-unticked-promoted-constructors
  -Wno-redundant-constraints
#-}
{-# OPTIONS_HADDOCK not-home #-}
-- |
-- Module      : Data.Bitfield.Internal
-- Copyright   : (c) Jannis Overesch 2022-2022
-- License     : MIT
-- Maintainer  : overesch.jannis@gmail.com
module Data.Bitfield.Internal (
  Bitfield(..)
, unwrap
, get, set
, pack, unpack
, HasFixedBitSize(..)
, AsRep(..)
, ViaIntegral(..)
, GenericEnum(..)
, Fits
) where

#include "MachDeps.h"

import Data.Bits
import Data.Int
import Data.Kind
import Data.Proxy
import Data.Word

import GHC.Generics
import GHC.Records
import GHC.TypeLits as Nat
import Foreign.Storable

-- | A generic Bitfield
-- 
-- Represents type @a@ with type @rep@.
--
-- Technically this allows any representation and any type to represent, however all methods
-- are written with the implicit assumption of a representation with an 'Integral' and 'Bits' instance.
-- The type to represent is also assumed to have a `Generic` instance and be a single constructor with named fields.
-- 
-- @a@'s fields are also required to have an instance of 'AsRep' and 'FiniteBits'. This is provided for the most common
-- types ('Int'/'Word' (and variants) and 'Bool'). 
newtype Bitfield (rep :: Type) (a :: Type) = Bitfield rep
  deriving newtype (Bitfield rep a -> Bitfield rep a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall rep a. Eq rep => Bitfield rep a -> Bitfield rep a -> Bool
/= :: Bitfield rep a -> Bitfield rep a -> Bool
$c/= :: forall rep a. Eq rep => Bitfield rep a -> Bitfield rep a -> Bool
== :: Bitfield rep a -> Bitfield rep a -> Bool
$c== :: forall rep a. Eq rep => Bitfield rep a -> Bitfield rep a -> Bool
Eq, Ptr (Bitfield rep a) -> IO (Bitfield rep a)
Ptr (Bitfield rep a) -> Int -> IO (Bitfield rep a)
Ptr (Bitfield rep a) -> Int -> Bitfield rep a -> IO ()
Ptr (Bitfield rep a) -> Bitfield rep a -> IO ()
Bitfield rep a -> Int
forall b. Ptr b -> Int -> IO (Bitfield rep a)
forall b. Ptr b -> Int -> Bitfield rep a -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
forall rep a.
Storable rep =>
Ptr (Bitfield rep a) -> IO (Bitfield rep a)
forall rep a.
Storable rep =>
Ptr (Bitfield rep a) -> Int -> IO (Bitfield rep a)
forall rep a.
Storable rep =>
Ptr (Bitfield rep a) -> Int -> Bitfield rep a -> IO ()
forall rep a.
Storable rep =>
Ptr (Bitfield rep a) -> Bitfield rep a -> IO ()
forall rep a. Storable rep => Bitfield rep a -> Int
forall rep a b. Storable rep => Ptr b -> Int -> IO (Bitfield rep a)
forall rep a b.
Storable rep =>
Ptr b -> Int -> Bitfield rep a -> IO ()
poke :: Ptr (Bitfield rep a) -> Bitfield rep a -> IO ()
$cpoke :: forall rep a.
Storable rep =>
Ptr (Bitfield rep a) -> Bitfield rep a -> IO ()
peek :: Ptr (Bitfield rep a) -> IO (Bitfield rep a)
$cpeek :: forall rep a.
Storable rep =>
Ptr (Bitfield rep a) -> IO (Bitfield rep a)
pokeByteOff :: forall b. Ptr b -> Int -> Bitfield rep a -> IO ()
$cpokeByteOff :: forall rep a b.
Storable rep =>
Ptr b -> Int -> Bitfield rep a -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO (Bitfield rep a)
$cpeekByteOff :: forall rep a b. Storable rep => Ptr b -> Int -> IO (Bitfield rep a)
pokeElemOff :: Ptr (Bitfield rep a) -> Int -> Bitfield rep a -> IO ()
$cpokeElemOff :: forall rep a.
Storable rep =>
Ptr (Bitfield rep a) -> Int -> Bitfield rep a -> IO ()
peekElemOff :: Ptr (Bitfield rep a) -> Int -> IO (Bitfield rep a)
$cpeekElemOff :: forall rep a.
Storable rep =>
Ptr (Bitfield rep a) -> Int -> IO (Bitfield rep a)
alignment :: Bitfield rep a -> Int
$calignment :: forall rep a. Storable rep => Bitfield rep a -> Int
sizeOf :: Bitfield rep a -> Int
$csizeOf :: forall rep a. Storable rep => Bitfield rep a -> Int
Storable)

-- | Access the underlying representation of the 'Bitfield'
unwrap :: Bitfield rep a -> rep
unwrap :: forall rep a. Bitfield rep a -> rep
unwrap (Bitfield rep
rep) = rep
rep
{-# INLINE unwrap #-}

-- | Access a single field
get :: forall name x rep a . (Fits rep a, HasField name (Bitfield rep a) x) => Bitfield rep a -> x
get :: forall {k} (name :: k) x rep a.
(Fits rep a, HasField name (Bitfield rep a) x) =>
Bitfield rep a -> x
get = forall {k} (x :: k) r a. HasField x r a => r -> a
getField @name
{-# INLINE get #-}

-- | Change a single field 
set :: forall name x rep a . (Fits rep a, HasField name (Bitfield rep a) x, GOffset name (Rep a), Bits rep, AsRep rep x) => Bitfield rep a -> x -> Bitfield rep a
set :: forall (name :: Symbol) x rep a.
(Fits rep a, HasField name (Bitfield rep a) x,
 GOffset name (Rep a), Bits rep, AsRep rep x) =>
Bitfield rep a -> x -> Bitfield rep a
set (Bitfield rep
rep) x
x = forall rep a. rep -> Bitfield rep a
Bitfield forall a b. (a -> b) -> a -> b
$ (forall rep a. AsRep rep a => rep -> a -> Int -> rep
toRep rep
rep x
x Int
off)
  where
    off :: Int
off = case forall p (name :: Symbol) (f :: p -> *).
GOffset name f =>
Proxy name -> Proxy f -> Either Int Int
offset (forall {k} (t :: k). Proxy t
Proxy @name) (forall {k} (t :: k). Proxy t
Proxy @(Rep a)) of
      Left Int
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"Data.Bitfield.set:Failed to find offset"
      Right Int
n -> Int
n
{-# INLINE set #-}

-- | Unpack the 'Bitfield' and return the full datatype
unpack :: forall rep a . (Fits rep a, Generic a, GPackBitfield rep (Rep a)) => Bitfield rep a -> a
unpack :: forall rep a.
(Fits rep a, Generic a, GPackBitfield rep (Rep a)) =>
Bitfield rep a -> a
unpack (Bitfield rep
b) = case forall p rep (f :: p -> *) (x :: p).
GPackBitfield rep f =>
Proxy f -> Int -> rep -> (Int, f x)
unpackI (forall {k} (t :: k). Proxy t
Proxy @(Rep a)) Int
0 rep
b of (Int
_, Rep a Any
a) -> forall a x. Generic a => Rep a x -> a
to Rep a Any
a
{-# INLINE unpack #-}

-- | Pack a datatype into a bitfield
--
-- Beware that updates should be done with 'set', as 'pack' will recreate the entire 'Bitfield'
-- from scratch. The following will most likely *not* be optimised: @pack $ (unpack bitfield) { example = True }@
pack :: forall rep a . (Fits rep a, Generic a, Bits rep, GPackBitfield rep (Rep a)) => a -> Bitfield rep a
pack :: forall rep a.
(Fits rep a, Generic a, Bits rep, GPackBitfield rep (Rep a)) =>
a -> Bitfield rep a
pack a
a = case forall p rep (f :: p -> *) (x :: p).
GPackBitfield rep f =>
Proxy f -> Int -> rep -> f x -> (Int, rep)
packI (forall {k} (t :: k). Proxy t
Proxy @(Rep a)) Int
0 forall a. Bits a => a
zeroBits (forall a x. Generic a => a -> Rep a x
from a
a) of (Int
_, rep
b) -> forall rep a. rep -> Bitfield rep a
Bitfield rep
b
{-# INLINE pack #-}

instance (Fits rep a, Generic a, GPackBitfield rep (Rep a), Show a) => Show (Bitfield rep a) where
  show :: Bitfield rep a -> [Char]
show = forall a. Show a => a -> [Char]
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall rep a.
(Fits rep a, Generic a, GPackBitfield rep (Rep a)) =>
Bitfield rep a -> a
unpack

--
class GPackBitfield rep (f :: p -> Type) where
  unpackI :: forall x . Proxy f -> Int -> rep -> (Int, f x)
  packI :: forall x . Proxy f -> Int -> rep -> f x -> (Int, rep)

instance GPackBitfield r f => GPackBitfield r (M1 s m f) where
  unpackI :: forall (x :: p). Proxy (M1 s m f) -> Int -> r -> (Int, M1 s m f x)
unpackI Proxy (M1 s m f)
_ Int
off r
b = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall p rep (f :: p -> *) (x :: p).
GPackBitfield rep f =>
Proxy f -> Int -> rep -> (Int, f x)
unpackI (forall {k} (t :: k). Proxy t
Proxy @f) Int
off r
b
  {-# INLINE unpackI #-}
  packI :: forall (x :: p).
Proxy (M1 s m f) -> Int -> r -> M1 s m f x -> (Int, r)
packI Proxy (M1 s m f)
_ Int
off r
r (M1 f x
f) = forall p rep (f :: p -> *) (x :: p).
GPackBitfield rep f =>
Proxy f -> Int -> rep -> f x -> (Int, rep)
packI (forall {k} (t :: k). Proxy t
Proxy @f) Int
off r
r f x
f
  {-# INLINE packI #-}
instance (HasFixedBitSize a, AsRep rep a) => GPackBitfield rep (K1 c a) where
  unpackI :: forall (x :: p). Proxy (K1 c a) -> Int -> rep -> (Int, K1 c a x)
unpackI Proxy (K1 c a)
_ Int
off rep
r = (forall a. HasFixedBitSize a => Int
fixedBitSize @a forall a. Num a => a -> a -> a
+ Int
off, forall k i c (p :: k). c -> K1 i c p
K1 forall a b. (a -> b) -> a -> b
$ forall rep a. AsRep rep a => rep -> Int -> a
fromRep rep
r Int
off)
  {-# INLINE unpackI #-}
  packI :: forall (x :: p).
Proxy (K1 c a) -> Int -> rep -> K1 c a x -> (Int, rep)
packI Proxy (K1 c a)
_ Int
off rep
r (K1 a
a) = (forall a. HasFixedBitSize a => Int
fixedBitSize @a forall a. Num a => a -> a -> a
+ Int
off, forall rep a. AsRep rep a => rep -> a -> Int -> rep
toRep rep
r a
a Int
off)
  {-# INLINE packI #-}
instance (GPackBitfield r f, GPackBitfield r g) => GPackBitfield r (f :*: g) where
  unpackI :: forall (x :: p). Proxy (f :*: g) -> Int -> r -> (Int, (:*:) f g x)
unpackI Proxy (f :*: g)
_ Int
off r
rep =
    case forall p rep (f :: p -> *) (x :: p).
GPackBitfield rep f =>
Proxy f -> Int -> rep -> (Int, f x)
unpackI (forall {k} (t :: k). Proxy t
Proxy @f) Int
off r
rep of
      (Int
off', f x
l) -> case forall p rep (f :: p -> *) (x :: p).
GPackBitfield rep f =>
Proxy f -> Int -> rep -> (Int, f x)
unpackI (forall {k} (t :: k). Proxy t
Proxy @g) Int
off' r
rep of
        (Int
off'', g x
r) -> (Int
off'', f x
l forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g x
r)
  {-# INLINE unpackI #-}
  packI :: forall (x :: p).
Proxy (f :*: g) -> Int -> r -> (:*:) f g x -> (Int, r)
packI Proxy (f :*: g)
_ Int
off r
rep (f x
l :*: g x
r) =
    case forall p rep (f :: p -> *) (x :: p).
GPackBitfield rep f =>
Proxy f -> Int -> rep -> f x -> (Int, rep)
packI (forall {k} (t :: k). Proxy t
Proxy @f) Int
off r
rep f x
l of
      (Int
off', r
rep') -> forall p rep (f :: p -> *) (x :: p).
GPackBitfield rep f =>
Proxy f -> Int -> rep -> f x -> (Int, rep)
packI (forall {k} (t :: k). Proxy t
Proxy @g) Int
off' r
rep' g x
r
  {-# INLINE packI #-}

class GOffset (name :: Symbol) (f :: p -> Type) where
  offset :: Proxy name -> Proxy f -> Either Int Int

instance GOffset name f => GOffset name (D1 m f) where
  offset :: Proxy name -> Proxy (D1 m f) -> Either Int Int
offset Proxy name
pn Proxy (D1 m f)
_ = forall p (name :: Symbol) (f :: p -> *).
GOffset name f =>
Proxy name -> Proxy f -> Either Int Int
offset Proxy name
pn (forall {k} (t :: k). Proxy t
Proxy @f)
  {-# INLINE offset #-}
instance GOffset name f => GOffset name (C1 m f) where
  offset :: Proxy name -> Proxy (C1 m f) -> Either Int Int
offset Proxy name
pn Proxy (C1 m f)
_ = forall p (name :: Symbol) (f :: p -> *).
GOffset name f =>
Proxy name -> Proxy f -> Either Int Int
offset Proxy name
pn (forall {k} (t :: k). Proxy t
Proxy @f)
  {-# INLINE offset #-}
instance (GOffset name f, GOffset name g) => GOffset name (f :*: g) where
  offset :: Proxy name -> Proxy (f :*: g) -> Either Int Int
offset Proxy name
pn Proxy (f :*: g)
_ = case forall p (name :: Symbol) (f :: p -> *).
GOffset name f =>
Proxy name -> Proxy f -> Either Int Int
offset Proxy name
pn (forall {k} (t :: k). Proxy t
Proxy @f) of
    Left Int
i -> case forall p (name :: Symbol) (f :: p -> *).
GOffset name f =>
Proxy name -> Proxy f -> Either Int Int
offset Proxy name
pn (forall {k} (t :: k). Proxy t
Proxy @g) of
      Left Int
j -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Int
i forall a. Num a => a -> a -> a
+ Int
j
      Right Int
j -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Int
i forall a. Num a => a -> a -> a
+ Int
j
    Right Int
i -> forall a b. b -> Either a b
Right Int
i
  {-# INLINE offset #-}
instance GOffset name (S1 (MetaSel (Just name) su ss ds) (K1 c a)) where
  offset :: Proxy name
-> Proxy (S1 ('MetaSel ('Just name) su ss ds) (K1 c a))
-> Either Int Int
offset Proxy name
_ Proxy (S1 ('MetaSel ('Just name) su ss ds) (K1 c a))
_ = forall a b. b -> Either a b
Right Int
0
  {-# INLINE offset #-}
instance {-# OVERLAPS #-} HasFixedBitSize a => GOffset name (S1 m (K1 c a)) where
  offset :: Proxy name -> Proxy (S1 m (K1 c a)) -> Either Int Int
offset Proxy name
_ Proxy (S1 m (K1 c a))
_ = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. HasFixedBitSize a => Int
fixedBitSize @a
  {-# INLINE offset #-}

instance (HasField (name :: Symbol) a x, GOffset name (Rep a), AsRep rep x) => HasField name (Bitfield rep a) x where
  getField :: Bitfield rep a -> x
getField (Bitfield rep
rep) = forall rep a. AsRep rep a => rep -> Int -> a
fromRep rep
rep Int
off
    where
      off :: Int
off = case forall p (name :: Symbol) (f :: p -> *).
GOffset name f =>
Proxy name -> Proxy f -> Either Int Int
offset (forall {k} (t :: k). Proxy t
Proxy @name) (forall {k} (t :: k). Proxy t
Proxy @(Rep a)) of
        Left Int
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"Data.Bitfield.getField:Failed to find offset"
        Right Int
n -> Int
n
  {-# INLINE getField #-}

-- | Types with a fixed bitsize. This could be a type family as well, but having
-- it as a typeclass provides nicer error messages when one forgets to write an
-- instance for it.
class KnownNat (BitSize a) => HasFixedBitSize (a :: Type) where
  type BitSize a :: Nat

fixedBitSize :: forall a. HasFixedBitSize a => Int
fixedBitSize :: forall a. HasFixedBitSize a => Int
fixedBitSize = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall {k} (t :: k). Proxy t
Proxy @(BitSize a))

-- | Typeclass which converts @rep@ and @a@ into each other (at specified offsets).
class HasFixedBitSize a => AsRep rep a where
  fromRep :: rep -> Int -> a
  toRep :: rep -> a -> Int -> rep

-- Flatten nested bitfields
instance KnownNat (BitSize r2) => HasFixedBitSize (Bitfield r2 a) where
  type BitSize (Bitfield r2 a) = BitSize r2

instance AsRep r1 r2 => AsRep r1 (Bitfield r2 a) where
  fromRep :: r1 -> Int -> Bitfield r2 a
fromRep r1
r1 Int
off = forall rep a. rep -> Bitfield rep a
Bitfield forall a b. (a -> b) -> a -> b
$ forall rep a. AsRep rep a => rep -> Int -> a
fromRep r1
r1 Int
off
  {-# INLINE fromRep #-}
  toRep :: r1 -> Bitfield r2 a -> Int -> r1
toRep r1
r1 (Bitfield r2
r2) Int
off = forall rep a. AsRep rep a => rep -> a -> Int -> rep
toRep r1
r1 r2
r2 Int
off
  {-# INLINE toRep #-}

instance HasFixedBitSize Bool where
  type BitSize Bool = 1 

instance Bits a => AsRep a Bool where
  fromRep :: a -> Int -> Bool
fromRep a
r Int
off = forall a. Bits a => a -> Int -> Bool
testBit a
r Int
off
  {-# INLINE fromRep #-}
  toRep :: a -> Bool -> Int -> a
toRep a
rep Bool
True Int
off = forall a. Bits a => a -> Int -> a
setBit a
rep Int
off
  toRep a
rep Bool
False Int
off = forall a. Bits a => a -> Int -> a
clearBit a
rep Int
off
  {-# INLINE toRep #-}

-- | Newtype wrapper with an 'AsRep' instance for 'Integral' representations and types.
--
-- The example below shows how to derive a 5 bit int field via a newtype:
-- 
-- @
-- newtype SmallInt = SmallInt Int
--   deriving (HasFixedBitSize, AsRep r) via (ViaIntegral 5 Int)
-- @
newtype ViaIntegral (sz :: Nat) a = ViaIntegral a
  deriving newtype (ViaIntegral sz a -> ViaIntegral sz a -> Bool
forall (sz :: Nat) a.
Eq a =>
ViaIntegral sz a -> ViaIntegral sz a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ViaIntegral sz a -> ViaIntegral sz a -> Bool
$c/= :: forall (sz :: Nat) a.
Eq a =>
ViaIntegral sz a -> ViaIntegral sz a -> Bool
== :: ViaIntegral sz a -> ViaIntegral sz a -> Bool
$c== :: forall (sz :: Nat) a.
Eq a =>
ViaIntegral sz a -> ViaIntegral sz a -> Bool
Eq, ViaIntegral sz a -> ViaIntegral sz a -> Bool
ViaIntegral sz a -> ViaIntegral sz a -> Ordering
ViaIntegral sz a -> ViaIntegral sz a -> ViaIntegral sz a
forall {sz :: Nat} {a}. Ord a => Eq (ViaIntegral sz a)
forall (sz :: Nat) a.
Ord a =>
ViaIntegral sz a -> ViaIntegral sz a -> Bool
forall (sz :: Nat) a.
Ord a =>
ViaIntegral sz a -> ViaIntegral sz a -> Ordering
forall (sz :: Nat) a.
Ord a =>
ViaIntegral sz a -> ViaIntegral sz a -> ViaIntegral sz a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ViaIntegral sz a -> ViaIntegral sz a -> ViaIntegral sz a
$cmin :: forall (sz :: Nat) a.
Ord a =>
ViaIntegral sz a -> ViaIntegral sz a -> ViaIntegral sz a
max :: ViaIntegral sz a -> ViaIntegral sz a -> ViaIntegral sz a
$cmax :: forall (sz :: Nat) a.
Ord a =>
ViaIntegral sz a -> ViaIntegral sz a -> ViaIntegral sz a
>= :: ViaIntegral sz a -> ViaIntegral sz a -> Bool
$c>= :: forall (sz :: Nat) a.
Ord a =>
ViaIntegral sz a -> ViaIntegral sz a -> Bool
> :: ViaIntegral sz a -> ViaIntegral sz a -> Bool
$c> :: forall (sz :: Nat) a.
Ord a =>
ViaIntegral sz a -> ViaIntegral sz a -> Bool
<= :: ViaIntegral sz a -> ViaIntegral sz a -> Bool
$c<= :: forall (sz :: Nat) a.
Ord a =>
ViaIntegral sz a -> ViaIntegral sz a -> Bool
< :: ViaIntegral sz a -> ViaIntegral sz a -> Bool
$c< :: forall (sz :: Nat) a.
Ord a =>
ViaIntegral sz a -> ViaIntegral sz a -> Bool
compare :: ViaIntegral sz a -> ViaIntegral sz a -> Ordering
$ccompare :: forall (sz :: Nat) a.
Ord a =>
ViaIntegral sz a -> ViaIntegral sz a -> Ordering
Ord, ViaIntegral sz a
Int -> ViaIntegral sz a
ViaIntegral sz a -> Bool
ViaIntegral sz a -> Int
ViaIntegral sz a -> Maybe Int
ViaIntegral sz a -> ViaIntegral sz a
ViaIntegral sz a -> Int -> Bool
ViaIntegral sz a -> Int -> ViaIntegral sz a
ViaIntegral sz a -> ViaIntegral sz a -> ViaIntegral sz a
forall {sz :: Nat} {a}. Bits a => Eq (ViaIntegral sz a)
forall (sz :: Nat) a. Bits a => ViaIntegral sz a
forall (sz :: Nat) a. Bits a => Int -> ViaIntegral sz a
forall (sz :: Nat) a. Bits a => ViaIntegral sz a -> Bool
forall (sz :: Nat) a. Bits a => ViaIntegral sz a -> Int
forall (sz :: Nat) a. Bits a => ViaIntegral sz a -> Maybe Int
forall (sz :: Nat) a.
Bits a =>
ViaIntegral sz a -> ViaIntegral sz a
forall (sz :: Nat) a. Bits a => ViaIntegral sz a -> Int -> Bool
forall (sz :: Nat) a.
Bits a =>
ViaIntegral sz a -> Int -> ViaIntegral sz a
forall (sz :: Nat) a.
Bits a =>
ViaIntegral sz a -> ViaIntegral sz a -> ViaIntegral sz a
forall a.
Eq a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
popCount :: ViaIntegral sz a -> Int
$cpopCount :: forall (sz :: Nat) a. Bits a => ViaIntegral sz a -> Int
rotateR :: ViaIntegral sz a -> Int -> ViaIntegral sz a
$crotateR :: forall (sz :: Nat) a.
Bits a =>
ViaIntegral sz a -> Int -> ViaIntegral sz a
rotateL :: ViaIntegral sz a -> Int -> ViaIntegral sz a
$crotateL :: forall (sz :: Nat) a.
Bits a =>
ViaIntegral sz a -> Int -> ViaIntegral sz a
unsafeShiftR :: ViaIntegral sz a -> Int -> ViaIntegral sz a
$cunsafeShiftR :: forall (sz :: Nat) a.
Bits a =>
ViaIntegral sz a -> Int -> ViaIntegral sz a
shiftR :: ViaIntegral sz a -> Int -> ViaIntegral sz a
$cshiftR :: forall (sz :: Nat) a.
Bits a =>
ViaIntegral sz a -> Int -> ViaIntegral sz a
unsafeShiftL :: ViaIntegral sz a -> Int -> ViaIntegral sz a
$cunsafeShiftL :: forall (sz :: Nat) a.
Bits a =>
ViaIntegral sz a -> Int -> ViaIntegral sz a
shiftL :: ViaIntegral sz a -> Int -> ViaIntegral sz a
$cshiftL :: forall (sz :: Nat) a.
Bits a =>
ViaIntegral sz a -> Int -> ViaIntegral sz a
isSigned :: ViaIntegral sz a -> Bool
$cisSigned :: forall (sz :: Nat) a. Bits a => ViaIntegral sz a -> Bool
bitSize :: ViaIntegral sz a -> Int
$cbitSize :: forall (sz :: Nat) a. Bits a => ViaIntegral sz a -> Int
bitSizeMaybe :: ViaIntegral sz a -> Maybe Int
$cbitSizeMaybe :: forall (sz :: Nat) a. Bits a => ViaIntegral sz a -> Maybe Int
testBit :: ViaIntegral sz a -> Int -> Bool
$ctestBit :: forall (sz :: Nat) a. Bits a => ViaIntegral sz a -> Int -> Bool
complementBit :: ViaIntegral sz a -> Int -> ViaIntegral sz a
$ccomplementBit :: forall (sz :: Nat) a.
Bits a =>
ViaIntegral sz a -> Int -> ViaIntegral sz a
clearBit :: ViaIntegral sz a -> Int -> ViaIntegral sz a
$cclearBit :: forall (sz :: Nat) a.
Bits a =>
ViaIntegral sz a -> Int -> ViaIntegral sz a
setBit :: ViaIntegral sz a -> Int -> ViaIntegral sz a
$csetBit :: forall (sz :: Nat) a.
Bits a =>
ViaIntegral sz a -> Int -> ViaIntegral sz a
bit :: Int -> ViaIntegral sz a
$cbit :: forall (sz :: Nat) a. Bits a => Int -> ViaIntegral sz a
zeroBits :: ViaIntegral sz a
$czeroBits :: forall (sz :: Nat) a. Bits a => ViaIntegral sz a
rotate :: ViaIntegral sz a -> Int -> ViaIntegral sz a
$crotate :: forall (sz :: Nat) a.
Bits a =>
ViaIntegral sz a -> Int -> ViaIntegral sz a
shift :: ViaIntegral sz a -> Int -> ViaIntegral sz a
$cshift :: forall (sz :: Nat) a.
Bits a =>
ViaIntegral sz a -> Int -> ViaIntegral sz a
complement :: ViaIntegral sz a -> ViaIntegral sz a
$ccomplement :: forall (sz :: Nat) a.
Bits a =>
ViaIntegral sz a -> ViaIntegral sz a
xor :: ViaIntegral sz a -> ViaIntegral sz a -> ViaIntegral sz a
$cxor :: forall (sz :: Nat) a.
Bits a =>
ViaIntegral sz a -> ViaIntegral sz a -> ViaIntegral sz a
.|. :: ViaIntegral sz a -> ViaIntegral sz a -> ViaIntegral sz a
$c.|. :: forall (sz :: Nat) a.
Bits a =>
ViaIntegral sz a -> ViaIntegral sz a -> ViaIntegral sz a
.&. :: ViaIntegral sz a -> ViaIntegral sz a -> ViaIntegral sz a
$c.&. :: forall (sz :: Nat) a.
Bits a =>
ViaIntegral sz a -> ViaIntegral sz a -> ViaIntegral sz a
Bits, ViaIntegral sz a -> Rational
forall {sz :: Nat} {a}. Real a => Num (ViaIntegral sz a)
forall {sz :: Nat} {a}. Real a => Ord (ViaIntegral sz a)
forall (sz :: Nat) a. Real a => ViaIntegral sz a -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: ViaIntegral sz a -> Rational
$ctoRational :: forall (sz :: Nat) a. Real a => ViaIntegral sz a -> Rational
Real, Int -> ViaIntegral sz a
ViaIntegral sz a -> Int
ViaIntegral sz a -> [ViaIntegral sz a]
ViaIntegral sz a -> ViaIntegral sz a
ViaIntegral sz a -> ViaIntegral sz a -> [ViaIntegral sz a]
ViaIntegral sz a
-> ViaIntegral sz a -> ViaIntegral sz a -> [ViaIntegral sz a]
forall (sz :: Nat) a. Enum a => Int -> ViaIntegral sz a
forall (sz :: Nat) a. Enum a => ViaIntegral sz a -> Int
forall (sz :: Nat) a.
Enum a =>
ViaIntegral sz a -> [ViaIntegral sz a]
forall (sz :: Nat) a.
Enum a =>
ViaIntegral sz a -> ViaIntegral sz a
forall (sz :: Nat) a.
Enum a =>
ViaIntegral sz a -> ViaIntegral sz a -> [ViaIntegral sz a]
forall (sz :: Nat) a.
Enum a =>
ViaIntegral sz a
-> ViaIntegral sz a -> ViaIntegral sz a -> [ViaIntegral sz a]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ViaIntegral sz a
-> ViaIntegral sz a -> ViaIntegral sz a -> [ViaIntegral sz a]
$cenumFromThenTo :: forall (sz :: Nat) a.
Enum a =>
ViaIntegral sz a
-> ViaIntegral sz a -> ViaIntegral sz a -> [ViaIntegral sz a]
enumFromTo :: ViaIntegral sz a -> ViaIntegral sz a -> [ViaIntegral sz a]
$cenumFromTo :: forall (sz :: Nat) a.
Enum a =>
ViaIntegral sz a -> ViaIntegral sz a -> [ViaIntegral sz a]
enumFromThen :: ViaIntegral sz a -> ViaIntegral sz a -> [ViaIntegral sz a]
$cenumFromThen :: forall (sz :: Nat) a.
Enum a =>
ViaIntegral sz a -> ViaIntegral sz a -> [ViaIntegral sz a]
enumFrom :: ViaIntegral sz a -> [ViaIntegral sz a]
$cenumFrom :: forall (sz :: Nat) a.
Enum a =>
ViaIntegral sz a -> [ViaIntegral sz a]
fromEnum :: ViaIntegral sz a -> Int
$cfromEnum :: forall (sz :: Nat) a. Enum a => ViaIntegral sz a -> Int
toEnum :: Int -> ViaIntegral sz a
$ctoEnum :: forall (sz :: Nat) a. Enum a => Int -> ViaIntegral sz a
pred :: ViaIntegral sz a -> ViaIntegral sz a
$cpred :: forall (sz :: Nat) a.
Enum a =>
ViaIntegral sz a -> ViaIntegral sz a
succ :: ViaIntegral sz a -> ViaIntegral sz a
$csucc :: forall (sz :: Nat) a.
Enum a =>
ViaIntegral sz a -> ViaIntegral sz a
Enum, Integer -> ViaIntegral sz a
ViaIntegral sz a -> ViaIntegral sz a
ViaIntegral sz a -> ViaIntegral sz a -> ViaIntegral sz a
forall (sz :: Nat) a. Num a => Integer -> ViaIntegral sz a
forall (sz :: Nat) a. Num a => ViaIntegral sz a -> ViaIntegral sz a
forall (sz :: Nat) a.
Num a =>
ViaIntegral sz a -> ViaIntegral sz a -> ViaIntegral sz a
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> ViaIntegral sz a
$cfromInteger :: forall (sz :: Nat) a. Num a => Integer -> ViaIntegral sz a
signum :: ViaIntegral sz a -> ViaIntegral sz a
$csignum :: forall (sz :: Nat) a. Num a => ViaIntegral sz a -> ViaIntegral sz a
abs :: ViaIntegral sz a -> ViaIntegral sz a
$cabs :: forall (sz :: Nat) a. Num a => ViaIntegral sz a -> ViaIntegral sz a
negate :: ViaIntegral sz a -> ViaIntegral sz a
$cnegate :: forall (sz :: Nat) a. Num a => ViaIntegral sz a -> ViaIntegral sz a
* :: ViaIntegral sz a -> ViaIntegral sz a -> ViaIntegral sz a
$c* :: forall (sz :: Nat) a.
Num a =>
ViaIntegral sz a -> ViaIntegral sz a -> ViaIntegral sz a
- :: ViaIntegral sz a -> ViaIntegral sz a -> ViaIntegral sz a
$c- :: forall (sz :: Nat) a.
Num a =>
ViaIntegral sz a -> ViaIntegral sz a -> ViaIntegral sz a
+ :: ViaIntegral sz a -> ViaIntegral sz a -> ViaIntegral sz a
$c+ :: forall (sz :: Nat) a.
Num a =>
ViaIntegral sz a -> ViaIntegral sz a -> ViaIntegral sz a
Num, ViaIntegral sz a -> Integer
ViaIntegral sz a
-> ViaIntegral sz a -> (ViaIntegral sz a, ViaIntegral sz a)
ViaIntegral sz a -> ViaIntegral sz a -> ViaIntegral sz a
forall {sz :: Nat} {a}. Integral a => Enum (ViaIntegral sz a)
forall {sz :: Nat} {a}. Integral a => Real (ViaIntegral sz a)
forall (sz :: Nat) a. Integral a => ViaIntegral sz a -> Integer
forall (sz :: Nat) a.
Integral a =>
ViaIntegral sz a
-> ViaIntegral sz a -> (ViaIntegral sz a, ViaIntegral sz a)
forall (sz :: Nat) a.
Integral a =>
ViaIntegral sz a -> ViaIntegral sz a -> ViaIntegral sz a
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: ViaIntegral sz a -> Integer
$ctoInteger :: forall (sz :: Nat) a. Integral a => ViaIntegral sz a -> Integer
divMod :: ViaIntegral sz a
-> ViaIntegral sz a -> (ViaIntegral sz a, ViaIntegral sz a)
$cdivMod :: forall (sz :: Nat) a.
Integral a =>
ViaIntegral sz a
-> ViaIntegral sz a -> (ViaIntegral sz a, ViaIntegral sz a)
quotRem :: ViaIntegral sz a
-> ViaIntegral sz a -> (ViaIntegral sz a, ViaIntegral sz a)
$cquotRem :: forall (sz :: Nat) a.
Integral a =>
ViaIntegral sz a
-> ViaIntegral sz a -> (ViaIntegral sz a, ViaIntegral sz a)
mod :: ViaIntegral sz a -> ViaIntegral sz a -> ViaIntegral sz a
$cmod :: forall (sz :: Nat) a.
Integral a =>
ViaIntegral sz a -> ViaIntegral sz a -> ViaIntegral sz a
div :: ViaIntegral sz a -> ViaIntegral sz a -> ViaIntegral sz a
$cdiv :: forall (sz :: Nat) a.
Integral a =>
ViaIntegral sz a -> ViaIntegral sz a -> ViaIntegral sz a
rem :: ViaIntegral sz a -> ViaIntegral sz a -> ViaIntegral sz a
$crem :: forall (sz :: Nat) a.
Integral a =>
ViaIntegral sz a -> ViaIntegral sz a -> ViaIntegral sz a
quot :: ViaIntegral sz a -> ViaIntegral sz a -> ViaIntegral sz a
$cquot :: forall (sz :: Nat) a.
Integral a =>
ViaIntegral sz a -> ViaIntegral sz a -> ViaIntegral sz a
Integral)

instance KnownNat sz => HasFixedBitSize (ViaIntegral sz n) where
  type BitSize (ViaIntegral sz n) = sz

instance (Bits a, Integral a, Integral n, KnownNat sz) => AsRep a (ViaIntegral sz n) where
  fromRep :: a -> Int -> ViaIntegral sz n
fromRep a
r Int
off = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ a
mask forall a. Bits a => a -> a -> a
.&. (forall a. Bits a => a -> Int -> a
unsafeShiftR a
r Int
off)
    where
      mask :: a
mask = (forall a. Bits a => a -> Int -> a
unsafeShiftL (forall a. Bits a => Int -> a
bit Int
0) (forall a. HasFixedBitSize a => Int
fixedBitSize @(ViaIntegral sz n))) forall a. Num a => a -> a -> a
- a
1
  {-# INLINE fromRep #-}
  toRep :: a -> ViaIntegral sz n -> Int -> a
toRep a
rep ViaIntegral sz n
n Int
off = (a
mask forall a. Bits a => a -> a -> a
.&. a
rep) forall a. Bits a => a -> a -> a
.|. (forall a. Bits a => a -> Int -> a
unsafeShiftL (forall a b. (Integral a, Num b) => a -> b
fromIntegral ViaIntegral sz n
n) Int
off)
    where
      mask :: a
mask = forall a. Bits a => a -> a
complement forall a b. (a -> b) -> a -> b
$ forall a. Bits a => a -> Int -> a
unsafeShiftL ((forall a. Bits a => a -> Int -> a
unsafeShiftL (forall a. Bits a => Int -> a
bit Int
0) (forall a. HasFixedBitSize a => Int
fixedBitSize @(ViaIntegral sz n))) forall a. Num a => a -> a -> a
- a
1) Int
off
  {-# INLINE toRep #-}

instance HasFixedBitSize Int8  where type BitSize Int8  = 8
instance HasFixedBitSize Int16 where type BitSize Int16 = 16
instance HasFixedBitSize Int32 where type BitSize Int32 = 32
instance HasFixedBitSize Int64 where type BitSize Int64 = 64

instance HasFixedBitSize Int where type BitSize Int = SIZEOF_HSINT Nat.* 8

instance HasFixedBitSize Word8  where type BitSize Word8  = 8
instance HasFixedBitSize Word16 where type BitSize Word16 = 16
instance HasFixedBitSize Word32 where type BitSize Word32 = 32
instance HasFixedBitSize Word64 where type BitSize Word64 = 64

instance HasFixedBitSize Word where type BitSize Word = SIZEOF_HSINT Nat.* 8

deriving via (ViaIntegral 8  Int8 ) instance (Bits r, Integral r) => AsRep r Int8
deriving via (ViaIntegral 16 Int16) instance (Bits r, Integral r) => AsRep r Int16
deriving via (ViaIntegral 32 Int32) instance (Bits r, Integral r) => AsRep r Int32
deriving via (ViaIntegral 64 Int64) instance (Bits r, Integral r) => AsRep r Int64

deriving via (ViaIntegral (SIZEOF_HSINT Nat.* 8) Int) instance (Bits r, Integral r) => AsRep r Int

deriving via (ViaIntegral 8  Word8 ) instance (Bits r, Integral r) => AsRep r Word8
deriving via (ViaIntegral 16 Word16) instance (Bits r, Integral r) => AsRep r Word16
deriving via (ViaIntegral 32 Word32) instance (Bits r, Integral r) => AsRep r Word32
deriving via (ViaIntegral 64 Word64) instance (Bits r, Integral r) => AsRep r Word64

deriving via (ViaIntegral (SIZEOF_HSINT Nat.* 8) Word) instance (Bits r, Integral r) => AsRep r Word

-- | Deriving via helper for 'Enum' types. Requires that type to also have an instance of 'Generic'.
--
-- @
-- data AEnum = A1 | A2 | A3
--   deriving stock (Enum, Generic)
--   deriving (HasFixedBitSize, AsRep r) via (GenericEnum AEnum)
-- @
newtype GenericEnum a = GenericEnum a
  deriving newtype GenericEnum a -> GenericEnum a -> Bool
forall a. Eq a => GenericEnum a -> GenericEnum a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GenericEnum a -> GenericEnum a -> Bool
$c/= :: forall a. Eq a => GenericEnum a -> GenericEnum a -> Bool
== :: GenericEnum a -> GenericEnum a -> Bool
$c== :: forall a. Eq a => GenericEnum a -> GenericEnum a -> Bool
Eq

instance KnownNat (RoundUpLog2 (EnumSz (Rep a))) => HasFixedBitSize (GenericEnum a) where
  type BitSize (GenericEnum a) = RoundUpLog2 (EnumSz (Rep a))

instance (Generic a, Enum a, Bits rep, Integral rep, KnownNat (RoundUpLog2 (EnumSz (Rep a)))) => AsRep rep (GenericEnum a) where
  fromRep :: rep -> Int -> GenericEnum a
fromRep rep
rep Int
off =
    let ViaIntegral Int
i = forall rep a. AsRep rep a => rep -> Int -> a
fromRep @rep @(ViaIntegral (BitSize (GenericEnum a)) Int) rep
rep Int
off
    in forall a. a -> GenericEnum a
GenericEnum forall a b. (a -> b) -> a -> b
$ forall a. Enum a => Int -> a
toEnum Int
i
  {-# INLINE fromRep #-}
  toRep :: rep -> GenericEnum a -> Int -> rep
toRep rep
rep (GenericEnum a
x) Int
off =
    let x' :: ViaIntegral (BitSize (GenericEnum a)) Int
x' = forall (sz :: Nat) a. a -> ViaIntegral sz a
ViaIntegral @(BitSize (GenericEnum a)) forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum a
x
    in forall rep a. AsRep rep a => rep -> a -> Int -> rep
toRep rep
rep ViaIntegral (BitSize (GenericEnum a)) Int
x' Int
off
  {-# INLINE toRep #-}

-- Ugly way to check if we need to round up. Basically if he 2^log2(sz) /= sz then sz is not a power of two and was rounded down in log2.
type family RoundUpLog2 (sz :: Nat) :: Nat where
  RoundUpLog2 sz = RoundUpLog2' sz (2 ^ (Log2 sz)) (Log2 sz)

type family RoundUpLog2' (sz :: Nat) (sz' :: Nat) (log2 :: Nat) :: Nat where
  RoundUpLog2' sz sz log2 = log2
  RoundUpLog2' sz sz' log2 = log2 + 1

type family EnumSz (f :: p -> Type) :: Nat where
  EnumSz (M1 i s f) = EnumSz f
  EnumSz (f :+: g) = EnumSz f + EnumSz g
  EnumSz U1 = 1
  EnumSz (f :*: g) = TypeError (Text "Deriving a generic AsRep instance only supports sum types with empty constructors")
  EnumSz (K1 c a)  = TypeError (Text "Deriving a generic AsRep instance only supports sum types with empty constructors")

type family ReqSz (f :: p -> Type) :: Nat where
  ReqSz (M1 i s f) = ReqSz f
  ReqSz (K1 c a) = BitSize a
  ReqSz (f :*: g) = ReqSz f + ReqSz g

-- | Constraint which checks if a datatype fits.
type Fits rep a = FitsPred (ReqSz (Rep a) <=? BitSize rep) rep a

type family FitsPred (b :: Bool) (rep :: Type) (a :: Type) :: Constraint where
  FitsPred True _ _ = ()
  FitsPred False rep a = TypeError (Text "Datatype " :<>: ShowType a :<>: Text " needs " :<>: ShowType (ReqSz (Rep a)) :<>: Text " bits, but the given representation " :<>: ShowType rep :<>: Text " has " :<>: ShowType (BitSize rep))