{-# LANGUAGE UndecidableInstances #-}

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

import Dahdit.Binary (Binary (..))
import Dahdit.Sizes (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 = x -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral x
x
    in  if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< a -> Int
forall a. Enum a => a -> Int
fromEnum (a
forall a. Bounded a => a
minBound :: a) Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> a -> Int
forall a. Enum a => a -> Int
fromEnum (a
forall a. Bounded a => a
maxBound :: a)
          then String -> Either String (ViaBoundedEnum x a)
forall a b. a -> Either a b
Left (String
"Invalid enum value: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i)
          else ViaBoundedEnum x a -> Either String (ViaBoundedEnum x a)
forall a b. b -> Either a b
Right (a -> ViaBoundedEnum x a
forall x a. a -> ViaBoundedEnum x a
ViaBoundedEnum (Int -> a
forall a. Enum a => Int -> a
toEnum Int
i))
  toBinaryRep :: ViaBoundedEnum x a -> x
toBinaryRep = Int -> x
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> x)
-> (ViaBoundedEnum x a -> Int) -> ViaBoundedEnum x a -> x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a. Enum a => a -> Int
fromEnum (a -> Int)
-> (ViaBoundedEnum x a -> a) -> ViaBoundedEnum x a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ViaBoundedEnum x a -> a
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 = ViaIntegral x a -> Either String (ViaIntegral x a)
forall a b. b -> Either a b
Right (ViaIntegral x a -> Either String (ViaIntegral x a))
-> (x -> ViaIntegral x a) -> x -> Either String (ViaIntegral x a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ViaIntegral x a
forall x a. a -> ViaIntegral x a
ViaIntegral (a -> ViaIntegral x a) -> (x -> a) -> x -> ViaIntegral x a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  toBinaryRep :: ViaIntegral x a -> x
toBinaryRep = a -> x
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> x) -> (ViaIntegral x a -> a) -> ViaIntegral x a -> x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ViaIntegral x a -> a
forall x a. ViaIntegral x a -> a
unViaIntegral

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

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

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