module Haskus.Format.Binary.Enum
( EnumField
, CEnum (..)
, fromEnumField
, toEnumField
, makeEnum
, makeEnumMaybe
, makeEnumWithCustom
)
where
import Haskus.Format.Binary.Storable
import Haskus.Format.Binary.Ptr
import Data.Data
newtype EnumField b a = EnumField a deriving (Show,Eq)
instance
( Storable b
, Integral b
, CEnum a
) => Storable (EnumField b a)
where
sizeOf _ = sizeOfT @b
alignment _ = alignmentT @b
peekIO p = (EnumField . toCEnum) <$> peek (castPtr p :: Ptr b)
pokeIO p (EnumField v) = poke (castPtr p :: Ptr b) (fromCEnum v)
instance
( Integral b
, StaticStorable b
, CEnum a
) => StaticStorable (EnumField b a)
where
type SizeOf (EnumField b a) = SizeOf b
type Alignment (EnumField b a) = Alignment b
staticPeekIO p = (EnumField . toCEnum) <$> staticPeek (castPtr p :: Ptr b)
staticPokeIO p (EnumField v) = staticPoke (castPtr p :: Ptr b) (fromCEnum v)
fromEnumField :: EnumField b a -> a
fromEnumField (EnumField a) = a
toEnumField :: a -> EnumField b a
toEnumField = EnumField
class CEnum a where
fromCEnum :: Integral b => a -> b
default fromCEnum :: (Enum a, Integral b) => a -> b
fromCEnum = fromIntegral . fromEnum
toCEnum :: Integral b => b -> a
default toCEnum :: (Enum a, Integral b) => b -> a
toCEnum = toEnum . fromIntegral
makeEnumWithCustom :: forall a i. (Data a,Integral i) => i -> a
makeEnumWithCustom x =
if x' < maxConstrIndex t
then fromConstr (indexConstr t x')
else fromConstrB (fromConstr (toConstr (x' m)))
(indexConstr t m)
where
m = maxConstrIndex t
x' = fromIntegral x + 1
t = dataTypeOf (undefined :: a)
makeEnumMaybe :: forall a i. (Data a,Integral i) => i -> Maybe a
makeEnumMaybe x =
if x' < maxConstrIndex t
then Just (fromConstr (indexConstr t x'))
else Nothing
where
x' = fromIntegral x + 1
t = dataTypeOf (undefined :: a)
makeEnum :: forall a i. (Data a,Integral i) => i -> a
makeEnum x =fromConstr (indexConstr t x')
where
x' = fromIntegral x + 1
t = dataTypeOf (undefined :: a)