module Dahdit.Fancy
  ( TermBytes (..)
  , StaticBytes (..)
  , mkStaticBytes
  , normStaticBytes
  , StaticSeq (..)
  , StaticArray (..)
  , BoolByte (..)
  , ExactBytes (..)
  )
where

import Control.Monad (unless)
import Dahdit.Binary (Binary (..))
import Dahdit.Free (Get)
import Dahdit.Funs
  ( getByteString
  , getExpect
  , getStaticArray
  , getStaticSeq
  , getWord8
  , putByteString
  , putFixedString
  , putWord8
  , unsafePutStaticArrayN
  , unsafePutStaticSeqN
  )
import Dahdit.Proxy (proxyForNatF)
import Dahdit.Sizes (ByteSized (..), StaticByteSized (..), ViaStaticByteSized (..))
import Data.ByteString.Internal (c2w)
import qualified Data.ByteString.Short as BSS
import Data.ByteString.Short.Internal (ShortByteString (..))
import Data.Default (Default (..))
import Data.Primitive (Prim)
import Data.Primitive.ByteArray (ByteArray (..), byteArrayFromListN)
import Data.Primitive.PrimArray (PrimArray, replicatePrimArray)
import Data.Proxy (Proxy (..))
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Data.String (IsString)
import Data.Word (Word8)
import GHC.TypeLits (KnownNat, KnownSymbol, Nat, Symbol, natVal, symbolVal)

getUntilNull :: Get (Int, [Word8])
getUntilNull :: Get (Int, [Word8])
getUntilNull = forall {t}. Num t => t -> [Word8] -> Get (t, [Word8])
go Int
0 []
 where
  go :: t -> [Word8] -> Get (t, [Word8])
go !t
i ![Word8]
racc = do
    Word8
w <- Get Word8
getWord8
    if Word8
w forall a. Eq a => a -> a -> Bool
== Word8
0
      then
        let !acc :: [Word8]
acc = forall a. [a] -> [a]
reverse [Word8]
racc
        in  forall (f :: * -> *) a. Applicative f => a -> f a
pure (t
i, [Word8]
acc)
      else t -> [Word8] -> Get (t, [Word8])
go (t
i forall a. Num a => a -> a -> a
+ t
1) (Word8
w forall a. a -> [a] -> [a]
: [Word8]
racc)

mkSBS :: Int -> [Word8] -> ShortByteString
mkSBS :: Int -> [Word8] -> ShortByteString
mkSBS Int
n [Word8]
bs = let !(ByteArray ByteArray#
ba) = forall a. Prim a => Int -> [a] -> ByteArray
byteArrayFromListN Int
n [Word8]
bs in ByteArray# -> ShortByteString
SBS ByteArray#
ba

-- | Bytes terminated with null byte.
-- NOTE: Terminated with TWO null bytes if the string is even length
-- to align to Word16 boundaries, as required for RIFF format, for example.
newtype TermBytes = TermBytes {TermBytes -> ShortByteString
unTermBytes :: ShortByteString}
  deriving stock (Int -> TermBytes -> ShowS
[TermBytes] -> ShowS
TermBytes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TermBytes] -> ShowS
$cshowList :: [TermBytes] -> ShowS
show :: TermBytes -> String
$cshow :: TermBytes -> String
showsPrec :: Int -> TermBytes -> ShowS
$cshowsPrec :: Int -> TermBytes -> ShowS
Show)
  deriving newtype (TermBytes -> TermBytes -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TermBytes -> TermBytes -> Bool
$c/= :: TermBytes -> TermBytes -> Bool
== :: TermBytes -> TermBytes -> Bool
$c== :: TermBytes -> TermBytes -> Bool
Eq, Eq TermBytes
TermBytes -> TermBytes -> Bool
TermBytes -> TermBytes -> Ordering
TermBytes -> TermBytes -> TermBytes
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 :: TermBytes -> TermBytes -> TermBytes
$cmin :: TermBytes -> TermBytes -> TermBytes
max :: TermBytes -> TermBytes -> TermBytes
$cmax :: TermBytes -> TermBytes -> TermBytes
>= :: TermBytes -> TermBytes -> Bool
$c>= :: TermBytes -> TermBytes -> Bool
> :: TermBytes -> TermBytes -> Bool
$c> :: TermBytes -> TermBytes -> Bool
<= :: TermBytes -> TermBytes -> Bool
$c<= :: TermBytes -> TermBytes -> Bool
< :: TermBytes -> TermBytes -> Bool
$c< :: TermBytes -> TermBytes -> Bool
compare :: TermBytes -> TermBytes -> Ordering
$ccompare :: TermBytes -> TermBytes -> Ordering
Ord, String -> TermBytes
forall a. (String -> a) -> IsString a
fromString :: String -> TermBytes
$cfromString :: String -> TermBytes
IsString)

instance Default TermBytes where
  def :: TermBytes
def = ShortByteString -> TermBytes
TermBytes ShortByteString
BSS.empty

instance ByteSized TermBytes where
  byteSize :: TermBytes -> ByteCount
byteSize (TermBytes ShortByteString
sbs) =
    let !bc :: ByteCount
bc = forall a. ByteSized a => a -> ByteCount
byteSize ShortByteString
sbs forall a. Num a => a -> a -> a
+ ByteCount
1
    in  if forall a. Integral a => a -> Bool
even ByteCount
bc then ByteCount
bc else ByteCount
bc forall a. Num a => a -> a -> a
+ ByteCount
1

instance Binary TermBytes where
  get :: Get TermBytes
get = do
    (!Int
i, [Word8]
acc) <- Get (Int, [Word8])
getUntilNull
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall a. Integral a => a -> Bool
odd Int
i) forall a b. (a -> b) -> a -> b
$ do
      Word8
w <- Get Word8
getWord8
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word8
w forall a. Eq a => a -> a -> Bool
== Word8
0) (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"TermBytes missing word pad")
    let !sbs :: ShortByteString
sbs = Int -> [Word8] -> ShortByteString
mkSBS Int
i [Word8]
acc
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! ShortByteString -> TermBytes
TermBytes ShortByteString
sbs

  put :: TermBytes -> Put
put (TermBytes ShortByteString
sbs) = do
    ShortByteString -> Put
putByteString ShortByteString
sbs
    Word8 -> Put
putWord8 Word8
0
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall a. Integral a => a -> Bool
odd (ShortByteString -> Int
BSS.length ShortByteString
sbs)) (Word8 -> Put
putWord8 Word8
0)

-- | A fixed-length bytestring (truncated or zero-padded on put if length does not match).
newtype StaticBytes (n :: Nat) = StaticBytes {forall (n :: Nat). StaticBytes n -> ShortByteString
unStaticBytes :: ShortByteString}
  deriving stock (Int -> StaticBytes n -> ShowS
forall (n :: Nat). Int -> StaticBytes n -> ShowS
forall (n :: Nat). [StaticBytes n] -> ShowS
forall (n :: Nat). StaticBytes n -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StaticBytes n] -> ShowS
$cshowList :: forall (n :: Nat). [StaticBytes n] -> ShowS
show :: StaticBytes n -> String
$cshow :: forall (n :: Nat). StaticBytes n -> String
showsPrec :: Int -> StaticBytes n -> ShowS
$cshowsPrec :: forall (n :: Nat). Int -> StaticBytes n -> ShowS
Show)
  deriving newtype (String -> StaticBytes n
forall (n :: Nat). String -> StaticBytes n
forall a. (String -> a) -> IsString a
fromString :: String -> StaticBytes n
$cfromString :: forall (n :: Nat). String -> StaticBytes n
IsString)
  deriving (StaticBytes n -> ByteCount
forall (n :: Nat). KnownNat n => StaticBytes n -> ByteCount
forall a. (a -> ByteCount) -> ByteSized a
byteSize :: StaticBytes n -> ByteCount
$cbyteSize :: forall (n :: Nat). KnownNat n => StaticBytes n -> ByteCount
ByteSized) via (ViaStaticByteSized (StaticBytes n))

mkStaticBytes :: KnownNat n => Proxy n -> ShortByteString -> StaticBytes n
mkStaticBytes :: forall (n :: Nat).
KnownNat n =>
Proxy n -> ShortByteString -> StaticBytes n
mkStaticBytes Proxy n
prox ShortByteString
sbs =
  let n :: Int
n = forall a. Num a => Integer -> a
fromInteger (forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal Proxy n
prox)
  in  if ShortByteString -> Int
BSS.length ShortByteString
sbs forall a. Eq a => a -> a -> Bool
== Int
n
        then forall (n :: Nat). ShortByteString -> StaticBytes n
StaticBytes ShortByteString
sbs
        else
          let x1 :: ShortByteString
x1 = Int -> ShortByteString -> ShortByteString
BSS.take Int
n ShortByteString
sbs
              l :: Int
l = ShortByteString -> Int
BSS.length ShortByteString
x1
          in  forall (n :: Nat). ShortByteString -> StaticBytes n
StaticBytes forall a b. (a -> b) -> a -> b
$
                if Int
l forall a. Eq a => a -> a -> Bool
== Int
n
                  then ShortByteString
x1
                  else ShortByteString
x1 forall a. Semigroup a => a -> a -> a
<> Int -> Word8 -> ShortByteString
BSS.replicate (Int
n forall a. Num a => a -> a -> a
- Int
l) Word8
0

normStaticBytes :: KnownNat n => StaticBytes n -> StaticBytes n
normStaticBytes :: forall (n :: Nat). KnownNat n => StaticBytes n -> StaticBytes n
normStaticBytes sb :: StaticBytes n
sb@(StaticBytes ShortByteString
sbs) = forall (n :: Nat).
KnownNat n =>
Proxy n -> ShortByteString -> StaticBytes n
mkStaticBytes (forall (n :: Nat) (f :: Nat -> *). f n -> Proxy n
proxyForNatF StaticBytes n
sb) ShortByteString
sbs

instance KnownNat n => Eq (StaticBytes n) where
  StaticBytes n
x == :: StaticBytes n -> StaticBytes n -> Bool
== StaticBytes n
y =
    let StaticBytes ShortByteString
x' = forall (n :: Nat). KnownNat n => StaticBytes n -> StaticBytes n
normStaticBytes StaticBytes n
x
        StaticBytes ShortByteString
y' = forall (n :: Nat). KnownNat n => StaticBytes n -> StaticBytes n
normStaticBytes StaticBytes n
y
    in  ShortByteString
x' forall a. Eq a => a -> a -> Bool
== ShortByteString
y'

instance KnownNat n => Ord (StaticBytes n) where
  compare :: StaticBytes n -> StaticBytes n -> Ordering
compare StaticBytes n
x StaticBytes n
y =
    let StaticBytes ShortByteString
x' = forall (n :: Nat). KnownNat n => StaticBytes n -> StaticBytes n
normStaticBytes StaticBytes n
x
        StaticBytes ShortByteString
y' = forall (n :: Nat). KnownNat n => StaticBytes n -> StaticBytes n
normStaticBytes StaticBytes n
y
    in  forall a. Ord a => a -> a -> Ordering
compare ShortByteString
x' ShortByteString
y'

instance Default (StaticBytes n) where
  def :: StaticBytes n
def = forall (n :: Nat). ShortByteString -> StaticBytes n
StaticBytes ShortByteString
BSS.empty

instance KnownNat n => StaticByteSized (StaticBytes n) where
  staticByteSize :: Proxy (StaticBytes n) -> ByteCount
staticByteSize Proxy (StaticBytes n)
_ = forall a. Num a => Integer -> a
fromInteger (forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall {k} (t :: k). Proxy t
Proxy :: Proxy n))

instance KnownNat n => Binary (StaticBytes n) where
  get :: Get (StaticBytes n)
get = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (n :: Nat). ShortByteString -> StaticBytes n
StaticBytes (ByteCount -> Get ShortByteString
getByteString (forall a. Num a => Integer -> a
fromInteger (forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall {k} (t :: k). Proxy t
Proxy :: Proxy n))))
  put :: StaticBytes n -> Put
put fb :: StaticBytes n
fb@(StaticBytes ShortByteString
sbs) = Word8 -> ByteCount -> ShortByteString -> Put
putFixedString Word8
0 (forall a. Num a => Integer -> a
fromInteger (forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal StaticBytes n
fb)) ShortByteString
sbs

newtype StaticSeq (n :: Nat) a = StaticSeq {forall (n :: Nat) a. StaticSeq n a -> Seq a
unStaticSeq :: Seq a}
  deriving stock (Int -> StaticSeq n a -> ShowS
forall (n :: Nat) a. Show a => Int -> StaticSeq n a -> ShowS
forall (n :: Nat) a. Show a => [StaticSeq n a] -> ShowS
forall (n :: Nat) a. Show a => StaticSeq n a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StaticSeq n a] -> ShowS
$cshowList :: forall (n :: Nat) a. Show a => [StaticSeq n a] -> ShowS
show :: StaticSeq n a -> String
$cshow :: forall (n :: Nat) a. Show a => StaticSeq n a -> String
showsPrec :: Int -> StaticSeq n a -> ShowS
$cshowsPrec :: forall (n :: Nat) a. Show a => Int -> StaticSeq n a -> ShowS
Show)
  deriving newtype (StaticSeq n a -> StaticSeq n a -> Bool
forall (n :: Nat) a. Eq a => StaticSeq n a -> StaticSeq n a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StaticSeq n a -> StaticSeq n a -> Bool
$c/= :: forall (n :: Nat) a. Eq a => StaticSeq n a -> StaticSeq n a -> Bool
== :: StaticSeq n a -> StaticSeq n a -> Bool
$c== :: forall (n :: Nat) a. Eq a => StaticSeq n a -> StaticSeq n a -> Bool
Eq, forall (n :: Nat) a b. a -> StaticSeq n b -> StaticSeq n a
forall (n :: Nat) a b. (a -> b) -> StaticSeq n a -> StaticSeq n b
forall a b. a -> StaticSeq n b -> StaticSeq n a
forall a b. (a -> b) -> StaticSeq n a -> StaticSeq n b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> StaticSeq n b -> StaticSeq n a
$c<$ :: forall (n :: Nat) a b. a -> StaticSeq n b -> StaticSeq n a
fmap :: forall a b. (a -> b) -> StaticSeq n a -> StaticSeq n b
$cfmap :: forall (n :: Nat) a b. (a -> b) -> StaticSeq n a -> StaticSeq n b
Functor, forall (n :: Nat) a. Eq a => a -> StaticSeq n a -> Bool
forall (n :: Nat) a. Num a => StaticSeq n a -> a
forall (n :: Nat) a. Ord a => StaticSeq n a -> a
forall (n :: Nat) m. Monoid m => StaticSeq n m -> m
forall (n :: Nat) a. StaticSeq n a -> Bool
forall (n :: Nat) a. StaticSeq n a -> Int
forall (n :: Nat) a. StaticSeq n a -> [a]
forall (n :: Nat) a. (a -> a -> a) -> StaticSeq n a -> a
forall (n :: Nat) m a. Monoid m => (a -> m) -> StaticSeq n a -> m
forall (n :: Nat) b a. (b -> a -> b) -> b -> StaticSeq n a -> b
forall (n :: Nat) a b. (a -> b -> b) -> b -> StaticSeq n a -> b
forall a. Eq a => a -> StaticSeq n a -> Bool
forall a. Num a => StaticSeq n a -> a
forall a. Ord a => StaticSeq n a -> a
forall m. Monoid m => StaticSeq n m -> m
forall a. StaticSeq n a -> Bool
forall a. StaticSeq n a -> Int
forall a. StaticSeq n a -> [a]
forall a. (a -> a -> a) -> StaticSeq n a -> a
forall m a. Monoid m => (a -> m) -> StaticSeq n a -> m
forall b a. (b -> a -> b) -> b -> StaticSeq n a -> b
forall a b. (a -> b -> b) -> b -> StaticSeq n a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => StaticSeq n a -> a
$cproduct :: forall (n :: Nat) a. Num a => StaticSeq n a -> a
sum :: forall a. Num a => StaticSeq n a -> a
$csum :: forall (n :: Nat) a. Num a => StaticSeq n a -> a
minimum :: forall a. Ord a => StaticSeq n a -> a
$cminimum :: forall (n :: Nat) a. Ord a => StaticSeq n a -> a
maximum :: forall a. Ord a => StaticSeq n a -> a
$cmaximum :: forall (n :: Nat) a. Ord a => StaticSeq n a -> a
elem :: forall a. Eq a => a -> StaticSeq n a -> Bool
$celem :: forall (n :: Nat) a. Eq a => a -> StaticSeq n a -> Bool
length :: forall a. StaticSeq n a -> Int
$clength :: forall (n :: Nat) a. StaticSeq n a -> Int
null :: forall a. StaticSeq n a -> Bool
$cnull :: forall (n :: Nat) a. StaticSeq n a -> Bool
toList :: forall a. StaticSeq n a -> [a]
$ctoList :: forall (n :: Nat) a. StaticSeq n a -> [a]
foldl1 :: forall a. (a -> a -> a) -> StaticSeq n a -> a
$cfoldl1 :: forall (n :: Nat) a. (a -> a -> a) -> StaticSeq n a -> a
foldr1 :: forall a. (a -> a -> a) -> StaticSeq n a -> a
$cfoldr1 :: forall (n :: Nat) a. (a -> a -> a) -> StaticSeq n a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> StaticSeq n a -> b
$cfoldl' :: forall (n :: Nat) b a. (b -> a -> b) -> b -> StaticSeq n a -> b
foldl :: forall b a. (b -> a -> b) -> b -> StaticSeq n a -> b
$cfoldl :: forall (n :: Nat) b a. (b -> a -> b) -> b -> StaticSeq n a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> StaticSeq n a -> b
$cfoldr' :: forall (n :: Nat) a b. (a -> b -> b) -> b -> StaticSeq n a -> b
foldr :: forall a b. (a -> b -> b) -> b -> StaticSeq n a -> b
$cfoldr :: forall (n :: Nat) a b. (a -> b -> b) -> b -> StaticSeq n a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> StaticSeq n a -> m
$cfoldMap' :: forall (n :: Nat) m a. Monoid m => (a -> m) -> StaticSeq n a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> StaticSeq n a -> m
$cfoldMap :: forall (n :: Nat) m a. Monoid m => (a -> m) -> StaticSeq n a -> m
fold :: forall m. Monoid m => StaticSeq n m -> m
$cfold :: forall (n :: Nat) m. Monoid m => StaticSeq n m -> m
Foldable)
  deriving (StaticSeq n a -> ByteCount
forall (n :: Nat) a.
(KnownNat n, StaticByteSized a) =>
StaticSeq n a -> ByteCount
forall a. (a -> ByteCount) -> ByteSized a
byteSize :: StaticSeq n a -> ByteCount
$cbyteSize :: forall (n :: Nat) a.
(KnownNat n, StaticByteSized a) =>
StaticSeq n a -> ByteCount
ByteSized) via (ViaStaticByteSized (StaticSeq n a))

instance (KnownNat n, Default a) => Default (StaticSeq n a) where
  def :: StaticSeq n a
def = forall (n :: Nat) a. Seq a -> StaticSeq n a
StaticSeq (forall a. Int -> a -> Seq a
Seq.replicate (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall {k} (t :: k). Proxy t
Proxy :: Proxy n))) forall a. Default a => a
def)

instance (KnownNat n, StaticByteSized a) => StaticByteSized (StaticSeq n a) where
  staticByteSize :: Proxy (StaticSeq n a) -> ByteCount
staticByteSize Proxy (StaticSeq n a)
_ = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall {k} (t :: k). Proxy t
Proxy :: Proxy n)) forall a. Num a => a -> a -> a
* forall a. StaticByteSized a => Proxy a -> ByteCount
staticByteSize (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)

instance (KnownNat n, Binary a, StaticByteSized a, Default a) => Binary (StaticSeq n a) where
  get :: Get (StaticSeq n a)
get = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (n :: Nat) a. Seq a -> StaticSeq n a
StaticSeq (forall a. StaticByteSized a => ElementCount -> Get a -> Get (Seq a)
getStaticSeq (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall {k} (t :: k). Proxy t
Proxy :: Proxy n))) forall a. Binary a => Get a
get)
  put :: StaticSeq n a -> Put
put = forall a.
StaticByteSized a =>
ElementCount -> Maybe a -> (a -> Put) -> Seq a -> Put
unsafePutStaticSeqN (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall {k} (t :: k). Proxy t
Proxy :: Proxy n))) (forall a. a -> Maybe a
Just forall a. Default a => a
def) forall a. Binary a => a -> Put
put forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Nat) a. StaticSeq n a -> Seq a
unStaticSeq

newtype StaticArray (n :: Nat) a = StaticArray {forall (n :: Nat) a. StaticArray n a -> PrimArray a
unStaticArray :: PrimArray a}
  deriving stock (Int -> StaticArray n a -> ShowS
forall (n :: Nat) a.
(Show a, Prim a) =>
Int -> StaticArray n a -> ShowS
forall (n :: Nat) a. (Show a, Prim a) => [StaticArray n a] -> ShowS
forall (n :: Nat) a. (Show a, Prim a) => StaticArray n a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StaticArray n a] -> ShowS
$cshowList :: forall (n :: Nat) a. (Show a, Prim a) => [StaticArray n a] -> ShowS
show :: StaticArray n a -> String
$cshow :: forall (n :: Nat) a. (Show a, Prim a) => StaticArray n a -> String
showsPrec :: Int -> StaticArray n a -> ShowS
$cshowsPrec :: forall (n :: Nat) a.
(Show a, Prim a) =>
Int -> StaticArray n a -> ShowS
Show)
  deriving newtype (StaticArray n a -> StaticArray n a -> Bool
forall (n :: Nat) a.
(Eq a, Prim a) =>
StaticArray n a -> StaticArray n a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StaticArray n a -> StaticArray n a -> Bool
$c/= :: forall (n :: Nat) a.
(Eq a, Prim a) =>
StaticArray n a -> StaticArray n a -> Bool
== :: StaticArray n a -> StaticArray n a -> Bool
$c== :: forall (n :: Nat) a.
(Eq a, Prim a) =>
StaticArray n a -> StaticArray n a -> Bool
Eq)
  deriving (StaticArray n a -> ByteCount
forall (n :: Nat) a.
(KnownNat n, StaticByteSized a) =>
StaticArray n a -> ByteCount
forall a. (a -> ByteCount) -> ByteSized a
byteSize :: StaticArray n a -> ByteCount
$cbyteSize :: forall (n :: Nat) a.
(KnownNat n, StaticByteSized a) =>
StaticArray n a -> ByteCount
ByteSized) via (ViaStaticByteSized (StaticArray n a))

instance (KnownNat n, Prim a, Default a) => Default (StaticArray n a) where
  def :: StaticArray n a
def = forall (n :: Nat) a. PrimArray a -> StaticArray n a
StaticArray (forall a. Prim a => Int -> a -> PrimArray a
replicatePrimArray (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall {k} (t :: k). Proxy t
Proxy :: Proxy n))) forall a. Default a => a
def)

instance (KnownNat n, StaticByteSized a) => StaticByteSized (StaticArray n a) where
  staticByteSize :: Proxy (StaticArray n a) -> ByteCount
staticByteSize Proxy (StaticArray n a)
_ = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall {k} (t :: k). Proxy t
Proxy :: Proxy n)) forall a. Num a => a -> a -> a
* forall a. StaticByteSized a => Proxy a -> ByteCount
staticByteSize (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)

instance (KnownNat n, Prim a, StaticByteSized a, Default a) => Binary (StaticArray n a) where
  get :: Get (StaticArray n a)
get = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (n :: Nat) a. PrimArray a -> StaticArray n a
StaticArray (forall a.
(StaticByteSized a, Prim a) =>
ElementCount -> Get (PrimArray a)
getStaticArray (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall {k} (t :: k). Proxy t
Proxy :: Proxy n))))
  put :: StaticArray n a -> Put
put = forall a.
(StaticByteSized a, Prim a) =>
ElementCount -> Maybe a -> PrimArray a -> Put
unsafePutStaticArrayN (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall {k} (t :: k). Proxy t
Proxy :: Proxy n))) (forall a. a -> Maybe a
Just forall a. Default a => a
def) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Nat) a. StaticArray n a -> PrimArray a
unStaticArray

newtype BoolByte = BoolByte {BoolByte -> Bool
unBoolByte :: Bool}
  deriving stock (Int -> BoolByte -> ShowS
[BoolByte] -> ShowS
BoolByte -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BoolByte] -> ShowS
$cshowList :: [BoolByte] -> ShowS
show :: BoolByte -> String
$cshow :: BoolByte -> String
showsPrec :: Int -> BoolByte -> ShowS
$cshowsPrec :: Int -> BoolByte -> ShowS
Show)
  deriving newtype (BoolByte -> BoolByte -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BoolByte -> BoolByte -> Bool
$c/= :: BoolByte -> BoolByte -> Bool
== :: BoolByte -> BoolByte -> Bool
$c== :: BoolByte -> BoolByte -> Bool
Eq)
  deriving (BoolByte -> ByteCount
forall a. (a -> ByteCount) -> ByteSized a
byteSize :: BoolByte -> ByteCount
$cbyteSize :: BoolByte -> ByteCount
ByteSized) via (ViaStaticByteSized BoolByte)

instance Default BoolByte where
  def :: BoolByte
def = Bool -> BoolByte
BoolByte Bool
False

instance StaticByteSized BoolByte where
  staticByteSize :: Proxy BoolByte -> ByteCount
staticByteSize Proxy BoolByte
_ = ByteCount
1

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

newtype ExactBytes (s :: Symbol) = ExactBytes {forall (s :: Symbol). ExactBytes s -> ()
unExactBytes :: ()}
  deriving stock (Int -> ExactBytes s -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (s :: Symbol). Int -> ExactBytes s -> ShowS
forall (s :: Symbol). [ExactBytes s] -> ShowS
forall (s :: Symbol). ExactBytes s -> String
showList :: [ExactBytes s] -> ShowS
$cshowList :: forall (s :: Symbol). [ExactBytes s] -> ShowS
show :: ExactBytes s -> String
$cshow :: forall (s :: Symbol). ExactBytes s -> String
showsPrec :: Int -> ExactBytes s -> ShowS
$cshowsPrec :: forall (s :: Symbol). Int -> ExactBytes s -> ShowS
Show)
  deriving newtype (ExactBytes s -> ExactBytes s -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (s :: Symbol). ExactBytes s -> ExactBytes s -> Bool
/= :: ExactBytes s -> ExactBytes s -> Bool
$c/= :: forall (s :: Symbol). ExactBytes s -> ExactBytes s -> Bool
== :: ExactBytes s -> ExactBytes s -> Bool
$c== :: forall (s :: Symbol). ExactBytes s -> ExactBytes s -> Bool
Eq)
  deriving (ExactBytes s -> ByteCount
forall a. (a -> ByteCount) -> ByteSized a
forall (s :: Symbol). KnownSymbol s => ExactBytes s -> ByteCount
byteSize :: ExactBytes s -> ByteCount
$cbyteSize :: forall (s :: Symbol). KnownSymbol s => ExactBytes s -> ByteCount
ByteSized) via (ViaStaticByteSized (ExactBytes s))

instance Default (ExactBytes s) where
  def :: ExactBytes s
def = forall (s :: Symbol). () -> ExactBytes s
ExactBytes ()

instance KnownSymbol s => StaticByteSized (ExactBytes s) where
  staticByteSize :: Proxy (ExactBytes s) -> ByteCount
staticByteSize Proxy (ExactBytes s)
_ = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy :: Proxy s)))

instance KnownSymbol s => Binary (ExactBytes s) where
  get :: Get (ExactBytes s)
get = do
    let !s :: String
s = forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy :: Proxy s)
        !bc :: ByteCount
bc = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s)
        !bs :: ShortByteString
bs = [Word8] -> ShortByteString
BSS.pack (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Word8
c2w String
s)
    forall a. (Eq a, Show a) => String -> Get a -> a -> Get ()
getExpect String
s (ByteCount -> Get ShortByteString
getByteString ByteCount
bc) ShortByteString
bs
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! forall (s :: Symbol). () -> ExactBytes s
ExactBytes ()
  put :: ExactBytes s -> Put
put ExactBytes s
_ = do
    let !s :: String
s = forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy :: Proxy s)
    ShortByteString -> Put
putByteString ([Word8] -> ShortByteString
BSS.pack (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Word8
c2w String
s))