{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoStarIsType #-}
{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}

module Dahdit.Fancy
  ( TermBytes8 (..)
  , TermBytes16 (..)
  , 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.LiftedPrim (LiftedPrim)
import Dahdit.LiftedPrimArray (LiftedPrimArray, replicateLiftedPrimArray)
import Dahdit.Proxy (proxyForNatF)
import Dahdit.Sizes (ByteCount (..), StaticByteSized (..), byteSizeViaStatic)
import Data.ByteString.Internal (c2w)
import qualified Data.ByteString.Short as BSS
import Data.ByteString.Short.Internal (ShortByteString (..))
import Data.Coerce (coerce)
import Data.Default (Default (..))
import Data.Primitive.ByteArray (ByteArray (..), byteArrayFromListN)
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 (ConsSymbol, KnownNat, KnownSymbol, Nat, Symbol, natVal, symbolVal, type (*), type (+))

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

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

-- | Bytes terminated with null byte.
newtype TermBytes8 = TermBytes8 {TermBytes8 -> ShortByteString
unTermBytes8 :: ShortByteString}
  deriving stock (Int -> TermBytes8 -> ShowS
[TermBytes8] -> ShowS
TermBytes8 -> String
(Int -> TermBytes8 -> ShowS)
-> (TermBytes8 -> String)
-> ([TermBytes8] -> ShowS)
-> Show TermBytes8
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TermBytes8 -> ShowS
showsPrec :: Int -> TermBytes8 -> ShowS
$cshow :: TermBytes8 -> String
show :: TermBytes8 -> String
$cshowList :: [TermBytes8] -> ShowS
showList :: [TermBytes8] -> ShowS
Show)
  deriving newtype (TermBytes8 -> TermBytes8 -> Bool
(TermBytes8 -> TermBytes8 -> Bool)
-> (TermBytes8 -> TermBytes8 -> Bool) -> Eq TermBytes8
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TermBytes8 -> TermBytes8 -> Bool
== :: TermBytes8 -> TermBytes8 -> Bool
$c/= :: TermBytes8 -> TermBytes8 -> Bool
/= :: TermBytes8 -> TermBytes8 -> Bool
Eq, Eq TermBytes8
Eq TermBytes8 =>
(TermBytes8 -> TermBytes8 -> Ordering)
-> (TermBytes8 -> TermBytes8 -> Bool)
-> (TermBytes8 -> TermBytes8 -> Bool)
-> (TermBytes8 -> TermBytes8 -> Bool)
-> (TermBytes8 -> TermBytes8 -> Bool)
-> (TermBytes8 -> TermBytes8 -> TermBytes8)
-> (TermBytes8 -> TermBytes8 -> TermBytes8)
-> Ord TermBytes8
TermBytes8 -> TermBytes8 -> Bool
TermBytes8 -> TermBytes8 -> Ordering
TermBytes8 -> TermBytes8 -> TermBytes8
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
$ccompare :: TermBytes8 -> TermBytes8 -> Ordering
compare :: TermBytes8 -> TermBytes8 -> Ordering
$c< :: TermBytes8 -> TermBytes8 -> Bool
< :: TermBytes8 -> TermBytes8 -> Bool
$c<= :: TermBytes8 -> TermBytes8 -> Bool
<= :: TermBytes8 -> TermBytes8 -> Bool
$c> :: TermBytes8 -> TermBytes8 -> Bool
> :: TermBytes8 -> TermBytes8 -> Bool
$c>= :: TermBytes8 -> TermBytes8 -> Bool
>= :: TermBytes8 -> TermBytes8 -> Bool
$cmax :: TermBytes8 -> TermBytes8 -> TermBytes8
max :: TermBytes8 -> TermBytes8 -> TermBytes8
$cmin :: TermBytes8 -> TermBytes8 -> TermBytes8
min :: TermBytes8 -> TermBytes8 -> TermBytes8
Ord, String -> TermBytes8
(String -> TermBytes8) -> IsString TermBytes8
forall a. (String -> a) -> IsString a
$cfromString :: String -> TermBytes8
fromString :: String -> TermBytes8
IsString)

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

instance Binary TermBytes8 where
  byteSize :: TermBytes8 -> ByteCount
byteSize (TermBytes8 ShortByteString
sbs) = Int -> ByteCount
ByteCount (ShortByteString -> Int
BSS.length ShortByteString
sbs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

  get :: Get TermBytes8
get = do
    (ByteCount
i, [Word8]
acc) <- Get (ByteCount, [Word8])
getUntilNull
    let sbs :: ShortByteString
sbs = ByteCount -> [Word8] -> ShortByteString
mkSBS ByteCount
i [Word8]
acc
    TermBytes8 -> Get TermBytes8
forall a. a -> Get a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (ShortByteString -> TermBytes8
TermBytes8 ShortByteString
sbs)

  put :: TermBytes8 -> Put
put (TermBytes8 ShortByteString
sbs) = do
    ShortByteString -> Put
putByteString ShortByteString
sbs
    Word8 -> Put
putWord8 Word8
0

-- | 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 TermBytes16 = TermBytes16 {TermBytes16 -> ShortByteString
unTermBytes16 :: ShortByteString}
  deriving stock (Int -> TermBytes16 -> ShowS
[TermBytes16] -> ShowS
TermBytes16 -> String
(Int -> TermBytes16 -> ShowS)
-> (TermBytes16 -> String)
-> ([TermBytes16] -> ShowS)
-> Show TermBytes16
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TermBytes16 -> ShowS
showsPrec :: Int -> TermBytes16 -> ShowS
$cshow :: TermBytes16 -> String
show :: TermBytes16 -> String
$cshowList :: [TermBytes16] -> ShowS
showList :: [TermBytes16] -> ShowS
Show)
  deriving newtype (TermBytes16 -> TermBytes16 -> Bool
(TermBytes16 -> TermBytes16 -> Bool)
-> (TermBytes16 -> TermBytes16 -> Bool) -> Eq TermBytes16
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TermBytes16 -> TermBytes16 -> Bool
== :: TermBytes16 -> TermBytes16 -> Bool
$c/= :: TermBytes16 -> TermBytes16 -> Bool
/= :: TermBytes16 -> TermBytes16 -> Bool
Eq, Eq TermBytes16
Eq TermBytes16 =>
(TermBytes16 -> TermBytes16 -> Ordering)
-> (TermBytes16 -> TermBytes16 -> Bool)
-> (TermBytes16 -> TermBytes16 -> Bool)
-> (TermBytes16 -> TermBytes16 -> Bool)
-> (TermBytes16 -> TermBytes16 -> Bool)
-> (TermBytes16 -> TermBytes16 -> TermBytes16)
-> (TermBytes16 -> TermBytes16 -> TermBytes16)
-> Ord TermBytes16
TermBytes16 -> TermBytes16 -> Bool
TermBytes16 -> TermBytes16 -> Ordering
TermBytes16 -> TermBytes16 -> TermBytes16
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
$ccompare :: TermBytes16 -> TermBytes16 -> Ordering
compare :: TermBytes16 -> TermBytes16 -> Ordering
$c< :: TermBytes16 -> TermBytes16 -> Bool
< :: TermBytes16 -> TermBytes16 -> Bool
$c<= :: TermBytes16 -> TermBytes16 -> Bool
<= :: TermBytes16 -> TermBytes16 -> Bool
$c> :: TermBytes16 -> TermBytes16 -> Bool
> :: TermBytes16 -> TermBytes16 -> Bool
$c>= :: TermBytes16 -> TermBytes16 -> Bool
>= :: TermBytes16 -> TermBytes16 -> Bool
$cmax :: TermBytes16 -> TermBytes16 -> TermBytes16
max :: TermBytes16 -> TermBytes16 -> TermBytes16
$cmin :: TermBytes16 -> TermBytes16 -> TermBytes16
min :: TermBytes16 -> TermBytes16 -> TermBytes16
Ord, String -> TermBytes16
(String -> TermBytes16) -> IsString TermBytes16
forall a. (String -> a) -> IsString a
$cfromString :: String -> TermBytes16
fromString :: String -> TermBytes16
IsString)

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

instance Binary TermBytes16 where
  byteSize :: TermBytes16 -> ByteCount
byteSize (TermBytes16 ShortByteString
sbs) =
    let bc :: ByteCount
bc = Int -> ByteCount
ByteCount (ShortByteString -> Int
BSS.length ShortByteString
sbs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    in  if ByteCount -> Bool
forall a. Integral a => a -> Bool
even ByteCount
bc then ByteCount
bc else ByteCount
bc ByteCount -> ByteCount -> ByteCount
forall a. Num a => a -> a -> a
+ ByteCount
1

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

  put :: TermBytes16 -> Put
put (TermBytes16 ShortByteString
sbs) = do
    ShortByteString -> Put
putByteString ShortByteString
sbs
    Word8 -> Put
putWord8 Word8
0
    Bool -> Put -> Put
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
unless (Int -> Bool
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
[StaticBytes n] -> ShowS
StaticBytes n -> String
(Int -> StaticBytes n -> ShowS)
-> (StaticBytes n -> String)
-> ([StaticBytes n] -> ShowS)
-> Show (StaticBytes n)
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
$cshowsPrec :: forall (n :: Nat). Int -> StaticBytes n -> ShowS
showsPrec :: Int -> StaticBytes n -> ShowS
$cshow :: forall (n :: Nat). StaticBytes n -> String
show :: StaticBytes n -> String
$cshowList :: forall (n :: Nat). [StaticBytes n] -> ShowS
showList :: [StaticBytes n] -> ShowS
Show)
  deriving newtype (String -> StaticBytes n
(String -> StaticBytes n) -> IsString (StaticBytes n)
forall (n :: Nat). String -> StaticBytes n
forall a. (String -> a) -> IsString a
$cfromString :: forall (n :: Nat). String -> StaticBytes n
fromString :: String -> StaticBytes n
IsString)

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 = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> Type).
KnownNat n =>
proxy n -> Integer
natVal Proxy n
prox)
  in  if ShortByteString -> Int
BSS.length ShortByteString
sbs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n
        then ShortByteString -> StaticBytes n
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  ShortByteString -> StaticBytes n
forall (n :: Nat). ShortByteString -> StaticBytes n
StaticBytes (ShortByteString -> StaticBytes n)
-> ShortByteString -> StaticBytes n
forall a b. (a -> b) -> a -> b
$
                if Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n
                  then ShortByteString
x1
                  else ShortByteString
x1 ShortByteString -> ShortByteString -> ShortByteString
forall a. Semigroup a => a -> a -> a
<> Int -> Word8 -> ShortByteString
BSS.replicate (Int
n Int -> Int -> Int
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) = Proxy n -> ShortByteString -> StaticBytes n
forall (n :: Nat).
KnownNat n =>
Proxy n -> ShortByteString -> StaticBytes n
mkStaticBytes (StaticBytes n -> Proxy n
forall (n :: Nat) (f :: Nat -> Type). 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' = StaticBytes n -> StaticBytes n
forall (n :: Nat). KnownNat n => StaticBytes n -> StaticBytes n
normStaticBytes StaticBytes n
x
        StaticBytes ShortByteString
y' = StaticBytes n -> StaticBytes n
forall (n :: Nat). KnownNat n => StaticBytes n -> StaticBytes n
normStaticBytes StaticBytes n
y
    in  ShortByteString
x' ShortByteString -> ShortByteString -> Bool
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' = StaticBytes n -> StaticBytes n
forall (n :: Nat). KnownNat n => StaticBytes n -> StaticBytes n
normStaticBytes StaticBytes n
x
        StaticBytes ShortByteString
y' = StaticBytes n -> StaticBytes n
forall (n :: Nat). KnownNat n => StaticBytes n -> StaticBytes n
normStaticBytes StaticBytes n
y
    in  ShortByteString -> ShortByteString -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ShortByteString
x' ShortByteString
y'

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

instance (KnownNat n) => StaticByteSized (StaticBytes n) where
  type StaticSize (StaticBytes n) = n

instance (KnownNat n) => Binary (StaticBytes n) where
  byteSize :: StaticBytes n -> ByteCount
byteSize = StaticBytes n -> ByteCount
forall a. StaticByteSized a => a -> ByteCount
byteSizeViaStatic
  get :: Get (StaticBytes n)
get = (ShortByteString -> StaticBytes n)
-> Get ShortByteString -> Get (StaticBytes n)
forall a b. (a -> b) -> Get a -> Get b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ShortByteString -> StaticBytes n
forall (n :: Nat). ShortByteString -> StaticBytes n
StaticBytes (ByteCount -> Get ShortByteString
getByteString (Integer -> ByteCount
forall a. Num a => Integer -> a
fromInteger (Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> Type).
KnownNat n =>
proxy n -> Integer
natVal (Proxy n
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 (Integer -> ByteCount
forall a. Num a => Integer -> a
fromInteger (StaticBytes n -> Integer
forall (n :: Nat) (proxy :: Nat -> Type).
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
[StaticSeq n a] -> ShowS
StaticSeq n a -> String
(Int -> StaticSeq n a -> ShowS)
-> (StaticSeq n a -> String)
-> ([StaticSeq n a] -> ShowS)
-> Show (StaticSeq n a)
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
$cshowsPrec :: forall (n :: Nat) a. Show a => Int -> StaticSeq n a -> ShowS
showsPrec :: Int -> StaticSeq n a -> ShowS
$cshow :: forall (n :: Nat) a. Show a => StaticSeq n a -> String
show :: StaticSeq n a -> String
$cshowList :: forall (n :: Nat) a. Show a => [StaticSeq n a] -> ShowS
showList :: [StaticSeq n a] -> ShowS
Show)
  deriving newtype (StaticSeq n a -> StaticSeq n a -> Bool
(StaticSeq n a -> StaticSeq n a -> Bool)
-> (StaticSeq n a -> StaticSeq n a -> Bool) -> Eq (StaticSeq n a)
forall (n :: Nat) a. Eq a => StaticSeq n a -> StaticSeq n a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$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
/= :: StaticSeq n a -> StaticSeq n a -> Bool
Eq, (forall a b. (a -> b) -> StaticSeq n a -> StaticSeq n b)
-> (forall a b. a -> StaticSeq n b -> StaticSeq n a)
-> Functor (StaticSeq n)
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 :: Type -> Type).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (n :: Nat) a b. (a -> b) -> StaticSeq n a -> StaticSeq n b
fmap :: forall a b. (a -> b) -> StaticSeq n a -> StaticSeq n b
$c<$ :: forall (n :: Nat) a b. a -> StaticSeq n b -> StaticSeq n a
<$ :: forall a b. a -> StaticSeq n b -> StaticSeq n a
Functor, (forall m. Monoid m => StaticSeq n m -> m)
-> (forall m a. Monoid m => (a -> m) -> StaticSeq n a -> m)
-> (forall m a. Monoid m => (a -> m) -> StaticSeq n a -> m)
-> (forall a b. (a -> b -> b) -> b -> StaticSeq n a -> b)
-> (forall a b. (a -> b -> b) -> b -> StaticSeq n a -> b)
-> (forall b a. (b -> a -> b) -> b -> StaticSeq n a -> b)
-> (forall b a. (b -> a -> b) -> b -> StaticSeq n a -> b)
-> (forall a. (a -> a -> a) -> StaticSeq n a -> a)
-> (forall a. (a -> a -> a) -> StaticSeq n a -> a)
-> (forall a. StaticSeq n a -> [a])
-> (forall a. StaticSeq n a -> Bool)
-> (forall a. StaticSeq n a -> Int)
-> (forall a. Eq a => a -> StaticSeq n a -> Bool)
-> (forall a. Ord a => StaticSeq n a -> a)
-> (forall a. Ord a => StaticSeq n a -> a)
-> (forall a. Num a => StaticSeq n a -> a)
-> (forall a. Num a => StaticSeq n a -> a)
-> Foldable (StaticSeq n)
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 :: Type -> Type).
(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
$cfold :: forall (n :: Nat) m. Monoid m => StaticSeq n m -> m
fold :: forall m. Monoid m => StaticSeq n m -> 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
foldMap' :: forall m a. Monoid m => (a -> m) -> StaticSeq n a -> m
$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
foldr' :: forall a b. (a -> b -> 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
foldl' :: forall b a. (b -> a -> b) -> b -> StaticSeq n a -> b
$cfoldr1 :: forall (n :: Nat) a. (a -> a -> a) -> StaticSeq n a -> a
foldr1 :: forall a. (a -> a -> a) -> StaticSeq n a -> a
$cfoldl1 :: forall (n :: Nat) a. (a -> a -> a) -> StaticSeq n a -> a
foldl1 :: forall a. (a -> a -> a) -> StaticSeq n a -> a
$ctoList :: forall (n :: Nat) a. StaticSeq n a -> [a]
toList :: forall a. StaticSeq n a -> [a]
$cnull :: forall (n :: Nat) a. StaticSeq n a -> Bool
null :: forall a. StaticSeq n a -> Bool
$clength :: forall (n :: Nat) a. StaticSeq n a -> Int
length :: forall a. StaticSeq n a -> Int
$celem :: forall (n :: Nat) a. Eq a => a -> StaticSeq n a -> Bool
elem :: forall a. Eq a => a -> StaticSeq n a -> Bool
$cmaximum :: forall (n :: Nat) a. Ord a => StaticSeq n a -> a
maximum :: forall a. Ord a => StaticSeq n a -> a
$cminimum :: forall (n :: Nat) a. Ord a => StaticSeq n a -> a
minimum :: forall a. Ord a => StaticSeq n a -> a
$csum :: forall (n :: Nat) a. Num a => StaticSeq n a -> a
sum :: forall a. Num a => StaticSeq n a -> a
$cproduct :: forall (n :: Nat) a. Num a => StaticSeq n a -> a
product :: forall a. Num a => StaticSeq n a -> a
Foldable)

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

instance (KnownNat n, StaticByteSized a) => StaticByteSized (StaticSeq n a) where
  type StaticSize (StaticSeq n a) = n * StaticSize a

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

newtype StaticArray (n :: Nat) a = StaticArray {forall (n :: Nat) a. StaticArray n a -> LiftedPrimArray a
unStaticArray :: LiftedPrimArray a}
  deriving stock (Int -> StaticArray n a -> ShowS
[StaticArray n a] -> ShowS
StaticArray n a -> String
(Int -> StaticArray n a -> ShowS)
-> (StaticArray n a -> String)
-> ([StaticArray n a] -> ShowS)
-> Show (StaticArray n a)
forall (n :: Nat) a. Int -> StaticArray n a -> ShowS
forall (n :: Nat) a. [StaticArray n a] -> ShowS
forall (n :: Nat) a. StaticArray n a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall (n :: Nat) a. Int -> StaticArray n a -> ShowS
showsPrec :: Int -> StaticArray n a -> ShowS
$cshow :: forall (n :: Nat) a. StaticArray n a -> String
show :: StaticArray n a -> String
$cshowList :: forall (n :: Nat) a. [StaticArray n a] -> ShowS
showList :: [StaticArray n a] -> ShowS
Show)
  deriving newtype (StaticArray n a -> StaticArray n a -> Bool
(StaticArray n a -> StaticArray n a -> Bool)
-> (StaticArray n a -> StaticArray n a -> Bool)
-> Eq (StaticArray n a)
forall (n :: Nat) a. StaticArray n a -> StaticArray n a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall (n :: Nat) a. StaticArray n a -> StaticArray n a -> Bool
== :: StaticArray n a -> StaticArray n a -> Bool
$c/= :: forall (n :: Nat) a. StaticArray n a -> StaticArray n a -> Bool
/= :: StaticArray n a -> StaticArray n a -> Bool
Eq)

instance (KnownNat n, LiftedPrim a, Default a) => Default (StaticArray n a) where
  def :: StaticArray n a
def = LiftedPrimArray a -> StaticArray n a
forall (n :: Nat) a. LiftedPrimArray a -> StaticArray n a
StaticArray (ElemCount -> a -> LiftedPrimArray a
forall a. LiftedPrim a => ElemCount -> a -> LiftedPrimArray a
replicateLiftedPrimArray (Integer -> ElemCount
forall a. Num a => Integer -> a
fromInteger (Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> Type).
KnownNat n =>
proxy n -> Integer
natVal (Proxy n
forall {k} (t :: k). Proxy t
Proxy :: Proxy n))) a
forall a. Default a => a
def)

instance (KnownNat n, StaticByteSized a) => StaticByteSized (StaticArray n a) where
  type StaticSize (StaticArray n a) = n * StaticSize a

instance (KnownNat n, LiftedPrim a, Default a) => Binary (StaticArray n a) where
  byteSize :: StaticArray n a -> ByteCount
byteSize = StaticArray n a -> ByteCount
forall a. StaticByteSized a => a -> ByteCount
byteSizeViaStatic
  get :: Get (StaticArray n a)
get = (LiftedPrimArray a -> StaticArray n a)
-> Get (LiftedPrimArray a) -> Get (StaticArray n a)
forall a b. (a -> b) -> Get a -> Get b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap LiftedPrimArray a -> StaticArray n a
forall (n :: Nat) a. LiftedPrimArray a -> StaticArray n a
StaticArray (ElemCount -> Get (LiftedPrimArray a)
forall a. LiftedPrim a => ElemCount -> Get (LiftedPrimArray a)
getStaticArray (Integer -> ElemCount
forall a. Num a => Integer -> a
fromInteger (Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> Type).
KnownNat n =>
proxy n -> Integer
natVal (Proxy n
forall {k} (t :: k). Proxy t
Proxy :: Proxy n))))
  put :: StaticArray n a -> Put
put = ElemCount -> Maybe a -> LiftedPrimArray a -> Put
forall a.
LiftedPrim a =>
ElemCount -> Maybe a -> LiftedPrimArray a -> Put
unsafePutStaticArrayN (Integer -> ElemCount
forall a. Num a => Integer -> a
fromInteger (Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> Type).
KnownNat n =>
proxy n -> Integer
natVal (Proxy n
forall {k} (t :: k). Proxy t
Proxy :: Proxy n))) (a -> Maybe a
forall a. a -> Maybe a
Just a
forall a. Default a => a
def) (LiftedPrimArray a -> Put)
-> (StaticArray n a -> LiftedPrimArray a) -> StaticArray n a -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StaticArray n a -> LiftedPrimArray a
forall (n :: Nat) a. StaticArray n a -> LiftedPrimArray a
unStaticArray

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

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

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

instance Binary BoolByte where
  byteSize :: BoolByte -> ByteCount
byteSize = BoolByte -> ByteCount
forall a. StaticByteSized a => a -> ByteCount
byteSizeViaStatic
  get :: Get BoolByte
get = (Word8 -> BoolByte) -> Get Word8 -> Get BoolByte
forall a b. (a -> b) -> Get a -> Get b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> BoolByte
BoolByte (Bool -> BoolByte) -> (Word8 -> Bool) -> Word8 -> BoolByte
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Word8 -> Bool
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 (n :: Nat) (s :: Symbol) = ExactBytes {forall (n :: Nat) (s :: Symbol). ExactBytes n s -> ()
unExactBytes :: ()}
  deriving stock (Int -> ExactBytes n s -> ShowS
[ExactBytes n s] -> ShowS
ExactBytes n s -> String
(Int -> ExactBytes n s -> ShowS)
-> (ExactBytes n s -> String)
-> ([ExactBytes n s] -> ShowS)
-> Show (ExactBytes n s)
forall (n :: Nat) (s :: Symbol). Int -> ExactBytes n s -> ShowS
forall (n :: Nat) (s :: Symbol). [ExactBytes n s] -> ShowS
forall (n :: Nat) (s :: Symbol). ExactBytes n s -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall (n :: Nat) (s :: Symbol). Int -> ExactBytes n s -> ShowS
showsPrec :: Int -> ExactBytes n s -> ShowS
$cshow :: forall (n :: Nat) (s :: Symbol). ExactBytes n s -> String
show :: ExactBytes n s -> String
$cshowList :: forall (n :: Nat) (s :: Symbol). [ExactBytes n s] -> ShowS
showList :: [ExactBytes n s] -> ShowS
Show)
  deriving newtype (ExactBytes n s -> ExactBytes n s -> Bool
(ExactBytes n s -> ExactBytes n s -> Bool)
-> (ExactBytes n s -> ExactBytes n s -> Bool)
-> Eq (ExactBytes n s)
forall (n :: Nat) (s :: Symbol).
ExactBytes n s -> ExactBytes n s -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall (n :: Nat) (s :: Symbol).
ExactBytes n s -> ExactBytes n s -> Bool
== :: ExactBytes n s -> ExactBytes n s -> Bool
$c/= :: forall (n :: Nat) (s :: Symbol).
ExactBytes n s -> ExactBytes n s -> Bool
/= :: ExactBytes n s -> ExactBytes n s -> Bool
Eq)

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

class SymLen (n :: Nat) (s :: Symbol) | s -> n

instance {-# OVERLAPPING #-} SymLen 0 ""

instance (SymLen n s, m ~ n + 1, t ~ ConsSymbol c s) => SymLen m t

instance (SymLen n s, KnownSymbol s, KnownNat n) => StaticByteSized (ExactBytes n s) where
  type StaticSize (ExactBytes n s) = n

instance (SymLen n s, KnownSymbol s, KnownNat n) => Binary (ExactBytes n s) where
  byteSize :: ExactBytes n s -> ByteCount
byteSize = ExactBytes n s -> ByteCount
forall a. StaticByteSized a => a -> ByteCount
byteSizeViaStatic
  get :: Get (ExactBytes n s)
get = do
    let s :: String
s = Proxy s -> String
forall (n :: Symbol) (proxy :: Symbol -> Type).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy s
forall {k} (t :: k). Proxy t
Proxy :: Proxy s)
        bc :: ByteCount
bc = Int -> ByteCount
forall a b. Coercible a b => a -> b
coerce (String -> Int
forall a. [a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length String
s)
        bs :: ShortByteString
bs = [Word8] -> ShortByteString
BSS.pack ((Char -> Word8) -> String -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Word8
c2w String
s)
    String -> Get ShortByteString -> ShortByteString -> Get ()
forall a. (Eq a, Show a) => String -> Get a -> a -> Get ()
getExpect String
s (ByteCount -> Get ShortByteString
getByteString ByteCount
bc) ShortByteString
bs
    ExactBytes n s -> Get (ExactBytes n s)
forall a. a -> Get a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (() -> ExactBytes n s
forall (n :: Nat) (s :: Symbol). () -> ExactBytes n s
ExactBytes ())
  put :: ExactBytes n s -> Put
put ExactBytes n s
_ = do
    let s :: String
s = Proxy s -> String
forall (n :: Symbol) (proxy :: Symbol -> Type).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy s
forall {k} (t :: k). Proxy t
Proxy :: Proxy s)
    ShortByteString -> Put
putByteString ([Word8] -> ShortByteString
BSS.pack ((Char -> Word8) -> String -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Word8
c2w String
s))