{-# 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 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