-- | 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
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
min :: Message -> Message -> Message
$cmin :: Message -> Message -> Message
max :: Message -> Message -> Message
$cmax :: Message -> Message -> Message
>= :: Message -> Message -> Bool
$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
compare :: Message -> Message -> Ordering
$ccompare :: Message -> Message -> Ordering
Ord, Message -> Message -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Message -> Message -> Bool
$c/= :: Message -> Message -> Bool
== :: Message -> Message -> Bool
$c== :: Message -> Message -> Bool
Eq, ReadPrec [Message]
ReadPrec Message
Int -> ReadS Message
ReadS [Message]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Message]
$creadListPrec :: ReadPrec [Message]
readPrec :: ReadPrec Message
$creadPrec :: ReadPrec Message
readList :: ReadS [Message]
$creadList :: ReadS [Message]
readsPrec :: Int -> ReadS Message
$creadsPrec :: Int -> ReadS Message
Read, Int -> Message -> ShowS
[Message] -> ShowS
Message -> Address_Pattern
forall a.
(Int -> a -> ShowS)
-> (a -> Address_Pattern) -> ([a] -> ShowS) -> Show a
showList :: [Message] -> ShowS
$cshowList :: [Message] -> ShowS
show :: Message -> Address_Pattern
$cshow :: Message -> Address_Pattern
showsPrec :: Int -> Message -> ShowS
$cshowsPrec :: Int -> 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
_ -> 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message -> [Datum]
messageDatum

messageDescriptor :: Message -> Ascii
messageDescriptor :: Message -> Ascii
messageDescriptor = [Datum] -> Ascii
descriptor 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.
Do not allow recursion, all contents must be messages.
-}
data Bundle =
  Bundle
  {Bundle -> Time
bundleTime :: !Time
  ,Bundle -> [Message]
bundleMessages :: ![Message]}
  deriving (Bundle -> Bundle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bundle -> Bundle -> Bool
$c/= :: Bundle -> Bundle -> Bool
== :: Bundle -> Bundle -> Bool
$c== :: Bundle -> Bundle -> Bool
Eq,ReadPrec [Bundle]
ReadPrec Bundle
Int -> ReadS Bundle
ReadS [Bundle]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Bundle]
$creadListPrec :: ReadPrec [Bundle]
readPrec :: ReadPrec Bundle
$creadPrec :: ReadPrec Bundle
readList :: ReadS [Bundle]
$creadList :: ReadS [Bundle]
readsPrec :: Int -> ReadS Bundle
$creadsPrec :: Int -> ReadS Bundle
Read,Int -> Bundle -> ShowS
[Bundle] -> ShowS
Bundle -> Address_Pattern
forall a.
(Int -> a -> ShowS)
-> (a -> Address_Pattern) -> ([a] -> ShowS) -> Show a
showList :: [Bundle] -> ShowS
$cshowList :: [Bundle] -> ShowS
show :: Bundle -> Address_Pattern
$cshow :: Bundle -> Address_Pattern
showsPrec :: Int -> Bundle -> ShowS
$cshowsPrec :: Int -> Bundle -> ShowS
Show)

-- | Osc 'Bundle's can be ordered (time ascending).
instance Ord Bundle where
    compare :: Bundle -> Bundle -> Ordering
compare (Bundle Time
a [Message]
_) (Bundle Time
b [Message]
_) = 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 -> [Message] -> Bundle
bundle :: Time -> [Message] -> Bundle
bundle Time
t [Message]
xs =
    case [Message]
xs of
      [] -> forall a. HasCallStack => Address_Pattern -> a
error Address_Pattern
"bundle: empty?"
      [Message]
_ -> Time -> [Message] -> Bundle
Bundle Time
t [Message]
xs

-- * Packet

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

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

-- | 'Packet_Message' of 'message'.
p_message :: Address_Pattern -> [Datum] -> Packet
p_message :: Address_Pattern -> [Datum] -> Packet
p_message Address_Pattern
a = Message -> Packet
Packet_Message 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@.

> ntpr_to_ntpi immediately == 1
-}
immediately :: Time
immediately :: Time
immediately = Time
1 forall a. Fractional a => a -> a -> a
/ Time
2forall 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 :: Packet -> Time
packetTime :: Packet -> Time
packetTime = forall a. (Message -> a) -> (Bundle -> a) -> Packet -> a
at_packet (forall a b. a -> b -> a
const Time
immediately) Bundle -> Time
bundleTime

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

-- | If 'Packet' is a 'Message' add 'immediately' timestamp, else 'id'.
packet_to_bundle :: Packet -> Bundle
packet_to_bundle :: Packet -> Bundle
packet_to_bundle = forall a. (Message -> a) -> (Bundle -> a) -> Packet -> a
at_packet (\Message
m -> Time -> [Message] -> Bundle
Bundle Time
immediately [Message
m]) 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 :: Packet -> Maybe Message
packet_to_message :: Packet -> Maybe Message
packet_to_message Packet
p =
    case Packet
p of
      Packet_Bundle Bundle
b ->
          case Bundle
b of
            Bundle Time
t [Message
m] -> if Time
t forall a. Eq a => a -> a -> Bool
== Time
immediately then forall a. a -> Maybe a
Just Message
m else forall a. Maybe a
Nothing
            Bundle
_ -> forall a. Maybe a
Nothing
      Packet_Message Message
m -> forall a. a -> Maybe a
Just Message
m

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

-- | Variant of 'either' for 'Packet'.
at_packet :: (Message -> a) -> (Bundle -> a) -> Packet -> a
at_packet :: forall a. (Message -> a) -> (Bundle -> a) -> Packet -> a
at_packet Message -> a
f Bundle -> a
g Packet
p =
    case Packet
p of
      Packet_Message Message
m -> Message -> a
f Message
m
      Packet_Bundle Bundle
b -> Bundle -> a
g Bundle
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 = (forall a. Eq a => a -> a -> Bool
== Address_Pattern
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message -> Address_Pattern
messageAddress

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

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