{-# LANGUAGE UndecidableInstances #-}

module Dahdit.BinaryRep
  ( BinaryRep (..)
  , ViaBoundedEnum (..)
  , ViaIntegral (..)
  , ViaBinaryRep (..)
  )
where

import Dahdit.Binary (Binary (..))
import Dahdit.Sizes (ByteSized (..), StaticByteSized (..))
import Data.Proxy (Proxy (..))

class Binary x => BinaryRep x a | a -> x where
  fromBinaryRep :: x -> Either String a
  toBinaryRep :: a -> x

newtype ViaBoundedEnum x a = ViaBoundedEnum {forall x a. ViaBoundedEnum x a -> a
unViaBoundedEnum :: a}

instance (Binary x, Integral x, Bounded a, Enum a) => BinaryRep x (ViaBoundedEnum x a) where
  fromBinaryRep :: x -> Either String (ViaBoundedEnum x a)
fromBinaryRep x
x =
    let i :: Int
i = forall a b. (Integral a, Num b) => a -> b
fromIntegral x
x
    in  if Int
i forall a. Ord a => a -> a -> Bool
< forall a. Enum a => a -> Int
fromEnum (forall a. Bounded a => a
minBound :: a) Bool -> Bool -> Bool
|| Int
i forall a. Ord a => a -> a -> Bool
> forall a. Enum a => a -> Int
fromEnum (forall a. Bounded a => a
maxBound :: a)
          then forall a b. a -> Either a b
Left (String
"Invalid enum value: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
i)
          else forall a b. b -> Either a b
Right (forall x a. a -> ViaBoundedEnum x a
ViaBoundedEnum (forall a. Enum a => Int -> a
toEnum Int
i))
  toBinaryRep :: ViaBoundedEnum x a -> x
toBinaryRep = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x a. ViaBoundedEnum x a -> a
unViaBoundedEnum

newtype ViaIntegral x a = ViaIntegral {forall x a. ViaIntegral x a -> a
unViaIntegral :: a}

instance (Binary x, Integral x, Integral a) => BinaryRep x (ViaIntegral x a) where
  fromBinaryRep :: x -> Either String (ViaIntegral x a)
fromBinaryRep = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x a. a -> ViaIntegral x a
ViaIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
  toBinaryRep :: ViaIntegral x a -> x
toBinaryRep = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x a. ViaIntegral x a -> a
unViaIntegral

newtype ViaBinaryRep a = ViaBinaryRep {forall a. ViaBinaryRep a -> a
unViaBinaryRep :: a}

instance (ByteSized x, BinaryRep x a) => ByteSized (ViaBinaryRep a) where
  byteSize :: ViaBinaryRep a -> ByteCount
byteSize = forall a. ByteSized a => a -> ByteCount
byteSize forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x a. BinaryRep x a => a -> x
toBinaryRep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ViaBinaryRep a -> a
unViaBinaryRep

instance (StaticByteSized x, BinaryRep x a) => StaticByteSized (ViaBinaryRep a) where
  staticByteSize :: Proxy (ViaBinaryRep a) -> ByteCount
staticByteSize Proxy (ViaBinaryRep a)
_ = forall a. StaticByteSized a => Proxy a -> ByteCount
staticByteSize (forall {k} (t :: k). Proxy t
Proxy :: Proxy x)

instance BinaryRep x a => Binary (ViaBinaryRep a) where
  get :: Get (ViaBinaryRep a)
get = forall a. Binary a => Get a
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => String -> m a
fail (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> ViaBinaryRep a
ViaBinaryRep) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x a. BinaryRep x a => x -> Either String a
fromBinaryRep
  put :: ViaBinaryRep a -> Put
put = forall a. Binary a => a -> Put
put forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x a. BinaryRep x a => a -> x
toBinaryRep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ViaBinaryRep a -> a
unViaBinaryRep