-- | Data types for Osc messages, bundles and packets.
module Sound.Osc.Packet where

import Sound.Osc.Datum {- hosc -}

-- * Message

{- | Osc address pattern.  This is strictly an Ascii value, however it
  is very common to pattern match on addresses and matching on
  Data.ByteString.Char8 requires @OverloadedStrings@.
-}
type Address_Pattern = String

-- | An Osc message, an 'Address_Pattern' and a sequence of 'Datum'.
data Message = Message
  { Message -> Address_Pattern
messageAddress :: !Address_Pattern
  , Message -> [Datum]
messageDatum :: ![Datum]
  }
  deriving (Eq Message
Eq Message =>
(Message -> Message -> Ordering)
-> (Message -> Message -> Bool)
-> (Message -> Message -> Bool)
-> (Message -> Message -> Bool)
-> (Message -> Message -> Bool)
-> (Message -> Message -> Message)
-> (Message -> Message -> Message)
-> Ord Message
Message -> Message -> Bool
Message -> Message -> Ordering
Message -> Message -> Message
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 :: Message -> Message -> Ordering
compare :: Message -> Message -> Ordering
$c< :: Message -> Message -> Bool
< :: Message -> Message -> Bool
$c<= :: Message -> Message -> Bool
<= :: Message -> Message -> Bool
$c> :: Message -> Message -> Bool
> :: Message -> Message -> Bool
$c>= :: Message -> Message -> Bool
>= :: Message -> Message -> Bool
$cmax :: Message -> Message -> Message
max :: Message -> Message -> Message
$cmin :: Message -> Message -> Message
min :: Message -> Message -> Message
Ord, Message -> Message -> Bool
(Message -> Message -> Bool)
-> (Message -> Message -> Bool) -> Eq Message
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Message -> Message -> Bool
== :: Message -> Message -> Bool
$c/= :: Message -> Message -> Bool
/= :: Message -> Message -> Bool
Eq, ReadPrec [Message]
ReadPrec Message
Int -> ReadS Message
ReadS [Message]
(Int -> ReadS Message)
-> ReadS [Message]
-> ReadPrec Message
-> ReadPrec [Message]
-> Read Message
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Message
readsPrec :: Int -> ReadS Message
$creadList :: ReadS [Message]
readList :: ReadS [Message]
$creadPrec :: ReadPrec Message
readPrec :: ReadPrec Message
$creadListPrec :: ReadPrec [Message]
readListPrec :: ReadPrec [Message]
Read, Int -> Message -> ShowS
[Message] -> ShowS
Message -> Address_Pattern
(Int -> Message -> ShowS)
-> (Message -> Address_Pattern)
-> ([Message] -> ShowS)
-> Show Message
forall a.
(Int -> a -> ShowS)
-> (a -> Address_Pattern) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Message -> ShowS
showsPrec :: Int -> Message -> ShowS
$cshow :: Message -> Address_Pattern
show :: Message -> Address_Pattern
$cshowList :: [Message] -> ShowS
showList :: [Message] -> ShowS
Show)

{- | 'Message' constructor.  It is an 'error' if the 'Address_Pattern'
doesn't conform to the Osc specification.
-}
message :: Address_Pattern -> [Datum] -> Message
message :: Address_Pattern -> [Datum] -> Message
message Address_Pattern
a [Datum]
xs =
  case Address_Pattern
a of
    Char
'/' : Address_Pattern
_ -> Address_Pattern -> [Datum] -> Message
Message Address_Pattern
a [Datum]
xs
    Address_Pattern
_ -> Address_Pattern -> Message
forall a. HasCallStack => Address_Pattern -> a
error Address_Pattern
"message: ill-formed address pattern"

messageSignature :: Message -> String
messageSignature :: Message -> Address_Pattern
messageSignature = [Datum] -> Address_Pattern
signatureFor ([Datum] -> Address_Pattern)
-> (Message -> [Datum]) -> Message -> Address_Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message -> [Datum]
messageDatum

messageDescriptor :: Message -> Ascii
messageDescriptor :: Message -> Ascii
messageDescriptor = [Datum] -> Ascii
descriptor ([Datum] -> Ascii) -> (Message -> [Datum]) -> Message -> Ascii
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message -> [Datum]
messageDatum

-- * Bundle

{- | An Osc bundle, a 'Time' and a sequence of 'Message's.
The type parameter specifies the element type.
Ordinarily this is Message, which does not allow recursion.
-}
data BundleOf t = Bundle
  { forall t. BundleOf t -> Time
bundleTime :: !Time
  , forall t. BundleOf t -> [t]
bundleMessages :: ![t]
  }
  deriving (BundleOf t -> BundleOf t -> Bool
(BundleOf t -> BundleOf t -> Bool)
-> (BundleOf t -> BundleOf t -> Bool) -> Eq (BundleOf t)
forall t. Eq t => BundleOf t -> BundleOf t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall t. Eq t => BundleOf t -> BundleOf t -> Bool
== :: BundleOf t -> BundleOf t -> Bool
$c/= :: forall t. Eq t => BundleOf t -> BundleOf t -> Bool
/= :: BundleOf t -> BundleOf t -> Bool
Eq, ReadPrec [BundleOf t]
ReadPrec (BundleOf t)
Int -> ReadS (BundleOf t)
ReadS [BundleOf t]
(Int -> ReadS (BundleOf t))
-> ReadS [BundleOf t]
-> ReadPrec (BundleOf t)
-> ReadPrec [BundleOf t]
-> Read (BundleOf t)
forall t. Read t => ReadPrec [BundleOf t]
forall t. Read t => ReadPrec (BundleOf t)
forall t. Read t => Int -> ReadS (BundleOf t)
forall t. Read t => ReadS [BundleOf t]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall t. Read t => Int -> ReadS (BundleOf t)
readsPrec :: Int -> ReadS (BundleOf t)
$creadList :: forall t. Read t => ReadS [BundleOf t]
readList :: ReadS [BundleOf t]
$creadPrec :: forall t. Read t => ReadPrec (BundleOf t)
readPrec :: ReadPrec (BundleOf t)
$creadListPrec :: forall t. Read t => ReadPrec [BundleOf t]
readListPrec :: ReadPrec [BundleOf t]
Read, Int -> BundleOf t -> ShowS
[BundleOf t] -> ShowS
BundleOf t -> Address_Pattern
(Int -> BundleOf t -> ShowS)
-> (BundleOf t -> Address_Pattern)
-> ([BundleOf t] -> ShowS)
-> Show (BundleOf t)
forall t. Show t => Int -> BundleOf t -> ShowS
forall t. Show t => [BundleOf t] -> ShowS
forall t. Show t => BundleOf t -> Address_Pattern
forall a.
(Int -> a -> ShowS)
-> (a -> Address_Pattern) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall t. Show t => Int -> BundleOf t -> ShowS
showsPrec :: Int -> BundleOf t -> ShowS
$cshow :: forall t. Show t => BundleOf t -> Address_Pattern
show :: BundleOf t -> Address_Pattern
$cshowList :: forall t. Show t => [BundleOf t] -> ShowS
showList :: [BundleOf t] -> ShowS
Show)

type Bundle = BundleOf Message

-- | Osc 'Bundle's can be ordered (time ascending).
instance Eq t => Ord (BundleOf t) where
  compare :: BundleOf t -> BundleOf t -> Ordering
compare (Bundle Time
a [t]
_) (Bundle Time
b [t]
_) = Time -> Time -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Time
a Time
b

-- | 'Bundle' constructor. It is an 'error' if the 'Message' list is empty.
bundle :: Time -> [t] -> BundleOf t
bundle :: forall t. Time -> [t] -> BundleOf t
bundle Time
t [t]
xs =
  case [t]
xs of
    [] -> Address_Pattern -> BundleOf t
forall a. HasCallStack => Address_Pattern -> a
error Address_Pattern
"bundle: empty?"
    [t]
_ -> Time -> [t] -> BundleOf t
forall t. Time -> [t] -> BundleOf t
Bundle Time
t [t]
xs

-- * Packet

-- | An Osc 'Packet' is either a 'Message' or a 'Bundle t'.
data PacketOf t
  = Packet_Message {forall t. PacketOf t -> Message
packetMessage :: !Message}
  | Packet_Bundle {forall t. PacketOf t -> BundleOf t
packetBundle :: !(BundleOf t)}
  deriving (PacketOf t -> PacketOf t -> Bool
(PacketOf t -> PacketOf t -> Bool)
-> (PacketOf t -> PacketOf t -> Bool) -> Eq (PacketOf t)
forall t. Eq t => PacketOf t -> PacketOf t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall t. Eq t => PacketOf t -> PacketOf t -> Bool
== :: PacketOf t -> PacketOf t -> Bool
$c/= :: forall t. Eq t => PacketOf t -> PacketOf t -> Bool
/= :: PacketOf t -> PacketOf t -> Bool
Eq, ReadPrec [PacketOf t]
ReadPrec (PacketOf t)
Int -> ReadS (PacketOf t)
ReadS [PacketOf t]
(Int -> ReadS (PacketOf t))
-> ReadS [PacketOf t]
-> ReadPrec (PacketOf t)
-> ReadPrec [PacketOf t]
-> Read (PacketOf t)
forall t. Read t => ReadPrec [PacketOf t]
forall t. Read t => ReadPrec (PacketOf t)
forall t. Read t => Int -> ReadS (PacketOf t)
forall t. Read t => ReadS [PacketOf t]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall t. Read t => Int -> ReadS (PacketOf t)
readsPrec :: Int -> ReadS (PacketOf t)
$creadList :: forall t. Read t => ReadS [PacketOf t]
readList :: ReadS [PacketOf t]
$creadPrec :: forall t. Read t => ReadPrec (PacketOf t)
readPrec :: ReadPrec (PacketOf t)
$creadListPrec :: forall t. Read t => ReadPrec [PacketOf t]
readListPrec :: ReadPrec [PacketOf t]
Read, Int -> PacketOf t -> ShowS
[PacketOf t] -> ShowS
PacketOf t -> Address_Pattern
(Int -> PacketOf t -> ShowS)
-> (PacketOf t -> Address_Pattern)
-> ([PacketOf t] -> ShowS)
-> Show (PacketOf t)
forall t. Show t => Int -> PacketOf t -> ShowS
forall t. Show t => [PacketOf t] -> ShowS
forall t. Show t => PacketOf t -> Address_Pattern
forall a.
(Int -> a -> ShowS)
-> (a -> Address_Pattern) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall t. Show t => Int -> PacketOf t -> ShowS
showsPrec :: Int -> PacketOf t -> ShowS
$cshow :: forall t. Show t => PacketOf t -> Address_Pattern
show :: PacketOf t -> Address_Pattern
$cshowList :: forall t. Show t => [PacketOf t] -> ShowS
showList :: [PacketOf t] -> ShowS
Show)

type Packet = PacketOf Message

-- | 'Packet_Bundle' of 'bundle'.
p_bundle :: Time -> [t] -> PacketOf t
p_bundle :: forall t. Time -> [t] -> PacketOf t
p_bundle Time
t = BundleOf t -> PacketOf t
forall t. BundleOf t -> PacketOf t
Packet_Bundle (BundleOf t -> PacketOf t)
-> ([t] -> BundleOf t) -> [t] -> PacketOf t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time -> [t] -> BundleOf t
forall t. Time -> [t] -> BundleOf t
bundle Time
t

-- | 'Packet_Message' of 'message'.
p_message :: Address_Pattern -> [Datum] -> PacketOf t
p_message :: forall t. Address_Pattern -> [Datum] -> PacketOf t
p_message Address_Pattern
a = Message -> PacketOf t
forall t. Message -> PacketOf t
Packet_Message (Message -> PacketOf t)
-> ([Datum] -> Message) -> [Datum] -> PacketOf t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address_Pattern -> [Datum] -> Message
message Address_Pattern
a

{- | Constant indicating a bundle to be executed immediately.
It has the Ntp64 representation of @1@.

>>> immediately == (1 / (2 ^ 32))
True
-}
immediately :: Time
immediately :: Time
immediately = Time
1 Time -> Time -> Time
forall a. Fractional a => a -> a -> a
/ Time
2 Time -> Int -> Time
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
32 :: Int)

-- | The 'Time' of 'Packet', if the 'Packet' is a 'Message' this is 'immediately'.
packetTime :: PacketOf t -> Time
packetTime :: forall t. PacketOf t -> Time
packetTime = (Message -> Time) -> (BundleOf t -> Time) -> PacketOf t -> Time
forall a t. (Message -> a) -> (BundleOf t -> a) -> PacketOf t -> a
at_packet (Time -> Message -> Time
forall a b. a -> b -> a
const Time
immediately) BundleOf t -> Time
forall t. BundleOf t -> Time
bundleTime

-- | Retrieve the set of 'Message's from a 'Packet'.
packetMessages :: PacketOf Message -> [Message]
packetMessages :: PacketOf Message -> [Message]
packetMessages = (Message -> [Message])
-> (BundleOf Message -> [Message]) -> PacketOf Message -> [Message]
forall a t. (Message -> a) -> (BundleOf t -> a) -> PacketOf t -> a
at_packet Message -> [Message]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return BundleOf Message -> [Message]
forall t. BundleOf t -> [t]
bundleMessages

-- | If 'Packet' is a 'Message' add 'immediately' timestamp, else 'id'.
packet_to_bundle :: PacketOf Message -> BundleOf Message
packet_to_bundle :: PacketOf Message -> BundleOf Message
packet_to_bundle = (Message -> BundleOf Message)
-> (BundleOf Message -> BundleOf Message)
-> PacketOf Message
-> BundleOf Message
forall a t. (Message -> a) -> (BundleOf t -> a) -> PacketOf t -> a
at_packet (\Message
m -> Time -> [Message] -> BundleOf Message
forall t. Time -> [t] -> BundleOf t
Bundle Time
immediately [Message
m]) BundleOf Message -> BundleOf Message
forall a. a -> a
id

{- | If 'Packet' is a 'Message' or a 'Bundle' with an /immediate/ time
tag and with one element, return the 'Message', else 'Nothing'.
-}
packet_to_message :: PacketOf Message -> Maybe Message
packet_to_message :: PacketOf Message -> Maybe Message
packet_to_message PacketOf Message
p =
  case PacketOf Message
p of
    Packet_Bundle BundleOf Message
b ->
      case BundleOf Message
b of
        Bundle Time
t [Message
m] -> if Time
t Time -> Time -> Bool
forall a. Eq a => a -> a -> Bool
== Time
immediately then Message -> Maybe Message
forall a. a -> Maybe a
Just Message
m else Maybe Message
forall a. Maybe a
Nothing
        BundleOf Message
_ -> Maybe Message
forall a. Maybe a
Nothing
    Packet_Message Message
m -> Message -> Maybe Message
forall a. a -> Maybe a
Just Message
m

-- | Is 'Packet' immediate, ie. a 'Bundle' with timestamp 'immediately', or a plain Message.
packet_is_immediate :: PacketOf t -> Bool
packet_is_immediate :: forall t. PacketOf t -> Bool
packet_is_immediate = (Time -> Time -> Bool
forall a. Eq a => a -> a -> Bool
== Time
immediately) (Time -> Bool) -> (PacketOf t -> Time) -> PacketOf t -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PacketOf t -> Time
forall t. PacketOf t -> Time
packetTime

-- | Variant of 'either' for 'Packet'.
at_packet :: (Message -> a) -> (BundleOf t -> a) -> PacketOf t -> a
at_packet :: forall a t. (Message -> a) -> (BundleOf t -> a) -> PacketOf t -> a
at_packet Message -> a
f BundleOf t -> a
g PacketOf t
p =
  case PacketOf t
p of
    Packet_Message Message
m -> Message -> a
f Message
m
    Packet_Bundle BundleOf t
b -> BundleOf t -> a
g BundleOf t
b

-- * Address Query

-- | Does 'Message' have the specified 'Address_Pattern'.
message_has_address :: Address_Pattern -> Message -> Bool
message_has_address :: Address_Pattern -> Message -> Bool
message_has_address Address_Pattern
x = (Address_Pattern -> Address_Pattern -> Bool
forall a. Eq a => a -> a -> Bool
== Address_Pattern
x) (Address_Pattern -> Bool)
-> (Message -> Address_Pattern) -> Message -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message -> Address_Pattern
messageAddress

{- | Do any of the 'Message's at 'Bundle Message' have the specified
'Address_Pattern'.
-}
bundle_has_address :: Address_Pattern -> BundleOf Message -> Bool
bundle_has_address :: Address_Pattern -> BundleOf Message -> Bool
bundle_has_address Address_Pattern
x = (Message -> Bool) -> [Message] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Address_Pattern -> Message -> Bool
message_has_address Address_Pattern
x) ([Message] -> Bool)
-> (BundleOf Message -> [Message]) -> BundleOf Message -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BundleOf Message -> [Message]
forall t. BundleOf t -> [t]
bundleMessages

{- | Does 'Packet' have the specified 'Address_Pattern', ie.
'message_has_address' or 'bundle_has_address'.
-}
packet_has_address :: Address_Pattern -> PacketOf Message -> Bool
packet_has_address :: Address_Pattern -> PacketOf Message -> Bool
packet_has_address Address_Pattern
x =
  (Message -> Bool)
-> (BundleOf Message -> Bool) -> PacketOf Message -> Bool
forall a t. (Message -> a) -> (BundleOf t -> a) -> PacketOf t -> a
at_packet
    (Address_Pattern -> Message -> Bool
message_has_address Address_Pattern
x)
    (Address_Pattern -> BundleOf Message -> Bool
bundle_has_address Address_Pattern
x)