{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE UndecidableInstances #-}

module Dahdit.Midi.Osc where

import Control.Monad (replicateM_)
import Dahdit
  ( Binary (..)
  , ByteCount (..)
  , DoubleBE (..)
  , FloatBE (..)
  , Get
  , Int32BE (..)
  , Int64BE (..)
  , Put
  , StaticByteSized (..)
  , TermBytes8 (..)
  , Word32BE
  , Word64BE (..)
  , byteSizeFoldable
  , byteSizeViaStatic
  , getByteString
  , getExact
  , getExpect
  , getLookAhead
  , getRemainingSeq
  , getRemainingSize
  , putByteString
  )
import Dahdit.Midi.Binary (getTermText, putTermText)
import Dahdit.Midi.Midi (ShortMsg)
import Dahdit.Midi.OscAddr (RawAddrPat (..))
import Dahdit.Midi.Pad (byteSizePad32, getPad32, pad32, putPad32)
import Data.ByteString.Internal (c2w, w2c)
import Data.ByteString.Short (ShortByteString)
import Data.ByteString.Short qualified as BSS
import Data.Coerce (coerce)
import Data.Foldable (foldMap', for_)
import Data.Int (Int32, Int64)
import Data.Monoid (Sum (..))
import Data.Sequence (Seq (..))
import Data.Sequence qualified as Seq
import Data.Text (Text)
import Data.Text qualified as T
import Data.Word (Word8)
import GHC.Generics (Generic)
import Nanotime (NtpTime (..))

data DatumType
  = DatumTypeInt32
  | DatumTypeInt64
  | DatumTypeFloat
  | DatumTypeDouble
  | DatumTypeString
  | DatumTypeBlob
  | DatumTypeTime
  | DatumTypeMidi
  deriving stock (DatumType -> DatumType -> Bool
(DatumType -> DatumType -> Bool)
-> (DatumType -> DatumType -> Bool) -> Eq DatumType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DatumType -> DatumType -> Bool
== :: DatumType -> DatumType -> Bool
$c/= :: DatumType -> DatumType -> Bool
/= :: DatumType -> DatumType -> Bool
Eq, Eq DatumType
Eq DatumType =>
(DatumType -> DatumType -> Ordering)
-> (DatumType -> DatumType -> Bool)
-> (DatumType -> DatumType -> Bool)
-> (DatumType -> DatumType -> Bool)
-> (DatumType -> DatumType -> Bool)
-> (DatumType -> DatumType -> DatumType)
-> (DatumType -> DatumType -> DatumType)
-> Ord DatumType
DatumType -> DatumType -> Bool
DatumType -> DatumType -> Ordering
DatumType -> DatumType -> DatumType
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 :: DatumType -> DatumType -> Ordering
compare :: DatumType -> DatumType -> Ordering
$c< :: DatumType -> DatumType -> Bool
< :: DatumType -> DatumType -> Bool
$c<= :: DatumType -> DatumType -> Bool
<= :: DatumType -> DatumType -> Bool
$c> :: DatumType -> DatumType -> Bool
> :: DatumType -> DatumType -> Bool
$c>= :: DatumType -> DatumType -> Bool
>= :: DatumType -> DatumType -> Bool
$cmax :: DatumType -> DatumType -> DatumType
max :: DatumType -> DatumType -> DatumType
$cmin :: DatumType -> DatumType -> DatumType
min :: DatumType -> DatumType -> DatumType
Ord, Int -> DatumType -> ShowS
[DatumType] -> ShowS
DatumType -> String
(Int -> DatumType -> ShowS)
-> (DatumType -> String)
-> ([DatumType] -> ShowS)
-> Show DatumType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DatumType -> ShowS
showsPrec :: Int -> DatumType -> ShowS
$cshow :: DatumType -> String
show :: DatumType -> String
$cshowList :: [DatumType] -> ShowS
showList :: [DatumType] -> ShowS
Show, Int -> DatumType
DatumType -> Int
DatumType -> [DatumType]
DatumType -> DatumType
DatumType -> DatumType -> [DatumType]
DatumType -> DatumType -> DatumType -> [DatumType]
(DatumType -> DatumType)
-> (DatumType -> DatumType)
-> (Int -> DatumType)
-> (DatumType -> Int)
-> (DatumType -> [DatumType])
-> (DatumType -> DatumType -> [DatumType])
-> (DatumType -> DatumType -> [DatumType])
-> (DatumType -> DatumType -> DatumType -> [DatumType])
-> Enum DatumType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: DatumType -> DatumType
succ :: DatumType -> DatumType
$cpred :: DatumType -> DatumType
pred :: DatumType -> DatumType
$ctoEnum :: Int -> DatumType
toEnum :: Int -> DatumType
$cfromEnum :: DatumType -> Int
fromEnum :: DatumType -> Int
$cenumFrom :: DatumType -> [DatumType]
enumFrom :: DatumType -> [DatumType]
$cenumFromThen :: DatumType -> DatumType -> [DatumType]
enumFromThen :: DatumType -> DatumType -> [DatumType]
$cenumFromTo :: DatumType -> DatumType -> [DatumType]
enumFromTo :: DatumType -> DatumType -> [DatumType]
$cenumFromThenTo :: DatumType -> DatumType -> DatumType -> [DatumType]
enumFromThenTo :: DatumType -> DatumType -> DatumType -> [DatumType]
Enum, DatumType
DatumType -> DatumType -> Bounded DatumType
forall a. a -> a -> Bounded a
$cminBound :: DatumType
minBound :: DatumType
$cmaxBound :: DatumType
maxBound :: DatumType
Bounded)

datumTypeRep :: DatumType -> Char
datumTypeRep :: DatumType -> Char
datumTypeRep = \case
  DatumType
DatumTypeInt32 -> Char
'i'
  DatumType
DatumTypeInt64 -> Char
'h'
  DatumType
DatumTypeFloat -> Char
'f'
  DatumType
DatumTypeDouble -> Char
'd'
  DatumType
DatumTypeString -> Char
's'
  DatumType
DatumTypeBlob -> Char
'b'
  DatumType
DatumTypeTime -> Char
't'
  DatumType
DatumTypeMidi -> Char
'm'

datumTypeUnRep :: Char -> Maybe DatumType
datumTypeUnRep :: Char -> Maybe DatumType
datumTypeUnRep = \case
  Char
'i' -> DatumType -> Maybe DatumType
forall a. a -> Maybe a
Just DatumType
DatumTypeInt32
  Char
'h' -> DatumType -> Maybe DatumType
forall a. a -> Maybe a
Just DatumType
DatumTypeInt64
  Char
'f' -> DatumType -> Maybe DatumType
forall a. a -> Maybe a
Just DatumType
DatumTypeFloat
  Char
'd' -> DatumType -> Maybe DatumType
forall a. a -> Maybe a
Just DatumType
DatumTypeDouble
  Char
's' -> DatumType -> Maybe DatumType
forall a. a -> Maybe a
Just DatumType
DatumTypeString
  Char
'b' -> DatumType -> Maybe DatumType
forall a. a -> Maybe a
Just DatumType
DatumTypeBlob
  Char
't' -> DatumType -> Maybe DatumType
forall a. a -> Maybe a
Just DatumType
DatumTypeTime
  Char
'm' -> DatumType -> Maybe DatumType
forall a. a -> Maybe a
Just DatumType
DatumTypeMidi
  Char
_ -> Maybe DatumType
forall a. Maybe a
Nothing

newtype Port = Port {Port -> Word8
unPort :: Word8}
  deriving stock (Int -> Port -> ShowS
[Port] -> ShowS
Port -> String
(Int -> Port -> ShowS)
-> (Port -> String) -> ([Port] -> ShowS) -> Show Port
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Port -> ShowS
showsPrec :: Int -> Port -> ShowS
$cshow :: Port -> String
show :: Port -> String
$cshowList :: [Port] -> ShowS
showList :: [Port] -> ShowS
Show)
  deriving newtype (Port -> Port -> Bool
(Port -> Port -> Bool) -> (Port -> Port -> Bool) -> Eq Port
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Port -> Port -> Bool
== :: Port -> Port -> Bool
$c/= :: Port -> Port -> Bool
/= :: Port -> Port -> Bool
Eq, Eq Port
Eq Port =>
(Port -> Port -> Ordering)
-> (Port -> Port -> Bool)
-> (Port -> Port -> Bool)
-> (Port -> Port -> Bool)
-> (Port -> Port -> Bool)
-> (Port -> Port -> Port)
-> (Port -> Port -> Port)
-> Ord Port
Port -> Port -> Bool
Port -> Port -> Ordering
Port -> Port -> Port
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 :: Port -> Port -> Ordering
compare :: Port -> Port -> Ordering
$c< :: Port -> Port -> Bool
< :: Port -> Port -> Bool
$c<= :: Port -> Port -> Bool
<= :: Port -> Port -> Bool
$c> :: Port -> Port -> Bool
> :: Port -> Port -> Bool
$c>= :: Port -> Port -> Bool
>= :: Port -> Port -> Bool
$cmax :: Port -> Port -> Port
max :: Port -> Port -> Port
$cmin :: Port -> Port -> Port
min :: Port -> Port -> Port
Ord, Get Port
Port -> ByteCount
Port -> Put
(Port -> ByteCount) -> Get Port -> (Port -> Put) -> Binary Port
forall a. (a -> ByteCount) -> Get a -> (a -> Put) -> Binary a
$cbyteSize :: Port -> ByteCount
byteSize :: Port -> ByteCount
$cget :: Get Port
get :: Get Port
$cput :: Port -> Put
put :: Port -> Put
Binary, KnownNat (StaticSize Port)
KnownNat (StaticSize Port) =>
(Proxy Port -> ByteCount) -> StaticByteSized Port
Proxy Port -> ByteCount
forall a.
KnownNat (StaticSize a) =>
(Proxy a -> ByteCount) -> StaticByteSized a
$cstaticByteSize :: Proxy Port -> ByteCount
staticByteSize :: Proxy Port -> ByteCount
StaticByteSized)

data PortMsg = PortMsg !Port !ShortMsg
  deriving stock (PortMsg -> PortMsg -> Bool
(PortMsg -> PortMsg -> Bool)
-> (PortMsg -> PortMsg -> Bool) -> Eq PortMsg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PortMsg -> PortMsg -> Bool
== :: PortMsg -> PortMsg -> Bool
$c/= :: PortMsg -> PortMsg -> Bool
/= :: PortMsg -> PortMsg -> Bool
Eq, Eq PortMsg
Eq PortMsg =>
(PortMsg -> PortMsg -> Ordering)
-> (PortMsg -> PortMsg -> Bool)
-> (PortMsg -> PortMsg -> Bool)
-> (PortMsg -> PortMsg -> Bool)
-> (PortMsg -> PortMsg -> Bool)
-> (PortMsg -> PortMsg -> PortMsg)
-> (PortMsg -> PortMsg -> PortMsg)
-> Ord PortMsg
PortMsg -> PortMsg -> Bool
PortMsg -> PortMsg -> Ordering
PortMsg -> PortMsg -> PortMsg
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 :: PortMsg -> PortMsg -> Ordering
compare :: PortMsg -> PortMsg -> Ordering
$c< :: PortMsg -> PortMsg -> Bool
< :: PortMsg -> PortMsg -> Bool
$c<= :: PortMsg -> PortMsg -> Bool
<= :: PortMsg -> PortMsg -> Bool
$c> :: PortMsg -> PortMsg -> Bool
> :: PortMsg -> PortMsg -> Bool
$c>= :: PortMsg -> PortMsg -> Bool
>= :: PortMsg -> PortMsg -> Bool
$cmax :: PortMsg -> PortMsg -> PortMsg
max :: PortMsg -> PortMsg -> PortMsg
$cmin :: PortMsg -> PortMsg -> PortMsg
min :: PortMsg -> PortMsg -> PortMsg
Ord, Int -> PortMsg -> ShowS
[PortMsg] -> ShowS
PortMsg -> String
(Int -> PortMsg -> ShowS)
-> (PortMsg -> String) -> ([PortMsg] -> ShowS) -> Show PortMsg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PortMsg -> ShowS
showsPrec :: Int -> PortMsg -> ShowS
$cshow :: PortMsg -> String
show :: PortMsg -> String
$cshowList :: [PortMsg] -> ShowS
showList :: [PortMsg] -> ShowS
Show, (forall x. PortMsg -> Rep PortMsg x)
-> (forall x. Rep PortMsg x -> PortMsg) -> Generic PortMsg
forall x. Rep PortMsg x -> PortMsg
forall x. PortMsg -> Rep PortMsg x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PortMsg -> Rep PortMsg x
from :: forall x. PortMsg -> Rep PortMsg x
$cto :: forall x. Rep PortMsg x -> PortMsg
to :: forall x. Rep PortMsg x -> PortMsg
Generic)

instance StaticByteSized PortMsg where
  type StaticSize PortMsg = 4
  staticByteSize :: Proxy PortMsg -> ByteCount
staticByteSize Proxy PortMsg
_ = ByteCount
4

instance Binary PortMsg where
  byteSize :: PortMsg -> ByteCount
byteSize = PortMsg -> ByteCount
forall a. StaticByteSized a => a -> ByteCount
byteSizeViaStatic
  get :: Get PortMsg
get = do
    Port
p <- Get Port
forall a. Binary a => Get a
get
    ShortMsg
m <- Get ShortMsg
forall a. Binary a => Get a
get
    Int -> Get () -> Get ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteCount -> Int
unByteCount (ShortMsg -> ByteCount
forall a. Binary a => a -> ByteCount
byteSize ShortMsg
m)) (String -> Get Word8 -> Word8 -> Get ()
forall a. (Eq a, Show a) => String -> Get a -> a -> Get ()
getExpect String
"port msg pad" (forall a. Binary a => Get a
get @Word8) Word8
0)
    PortMsg -> Get PortMsg
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Port -> ShortMsg -> PortMsg
PortMsg Port
p ShortMsg
m)
  put :: PortMsg -> Put
put (PortMsg Port
p ShortMsg
m) = do
    Port -> Put
forall a. Binary a => a -> Put
put Port
p
    ShortMsg -> Put
forall a. Binary a => a -> Put
put ShortMsg
m
    Int -> Put -> Put
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteCount -> Int
unByteCount (ShortMsg -> ByteCount
forall a. Binary a => a -> ByteCount
byteSize ShortMsg
m)) (forall a. Binary a => a -> Put
put @Word8 Word8
0)

data Datum
  = DatumInt32 !Int32
  | DatumInt64 !Int64
  | DatumFloat !Float
  | DatumDouble !Double
  | DatumString !Text
  | DatumBlob !ShortByteString
  | DatumTime !NtpTime
  | DatumMidi !PortMsg
  deriving stock (Datum -> Datum -> Bool
(Datum -> Datum -> Bool) -> (Datum -> Datum -> Bool) -> Eq Datum
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Datum -> Datum -> Bool
== :: Datum -> Datum -> Bool
$c/= :: Datum -> Datum -> Bool
/= :: Datum -> Datum -> Bool
Eq, Eq Datum
Eq Datum =>
(Datum -> Datum -> Ordering)
-> (Datum -> Datum -> Bool)
-> (Datum -> Datum -> Bool)
-> (Datum -> Datum -> Bool)
-> (Datum -> Datum -> Bool)
-> (Datum -> Datum -> Datum)
-> (Datum -> Datum -> Datum)
-> Ord Datum
Datum -> Datum -> Bool
Datum -> Datum -> Ordering
Datum -> Datum -> Datum
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 :: Datum -> Datum -> Ordering
compare :: Datum -> Datum -> Ordering
$c< :: Datum -> Datum -> Bool
< :: Datum -> Datum -> Bool
$c<= :: Datum -> Datum -> Bool
<= :: Datum -> Datum -> Bool
$c> :: Datum -> Datum -> Bool
> :: Datum -> Datum -> Bool
$c>= :: Datum -> Datum -> Bool
>= :: Datum -> Datum -> Bool
$cmax :: Datum -> Datum -> Datum
max :: Datum -> Datum -> Datum
$cmin :: Datum -> Datum -> Datum
min :: Datum -> Datum -> Datum
Ord, Int -> Datum -> ShowS
[Datum] -> ShowS
Datum -> String
(Int -> Datum -> ShowS)
-> (Datum -> String) -> ([Datum] -> ShowS) -> Show Datum
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Datum -> ShowS
showsPrec :: Int -> Datum -> ShowS
$cshow :: Datum -> String
show :: Datum -> String
$cshowList :: [Datum] -> ShowS
showList :: [Datum] -> ShowS
Show)

datumSizer :: Datum -> ByteCount
datumSizer :: Datum -> ByteCount
datumSizer = \case
  DatumInt32 Int32
_ -> ByteCount
4
  DatumInt64 Int64
_ -> ByteCount
8
  DatumFloat Float
_ -> ByteCount
4
  DatumDouble Double
_ -> ByteCount
8
  DatumString Text
x -> Int -> ByteCount
ByteCount (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
T.length Text
x)
  DatumBlob ShortByteString
x -> Int -> ByteCount
ByteCount (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ShortByteString -> Int
BSS.length ShortByteString
x)
  DatumTime NtpTime
_ -> ByteCount
8
  DatumMidi PortMsg
_ -> ByteCount
4

datumGetter :: DatumType -> Get Datum
datumGetter :: DatumType -> Get Datum
datumGetter = \case
  DatumType
DatumTypeInt32 -> Int32 -> Datum
DatumInt32 (Int32 -> Datum) -> (Int32BE -> Int32) -> Int32BE -> Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32BE -> Int32
unInt32BE (Int32BE -> Datum) -> Get Int32BE -> Get Datum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int32BE
forall a. Binary a => Get a
get
  DatumType
DatumTypeInt64 -> Int64 -> Datum
DatumInt64 (Int64 -> Datum) -> (Int64BE -> Int64) -> Int64BE -> Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64BE -> Int64
unInt64BE (Int64BE -> Datum) -> Get Int64BE -> Get Datum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int64BE
forall a. Binary a => Get a
get
  DatumType
DatumTypeFloat -> Float -> Datum
DatumFloat (Float -> Datum) -> (FloatBE -> Float) -> FloatBE -> Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FloatBE -> Float
unFloatBE (FloatBE -> Datum) -> Get FloatBE -> Get Datum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get FloatBE
forall a. Binary a => Get a
get
  DatumType
DatumTypeDouble -> Double -> Datum
DatumDouble (Double -> Datum) -> (DoubleBE -> Double) -> DoubleBE -> Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DoubleBE -> Double
unDoubleBE (DoubleBE -> Datum) -> Get DoubleBE -> Get Datum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get DoubleBE
forall a. Binary a => Get a
get
  DatumType
DatumTypeString -> Text -> Datum
DatumString (Text -> Datum) -> Get Text -> Get Datum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Text -> Get Text
forall a. Get a -> Get a
getPad32 Get Text
getTermText
  DatumType
DatumTypeBlob -> (ShortByteString -> Datum) -> Get ShortByteString -> Get Datum
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ShortByteString -> Datum
DatumBlob (Get ShortByteString -> Get Datum)
-> Get ShortByteString -> Get Datum
forall a b. (a -> b) -> a -> b
$ Get ShortByteString -> Get ShortByteString
forall a. Get a -> Get a
getPad32 (Get ShortByteString -> Get ShortByteString)
-> Get ShortByteString -> Get ShortByteString
forall a b. (a -> b) -> a -> b
$ do
    Word32BE
w <- forall a. Binary a => Get a
get @Word32BE
    ByteCount -> Get ShortByteString
getByteString (Word32BE -> ByteCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32BE
w)
  DatumType
DatumTypeTime -> NtpTime -> Datum
DatumTime (NtpTime -> Datum) -> (Word64BE -> NtpTime) -> Word64BE -> Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> NtpTime
NtpTime (Word64 -> NtpTime) -> (Word64BE -> Word64) -> Word64BE -> NtpTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64BE -> Word64
unWord64BE (Word64BE -> Datum) -> Get Word64BE -> Get Datum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64BE
forall a. Binary a => Get a
get
  DatumType
DatumTypeMidi -> PortMsg -> Datum
DatumMidi (PortMsg -> Datum) -> Get PortMsg -> Get Datum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get PortMsg
forall a. Binary a => Get a
get

datumPutter :: Datum -> Put
datumPutter :: Datum -> Put
datumPutter = (Datum -> ByteCount) -> (Datum -> Put) -> Datum -> Put
forall a. (a -> ByteCount) -> (a -> Put) -> a -> Put
putPad32 Datum -> ByteCount
datumSizer ((Datum -> Put) -> Datum -> Put) -> (Datum -> Put) -> Datum -> Put
forall a b. (a -> b) -> a -> b
$ \case
  DatumInt32 Int32
x -> Int32BE -> Put
forall a. Binary a => a -> Put
put (Int32 -> Int32BE
Int32BE Int32
x)
  DatumInt64 Int64
x -> Int64BE -> Put
forall a. Binary a => a -> Put
put (Int64 -> Int64BE
Int64BE Int64
x)
  DatumFloat Float
x -> FloatBE -> Put
forall a. Binary a => a -> Put
put (Float -> FloatBE
FloatBE Float
x)
  DatumDouble Double
x -> DoubleBE -> Put
forall a. Binary a => a -> Put
put (Double -> DoubleBE
DoubleBE Double
x)
  DatumString Text
x -> Text -> Put
putTermText Text
x
  DatumBlob ShortByteString
x -> do
    forall a. Binary a => a -> Put
put @Word32BE (Int -> Word32BE
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ShortByteString -> Int
BSS.length ShortByteString
x))
    ShortByteString -> Put
putByteString ShortByteString
x
  DatumTime NtpTime
x -> Word64BE -> Put
forall a. Binary a => a -> Put
put (Word64 -> Word64BE
Word64BE (NtpTime -> Word64
unNtpTime NtpTime
x))
  DatumMidi PortMsg
x -> PortMsg -> Put
forall a. Binary a => a -> Put
put PortMsg
x

datumType :: Datum -> DatumType
datumType :: Datum -> DatumType
datumType = \case
  DatumInt32 Int32
_ -> DatumType
DatumTypeInt32
  DatumInt64 Int64
_ -> DatumType
DatumTypeInt64
  DatumFloat Float
_ -> DatumType
DatumTypeFloat
  DatumDouble Double
_ -> DatumType
DatumTypeDouble
  DatumString Text
_ -> DatumType
DatumTypeString
  DatumBlob ShortByteString
_ -> DatumType
DatumTypeBlob
  DatumTime NtpTime
_ -> DatumType
DatumTypeTime
  DatumMidi PortMsg
_ -> DatumType
DatumTypeMidi

class IsDatum a where
  toDatum :: a -> Datum

instance IsDatum Datum where
  toDatum :: Datum -> Datum
toDatum = Datum -> Datum
forall a. a -> a
id

instance IsDatum Int32 where
  toDatum :: Int32 -> Datum
toDatum = Int32 -> Datum
DatumInt32

instance IsDatum Int64 where
  toDatum :: Int64 -> Datum
toDatum = Int64 -> Datum
DatumInt64

instance IsDatum Float where
  toDatum :: Float -> Datum
toDatum = Float -> Datum
DatumFloat

instance IsDatum Double where
  toDatum :: Double -> Datum
toDatum = Double -> Datum
DatumDouble

instance IsDatum Text where
  toDatum :: Text -> Datum
toDatum = Text -> Datum
DatumString

instance IsDatum ShortByteString where
  toDatum :: ShortByteString -> Datum
toDatum = ShortByteString -> Datum
DatumBlob

instance IsDatum NtpTime where
  toDatum :: NtpTime -> Datum
toDatum = NtpTime -> Datum
DatumTime

instance IsDatum PortMsg where
  toDatum :: PortMsg -> Datum
toDatum = PortMsg -> Datum
DatumMidi

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

commaByte :: Word8
commaByte :: Word8
commaByte = Char -> Word8
c2w Char
','

hashByte :: Word8
hashByte :: Word8
hashByte = Char -> Word8
c2w Char
'#'

getNextNonPad :: Get (Maybe Word8)
getNextNonPad :: Get (Maybe Word8)
getNextNonPad = do
  ByteCount
sz <- Get ByteCount
getRemainingSize
  if ByteCount
sz ByteCount -> ByteCount -> Bool
forall a. Eq a => a -> a -> Bool
== ByteCount
0
    then Maybe Word8 -> Get (Maybe Word8)
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Word8
forall a. Maybe a
Nothing
    else do
      Word8
w <- Get Word8 -> Get Word8
forall a. Get a -> Get a
getLookAhead (forall a. Binary a => Get a
get @Word8)
      if Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0
        then Maybe Word8 -> Get (Maybe Word8)
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Word8
forall a. Maybe a
Nothing
        else (Word8 -> Maybe Word8) -> Get Word8 -> Get (Maybe Word8)
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word8 -> Maybe Word8
forall a. a -> Maybe a
Just (forall a. Binary a => Get a
get @Word8)

sigSizer :: Sig -> ByteCount
sigSizer :: Sig -> ByteCount
sigSizer (Sig Seq DatumType
dts) = Int -> ByteCount
ByteCount (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Seq DatumType -> Int
forall a. Seq a -> Int
Seq.length Seq DatumType
dts)

instance Binary Sig where
  byteSize :: Sig -> ByteCount
byteSize = (Sig -> ByteCount) -> Sig -> ByteCount
forall a. (a -> ByteCount) -> a -> ByteCount
byteSizePad32 Sig -> ByteCount
sigSizer
  get :: Get Sig
get = Get Sig -> Get Sig
forall a. Get a -> Get a
getPad32 (String -> Get Word8 -> Word8 -> Get ()
forall a. (Eq a, Show a) => String -> Get a -> a -> Get ()
getExpect String
"comma" Get Word8
forall a. Binary a => Get a
get Word8
commaByte Get () -> Get Sig -> Get Sig
forall a b. Get a -> Get b -> Get b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Seq DatumType -> Sig) -> Get (Seq DatumType) -> Get Sig
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Seq DatumType -> Sig
Sig (Seq DatumType -> Get (Seq DatumType)
go Seq DatumType
forall a. Seq a
Empty))
   where
    go :: Seq DatumType -> Get (Seq DatumType)
go !Seq DatumType
acc = do
      Maybe Word8
mnext <- Get (Maybe Word8)
getNextNonPad
      case Maybe Word8
mnext of
        Just Word8
w -> do
          case Char -> Maybe DatumType
datumTypeUnRep (Word8 -> Char
w2c Word8
w) of
            Maybe DatumType
Nothing -> String -> Get (Seq DatumType)
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Unknown data type rep: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
w)
            Just DatumType
dt -> Seq DatumType -> Get (Seq DatumType)
go (Seq DatumType
acc Seq DatumType -> DatumType -> Seq DatumType
forall a. Seq a -> a -> Seq a
:|> DatumType
dt)
        Maybe Word8
Nothing -> Seq DatumType
acc Seq DatumType -> Get () -> Get (Seq DatumType)
forall a b. a -> Get b -> Get a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Get Word8 -> Word8 -> Get ()
forall a. (Eq a, Show a) => String -> Get a -> a -> Get ()
getExpect String
"pad" (forall a. Binary a => Get a
get @Word8) Word8
0
  put :: Sig -> Put
put = (Sig -> ByteCount) -> (Sig -> Put) -> Sig -> Put
forall a. (a -> ByteCount) -> (a -> Put) -> a -> Put
putPad32 Sig -> ByteCount
sigSizer ((Sig -> Put) -> Sig -> Put) -> (Sig -> Put) -> Sig -> Put
forall a b. (a -> b) -> a -> b
$ \(Sig Seq DatumType
dts) -> do
    Word8 -> Put
forall a. Binary a => a -> Put
put Word8
commaByte
    Seq DatumType -> (DatumType -> Put) -> Put
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Seq DatumType
dts (Word8 -> Put
forall a. Binary a => a -> Put
put (Word8 -> Put) -> (DatumType -> Word8) -> DatumType -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Word8
c2w (Char -> Word8) -> (DatumType -> Char) -> DatumType -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DatumType -> Char
datumTypeRep)
    forall a. Binary a => a -> Put
put @Word8 Word8
0

data Msg = Msg !RawAddrPat !(Seq Datum)
  deriving stock (Msg -> Msg -> Bool
(Msg -> Msg -> Bool) -> (Msg -> Msg -> Bool) -> Eq Msg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Msg -> Msg -> Bool
== :: Msg -> Msg -> Bool
$c/= :: Msg -> Msg -> Bool
/= :: Msg -> Msg -> Bool
Eq, Eq Msg
Eq Msg =>
(Msg -> Msg -> Ordering)
-> (Msg -> Msg -> Bool)
-> (Msg -> Msg -> Bool)
-> (Msg -> Msg -> Bool)
-> (Msg -> Msg -> Bool)
-> (Msg -> Msg -> Msg)
-> (Msg -> Msg -> Msg)
-> Ord Msg
Msg -> Msg -> Bool
Msg -> Msg -> Ordering
Msg -> Msg -> Msg
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 :: Msg -> Msg -> Ordering
compare :: Msg -> Msg -> Ordering
$c< :: Msg -> Msg -> Bool
< :: Msg -> Msg -> Bool
$c<= :: Msg -> Msg -> Bool
<= :: Msg -> Msg -> Bool
$c> :: Msg -> Msg -> Bool
> :: Msg -> Msg -> Bool
$c>= :: Msg -> Msg -> Bool
>= :: Msg -> Msg -> Bool
$cmax :: Msg -> Msg -> Msg
max :: Msg -> Msg -> Msg
$cmin :: Msg -> Msg -> Msg
min :: Msg -> Msg -> Msg
Ord, Int -> Msg -> ShowS
[Msg] -> ShowS
Msg -> String
(Int -> Msg -> ShowS)
-> (Msg -> String) -> ([Msg] -> ShowS) -> Show Msg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Msg -> ShowS
showsPrec :: Int -> Msg -> ShowS
$cshow :: Msg -> String
show :: Msg -> String
$cshowList :: [Msg] -> ShowS
showList :: [Msg] -> ShowS
Show)

instance Binary Msg where
  byteSize :: Msg -> ByteCount
byteSize (Msg RawAddrPat
r Seq Datum
ds) =
    RawAddrPat -> ByteCount
forall a. Binary a => a -> ByteCount
byteSize RawAddrPat
r
      ByteCount -> ByteCount -> ByteCount
forall a. Num a => a -> a -> a
+ ByteCount -> ByteCount
pad32 (Int -> ByteCount
ByteCount (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Seq Datum -> Int
forall a. Seq a -> Int
Seq.length Seq Datum
ds))
      ByteCount -> ByteCount -> ByteCount
forall a. Num a => a -> a -> a
+ Sum ByteCount -> ByteCount
forall a. Sum a -> a
getSum ((Datum -> Sum ByteCount) -> Seq Datum -> Sum ByteCount
forall m a. Monoid m => (a -> m) -> Seq a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap' (ByteCount -> Sum ByteCount
forall a. a -> Sum a
Sum (ByteCount -> Sum ByteCount)
-> (Datum -> ByteCount) -> Datum -> Sum ByteCount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteCount -> ByteCount
pad32 (ByteCount -> ByteCount)
-> (Datum -> ByteCount) -> Datum -> ByteCount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Datum -> ByteCount
datumSizer) Seq Datum
ds)
  get :: Get Msg
get = do
    RawAddrPat
r <- forall a. Binary a => Get a
get @RawAddrPat
    Sig
s <- forall a. Binary a => Get a
get @Sig
    Seq Datum
ds <- (DatumType -> Get Datum) -> Seq DatumType -> Get (Seq Datum)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Seq a -> f (Seq b)
traverse DatumType -> Get Datum
datumGetter (Sig -> Seq DatumType
unSig Sig
s)
    Msg -> Get Msg
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RawAddrPat -> Seq Datum -> Msg
Msg RawAddrPat
r Seq Datum
ds)
  put :: Msg -> Put
put (Msg RawAddrPat
r Seq Datum
ds) = do
    RawAddrPat -> Put
forall a. Binary a => a -> Put
put RawAddrPat
r
    Sig -> Put
forall a. Binary a => a -> Put
put (Seq DatumType -> Sig
Sig ((Datum -> DatumType) -> Seq Datum -> Seq DatumType
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Datum -> DatumType
datumType Seq Datum
ds))
    Seq Datum -> (Datum -> Put) -> Put
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Seq Datum
ds Datum -> Put
datumPutter

data Bundle = Bundle !NtpTime !(Seq Packet)
  deriving stock (Bundle -> Bundle -> Bool
(Bundle -> Bundle -> Bool)
-> (Bundle -> Bundle -> Bool) -> Eq Bundle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Bundle -> Bundle -> Bool
== :: Bundle -> Bundle -> Bool
$c/= :: Bundle -> Bundle -> Bool
/= :: Bundle -> Bundle -> Bool
Eq, Eq Bundle
Eq Bundle =>
(Bundle -> Bundle -> Ordering)
-> (Bundle -> Bundle -> Bool)
-> (Bundle -> Bundle -> Bool)
-> (Bundle -> Bundle -> Bool)
-> (Bundle -> Bundle -> Bool)
-> (Bundle -> Bundle -> Bundle)
-> (Bundle -> Bundle -> Bundle)
-> Ord Bundle
Bundle -> Bundle -> Bool
Bundle -> Bundle -> Ordering
Bundle -> Bundle -> Bundle
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 :: Bundle -> Bundle -> Ordering
compare :: Bundle -> Bundle -> Ordering
$c< :: Bundle -> Bundle -> Bool
< :: Bundle -> Bundle -> Bool
$c<= :: Bundle -> Bundle -> Bool
<= :: Bundle -> Bundle -> Bool
$c> :: Bundle -> Bundle -> Bool
> :: Bundle -> Bundle -> Bool
$c>= :: Bundle -> Bundle -> Bool
>= :: Bundle -> Bundle -> Bool
$cmax :: Bundle -> Bundle -> Bundle
max :: Bundle -> Bundle -> Bundle
$cmin :: Bundle -> Bundle -> Bundle
min :: Bundle -> Bundle -> Bundle
Ord, Int -> Bundle -> ShowS
[Bundle] -> ShowS
Bundle -> String
(Int -> Bundle -> ShowS)
-> (Bundle -> String) -> ([Bundle] -> ShowS) -> Show Bundle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Bundle -> ShowS
showsPrec :: Int -> Bundle -> ShowS
$cshow :: Bundle -> String
show :: Bundle -> String
$cshowList :: [Bundle] -> ShowS
showList :: [Bundle] -> ShowS
Show)

bundleTag :: TermBytes8
bundleTag :: TermBytes8
bundleTag = ShortByteString -> TermBytes8
TermBytes8 ShortByteString
"#bundle"

instance Binary Bundle where
  byteSize :: Bundle -> ByteCount
byteSize (Bundle NtpTime
_ Seq Packet
packs) = ByteCount
16 ByteCount -> ByteCount -> ByteCount
forall a. Num a => a -> a -> a
+ Int -> ByteCount
ByteCount (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Seq Packet -> Int
forall a. Seq a -> Int
Seq.length Seq Packet
packs) ByteCount -> ByteCount -> ByteCount
forall a. Num a => a -> a -> a
+ Seq Packet -> ByteCount
forall (f :: * -> *) a. (Foldable f, Binary a) => f a -> ByteCount
byteSizeFoldable Seq Packet
packs
  get :: Get Bundle
get = do
    String -> Get TermBytes8 -> TermBytes8 -> Get ()
forall a. (Eq a, Show a) => String -> Get a -> a -> Get ()
getExpect String
"bundle tag" (forall a. Binary a => Get a
get @TermBytes8) TermBytes8
bundleTag
    NtpTime
t <- (Word64BE -> NtpTime) -> Get Word64BE -> Get NtpTime
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word64 -> NtpTime
NtpTime (Word64 -> NtpTime) -> (Word64BE -> Word64) -> Word64BE -> NtpTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64BE -> Word64
forall a b. Coercible a b => a -> b
coerce) (forall a. Binary a => Get a
get @Word64BE)
    Seq Packet
packs <- Get Packet -> Get (Seq Packet)
forall a. Get a -> Get (Seq a)
getRemainingSeq (Get Packet -> Get (Seq Packet)) -> Get Packet -> Get (Seq Packet)
forall a b. (a -> b) -> a -> b
$ do
      ByteCount
sz <- (Word32BE -> ByteCount) -> Get Word32BE -> Get ByteCount
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> ByteCount
ByteCount (Int -> ByteCount) -> (Word32BE -> Int) -> Word32BE -> ByteCount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32BE -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (forall a. Binary a => Get a
get @Word32BE)
      ByteCount -> Get Packet -> Get Packet
forall a. ByteCount -> Get a -> Get a
getExact ByteCount
sz Get Packet
forall a. Binary a => Get a
get
    Bundle -> Get Bundle
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NtpTime -> Seq Packet -> Bundle
Bundle NtpTime
t Seq Packet
packs)
  put :: Bundle -> Put
put (Bundle (NtpTime Word64
k) Seq Packet
packs) = do
    TermBytes8 -> Put
forall a. Binary a => a -> Put
put TermBytes8
bundleTag
    forall a. Binary a => a -> Put
put @Word64BE (Word64 -> Word64BE
forall a b. Coercible a b => a -> b
coerce Word64
k)
    Seq Packet -> (Packet -> Put) -> Put
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Seq Packet
packs ((Packet -> Put) -> Put) -> (Packet -> Put) -> Put
forall a b. (a -> b) -> a -> b
$ \Packet
pack -> do
      forall a. Binary a => a -> Put
put @Word32BE (ByteCount -> Word32BE
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Packet -> ByteCount
forall a. Binary a => a -> ByteCount
byteSize Packet
pack))
      Packet -> Put
forall a. Binary a => a -> Put
put Packet
pack

data Packet
  = PacketMsg !Msg
  | PacketBundle !Bundle
  deriving stock (Packet -> Packet -> Bool
(Packet -> Packet -> Bool)
-> (Packet -> Packet -> Bool) -> Eq Packet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Packet -> Packet -> Bool
== :: Packet -> Packet -> Bool
$c/= :: Packet -> Packet -> Bool
/= :: Packet -> Packet -> Bool
Eq, Eq Packet
Eq Packet =>
(Packet -> Packet -> Ordering)
-> (Packet -> Packet -> Bool)
-> (Packet -> Packet -> Bool)
-> (Packet -> Packet -> Bool)
-> (Packet -> Packet -> Bool)
-> (Packet -> Packet -> Packet)
-> (Packet -> Packet -> Packet)
-> Ord Packet
Packet -> Packet -> Bool
Packet -> Packet -> Ordering
Packet -> Packet -> Packet
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 :: Packet -> Packet -> Ordering
compare :: Packet -> Packet -> Ordering
$c< :: Packet -> Packet -> Bool
< :: Packet -> Packet -> Bool
$c<= :: Packet -> Packet -> Bool
<= :: Packet -> Packet -> Bool
$c> :: Packet -> Packet -> Bool
> :: Packet -> Packet -> Bool
$c>= :: Packet -> Packet -> Bool
>= :: Packet -> Packet -> Bool
$cmax :: Packet -> Packet -> Packet
max :: Packet -> Packet -> Packet
$cmin :: Packet -> Packet -> Packet
min :: Packet -> Packet -> Packet
Ord, Int -> Packet -> ShowS
[Packet] -> ShowS
Packet -> String
(Int -> Packet -> ShowS)
-> (Packet -> String) -> ([Packet] -> ShowS) -> Show Packet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Packet -> ShowS
showsPrec :: Int -> Packet -> ShowS
$cshow :: Packet -> String
show :: Packet -> String
$cshowList :: [Packet] -> ShowS
showList :: [Packet] -> ShowS
Show, (forall x. Packet -> Rep Packet x)
-> (forall x. Rep Packet x -> Packet) -> Generic Packet
forall x. Rep Packet x -> Packet
forall x. Packet -> Rep Packet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Packet -> Rep Packet x
from :: forall x. Packet -> Rep Packet x
$cto :: forall x. Rep Packet x -> Packet
to :: forall x. Rep Packet x -> Packet
Generic)

instance Binary Packet where
  byteSize :: Packet -> ByteCount
byteSize = \case
    PacketMsg Msg
msg -> Msg -> ByteCount
forall a. Binary a => a -> ByteCount
byteSize Msg
msg
    PacketBundle Bundle
bun -> Bundle -> ByteCount
forall a. Binary a => a -> ByteCount
byteSize Bundle
bun
  get :: Get Packet
get = do
    Word8
w <- Get Word8 -> Get Word8
forall a. Get a -> Get a
getLookAhead (forall a. Binary a => Get a
get @Word8)
    if Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
hashByte
      then (Bundle -> Packet) -> Get Bundle -> Get Packet
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bundle -> Packet
PacketBundle Get Bundle
forall a. Binary a => Get a
get
      else (Msg -> Packet) -> Get Msg -> Get Packet
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Msg -> Packet
PacketMsg Get Msg
forall a. Binary a => Get a
get
  put :: Packet -> Put
put = \case
    PacketMsg Msg
msg -> Msg -> Put
forall a. Binary a => a -> Put
put Msg
msg
    PacketBundle Bundle
bun -> Bundle -> Put
forall a. Binary a => a -> Put
put Bundle
bun

immediately :: NtpTime
immediately :: NtpTime
immediately = Word64 -> NtpTime
NtpTime Word64
1