module Dahdit.Binary
  ( Binary (..)
  )
where

import Dahdit.Free (Get, Put)
import Dahdit.Funs
  ( getDoubleBE
  , getDoubleLE
  , getFloatBE
  , getFloatLE
  , getInt16BE
  , getInt16LE
  , getInt24BE
  , getInt24LE
  , getInt32BE
  , getInt32LE
  , getInt64BE
  , getInt64LE
  , getInt8
  , getList
  , getSeq
  , getWord16BE
  , getWord16LE
  , getWord24BE
  , getWord24LE
  , getWord32BE
  , getWord32LE
  , getWord64BE
  , getWord64LE
  , getWord8
  , putDoubleBE
  , putDoubleLE
  , putFloatBE
  , putFloatLE
  , putInt16BE
  , putInt16LE
  , putInt24BE
  , putInt24LE
  , putInt32BE
  , putInt32LE
  , putInt64BE
  , putInt64LE
  , putInt8
  , putList
  , putSeq
  , putWord16BE
  , putWord16LE
  , putWord24BE
  , putWord24LE
  , putWord32BE
  , putWord32LE
  , putWord64BE
  , putWord64LE
  , putWord8
  )
import Dahdit.Nums
  ( DoubleBE (..)
  , DoubleLE (..)
  , FloatBE (..)
  , FloatLE (..)
  , Int16BE (..)
  , Int16LE (..)
  , Int24BE (..)
  , Int24LE (..)
  , Int32BE (..)
  , Int32LE (..)
  , Int64BE (..)
  , Int64LE (..)
  , Word16BE (..)
  , Word16LE (..)
  , Word24BE (..)
  , Word24LE (..)
  , Word32BE (..)
  , Word32LE (..)
  , Word64BE (..)
  , Word64LE (..)
  )
import Dahdit.Sizes (ElemCount (..))
import Data.ByteString.Internal (c2w, w2c)
import Data.Coerce (coerce)
import Data.Int (Int16, Int32, Int64, Int8)
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Sequence (Seq (..))
import qualified Data.Sequence as Seq
import Data.Set (Set)
import qualified Data.Set as Set
import Data.ShortWord (Int24, Word24)
import Data.Word (Word16, Word32, Word64, Word8)

class Binary a where
  get :: Get a
  put :: a -> Put

-- Basic types

instance Binary () where
  get :: Get ()
get = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  put :: () -> Put
put ()
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

instance Binary Word8 where
  get :: Get Word8
get = Get Word8
getWord8
  put :: Word8 -> Put
put = Word8 -> Put
putWord8

instance Binary Int8 where
  get :: Get Int8
get = Get Int8
getInt8
  put :: Int8 -> Put
put = Int8 -> Put
putInt8

instance Binary Word16LE where
  get :: Get Word16LE
get = Get Word16LE
getWord16LE
  put :: Word16LE -> Put
put = Word16LE -> Put
putWord16LE

instance Binary Int16LE where
  get :: Get Int16LE
get = Get Int16LE
getInt16LE
  put :: Int16LE -> Put
put = Int16LE -> Put
putInt16LE

instance Binary Word24LE where
  get :: Get Word24LE
get = Get Word24LE
getWord24LE
  put :: Word24LE -> Put
put = Word24LE -> Put
putWord24LE

instance Binary Int24LE where
  get :: Get Int24LE
get = Get Int24LE
getInt24LE
  put :: Int24LE -> Put
put = Int24LE -> Put
putInt24LE

instance Binary Word32LE where
  get :: Get Word32LE
get = Get Word32LE
getWord32LE
  put :: Word32LE -> Put
put = Word32LE -> Put
putWord32LE

instance Binary Int32LE where
  get :: Get Int32LE
get = Get Int32LE
getInt32LE
  put :: Int32LE -> Put
put = Int32LE -> Put
putInt32LE

instance Binary Word64LE where
  get :: Get Word64LE
get = Get Word64LE
getWord64LE
  put :: Word64LE -> Put
put = Word64LE -> Put
putWord64LE

instance Binary Int64LE where
  get :: Get Int64LE
get = Get Int64LE
getInt64LE
  put :: Int64LE -> Put
put = Int64LE -> Put
putInt64LE

instance Binary FloatLE where
  get :: Get FloatLE
get = Get FloatLE
getFloatLE
  put :: FloatLE -> Put
put = FloatLE -> Put
putFloatLE

instance Binary DoubleLE where
  get :: Get DoubleLE
get = Get DoubleLE
getDoubleLE
  put :: DoubleLE -> Put
put = DoubleLE -> Put
putDoubleLE

instance Binary Word16BE where
  get :: Get Word16BE
get = Get Word16BE
getWord16BE
  put :: Word16BE -> Put
put = Word16BE -> Put
putWord16BE

instance Binary Int16BE where
  get :: Get Int16BE
get = Get Int16BE
getInt16BE
  put :: Int16BE -> Put
put = Int16BE -> Put
putInt16BE

instance Binary Word24BE where
  get :: Get Word24BE
get = Get Word24BE
getWord24BE
  put :: Word24BE -> Put
put = Word24BE -> Put
putWord24BE

instance Binary Int24BE where
  get :: Get Int24BE
get = Get Int24BE
getInt24BE
  put :: Int24BE -> Put
put = Int24BE -> Put
putInt24BE

instance Binary Word32BE where
  get :: Get Word32BE
get = Get Word32BE
getWord32BE
  put :: Word32BE -> Put
put = Word32BE -> Put
putWord32BE

instance Binary Int32BE where
  get :: Get Int32BE
get = Get Int32BE
getInt32BE
  put :: Int32BE -> Put
put = Int32BE -> Put
putInt32BE

instance Binary Word64BE where
  get :: Get Word64BE
get = Get Word64BE
getWord64BE
  put :: Word64BE -> Put
put = Word64BE -> Put
putWord64BE

instance Binary Int64BE where
  get :: Get Int64BE
get = Get Int64BE
getInt64BE
  put :: Int64BE -> Put
put = Int64BE -> Put
putInt64BE

instance Binary FloatBE where
  get :: Get FloatBE
get = Get FloatBE
getFloatBE
  put :: FloatBE -> Put
put = FloatBE -> Put
putFloatBE

instance Binary DoubleBE where
  get :: Get DoubleBE
get = Get DoubleBE
getDoubleBE
  put :: DoubleBE -> Put
put = DoubleBE -> Put
putDoubleBE

deriving via Word16LE instance Binary Word16

deriving via Int16LE instance Binary Int16

deriving via Word24LE instance Binary Word24

deriving via Int24LE instance Binary Int24

deriving via Word32LE instance Binary Word32

deriving via Int32LE instance Binary Int32

deriving via Word64LE instance Binary Word64

deriving via Int64LE instance Binary Int64

deriving via FloatLE instance Binary Float

deriving via DoubleLE instance Binary Double

instance Binary Bool where
  get :: Get Bool
get = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Eq a => a -> a -> Bool
/= Word8
0) Get Word8
getWord8
  put :: Bool -> Put
put Bool
b = Word8 -> Put
putWord8 (if Bool
b then Word8
1 else Word8
0)

instance Binary Char where
  get :: Get Char
get = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word8 -> Char
w2c Get Word8
getWord8
  put :: Char -> Put
put = Word8 -> Put
putWord8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Word8
c2w

instance Binary Int where
  get :: Get Int
get = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Integral a, Num b) => a -> b
fromIntegral Get Int64LE
getInt64LE
  put :: Int -> Put
put = Int64LE -> Put
putInt64LE forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance Binary a => Binary [a] where
  get :: Get [a]
get = do
    Int
ec <- forall a. Binary a => Get a
get @Int
    forall a. ElemCount -> Get a -> Get [a]
getList (coerce :: forall a b. Coercible a b => a -> b
coerce Int
ec) forall a. Binary a => Get a
get
  put :: [a] -> Put
put [a]
s = forall a. Binary a => a -> Put
put @Int (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
s) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. (a -> Put) -> [a] -> Put
putList forall a. Binary a => a -> Put
put [a]
s

instance Binary a => Binary (Seq a) where
  get :: Get (Seq a)
get = do
    Int
ec <- forall a. Binary a => Get a
get @Int
    forall a. ElemCount -> Get a -> Get (Seq a)
getSeq (coerce :: forall a b. Coercible a b => a -> b
coerce Int
ec) forall a. Binary a => Get a
get
  put :: Seq a -> Put
put Seq a
s = forall a. Binary a => a -> Put
put @Int (forall a. Seq a -> Int
Seq.length Seq a
s) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. (a -> Put) -> Seq a -> Put
putSeq forall a. Binary a => a -> Put
put Seq a
s

instance Binary a => Binary (Set a) where
  get :: Get (Set a)
get = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [a] -> Set a
Set.fromDistinctAscList forall a. Binary a => Get a
get
  put :: Set a -> Put
put = forall a. Binary a => a -> Put
put forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> [a]
Set.toAscList

instance (Binary k, Binary v) => Binary (Map k v) where
  get :: Get (Map k v)
get = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k a. [(k, a)] -> Map k a
Map.fromDistinctAscList forall a. Binary a => Get a
get
  put :: Map k v -> Put
put = forall a. Binary a => a -> Put
put forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
Map.toAscList

instance Binary IntSet where
  get :: Get IntSet
get = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Int] -> IntSet
IntSet.fromDistinctAscList forall a. Binary a => Get a
get
  put :: IntSet -> Put
put = forall a. Binary a => a -> Put
put forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> [Int]
IntSet.toAscList

instance Binary v => Binary (IntMap v) where
  get :: Get (IntMap v)
get = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [(Int, a)] -> IntMap a
IntMap.fromDistinctAscList forall a. Binary a => Get a
get
  put :: IntMap v -> Put
put = forall a. Binary a => a -> Put
put forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IntMap a -> [(Int, a)]
IntMap.toAscList

instance Binary a => Binary (Maybe a) where
  get :: Get (Maybe a)
get = do
    Int
tag <- forall a. Binary a => Get a
get @Int
    case Int
tag of
      Int
0 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
      Int
1 -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall a. Binary a => Get a
get
      Int
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unknown encoding for constructor"
  put :: Maybe a -> Put
put = \case
    Maybe a
Nothing -> forall a. Binary a => a -> Put
put @Int Int
0
    Just a
a -> forall a. Binary a => a -> Put
put @Int Int
1 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Binary a => a -> Put
put a
a

instance (Binary b, Binary a) => Binary (Either b a) where
  get :: Get (Either b a)
get = do
    Int
tag <- forall a. Binary a => Get a
get @Int
    case Int
tag of
      Int
0 -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left forall a. Binary a => Get a
get
      Int
1 -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right forall a. Binary a => Get a
get
      Int
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unknown encoding for constructor"
  put :: Either b a -> Put
put = \case
    Left b
b -> forall a. Binary a => a -> Put
put @Int Int
0 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Binary a => a -> Put
put b
b
    Right a
a -> forall a. Binary a => a -> Put
put @Int Int
1 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Binary a => a -> Put
put a
a

instance (Binary a, Binary b) => Binary (a, b) where
  get :: Get (a, b)
get = do
    a
a <- forall a. Binary a => Get a
get
    b
b <- forall a. Binary a => Get a
get
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, b
b)
  put :: (a, b) -> Put
put (a
a, b
b) = forall a. Binary a => a -> Put
put a
a forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Binary a => a -> Put
put b
b

instance (Binary a, Binary b, Binary c) => Binary (a, b, c) where
  get :: Get (a, b, c)
get = do
    a
a <- forall a. Binary a => Get a
get
    b
b <- forall a. Binary a => Get a
get
    c
c <- forall a. Binary a => Get a
get
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, b
b, c
c)
  put :: (a, b, c) -> Put
put (a
a, b
b, c
c) = forall a. Binary a => a -> Put
put a
a forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Binary a => a -> Put
put b
b forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Binary a => a -> Put
put c
c

instance (Binary a, Binary b, Binary c, Binary d) => Binary (a, b, c, d) where
  get :: Get (a, b, c, d)
get = do
    a
a <- forall a. Binary a => Get a
get
    b
b <- forall a. Binary a => Get a
get
    c
c <- forall a. Binary a => Get a
get
    d
d <- forall a. Binary a => Get a
get
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, b
b, c
c, d
d)
  put :: (a, b, c, d) -> Put
put (a
a, b
b, c
c, d
d) = forall a. Binary a => a -> Put
put a
a forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Binary a => a -> Put
put b
b forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Binary a => a -> Put
put c
c forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Binary a => a -> Put
put d
d

instance (Binary a, Binary b, Binary c, Binary d, Binary e) => Binary (a, b, c, d, e) where
  get :: Get (a, b, c, d, e)
get = do
    a
a <- forall a. Binary a => Get a
get
    b
b <- forall a. Binary a => Get a
get
    c
c <- forall a. Binary a => Get a
get
    d
d <- forall a. Binary a => Get a
get
    e
e <- forall a. Binary a => Get a
get
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, b
b, c
c, d
d, e
e)
  put :: (a, b, c, d, e) -> Put
put (a
a, b
b, c
c, d
d, e
e) = forall a. Binary a => a -> Put
put a
a forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Binary a => a -> Put
put b
b forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Binary a => a -> Put
put c
c forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Binary a => a -> Put
put d
d forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Binary a => a -> Put
put e
e