-- | Osc data types.
module Sound.Osc.Datum where

import Data.Int {- base -}
import Data.Maybe {- base -}
import Data.Word {- base -}

import qualified Data.ByteString.Char8 as ByteString.Char8 {- bytestring -}
import qualified Data.ByteString.Lazy as ByteString.Lazy {- bytestring -}

-- * Datum

-- | Type enumerating Datum categories.
type DatumType = Char

-- | Type for Ascii strings (strict Char8 ByteString)
type Ascii = ByteString.Char8.ByteString

-- | Type-specialised pack.
ascii :: String -> Ascii
ascii :: String -> Ascii
ascii = String -> Ascii
ByteString.Char8.pack

-- | Type-specialised unpack.
ascii_to_string :: Ascii -> String
ascii_to_string :: Ascii -> String
ascii_to_string = Ascii -> String
ByteString.Char8.unpack

-- | Type for 'Word8' arrays, these are stored with an 'Int32' length prefix.
type Blob = ByteString.Lazy.ByteString

-- | Type-specialised pack.
blob_pack :: [Word8] -> Blob
blob_pack :: [Word8] -> Blob
blob_pack = [Word8] -> Blob
ByteString.Lazy.pack

-- | Type-specialised pack.
blob_pack_int :: [Int] -> Blob
blob_pack_int :: [Int] -> Blob
blob_pack_int = [Word8] -> Blob
ByteString.Lazy.pack ([Word8] -> Blob) -> ([Int] -> [Word8]) -> [Int] -> Blob
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Word8) -> [Int] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Type-specialised unpack.
blob_unpack :: Blob -> [Word8]
blob_unpack :: Blob -> [Word8]
blob_unpack = Blob -> [Word8]
ByteString.Lazy.unpack

-- | Type-specialised unpack.
blob_unpack_int :: Blob -> [Int]
blob_unpack_int :: Blob -> [Int]
blob_unpack_int = (Word8 -> Int) -> [Word8] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Word8] -> [Int]) -> (Blob -> [Word8]) -> Blob -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blob -> [Word8]
blob_unpack

-- | Four-byte midi message: port-id, status-byte, data, data.
data MidiData = MidiData !Word8 !Word8 !Word8 !Word8
  deriving (Eq MidiData
Eq MidiData =>
(MidiData -> MidiData -> Ordering)
-> (MidiData -> MidiData -> Bool)
-> (MidiData -> MidiData -> Bool)
-> (MidiData -> MidiData -> Bool)
-> (MidiData -> MidiData -> Bool)
-> (MidiData -> MidiData -> MidiData)
-> (MidiData -> MidiData -> MidiData)
-> Ord MidiData
MidiData -> MidiData -> Bool
MidiData -> MidiData -> Ordering
MidiData -> MidiData -> MidiData
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 :: MidiData -> MidiData -> Ordering
compare :: MidiData -> MidiData -> Ordering
$c< :: MidiData -> MidiData -> Bool
< :: MidiData -> MidiData -> Bool
$c<= :: MidiData -> MidiData -> Bool
<= :: MidiData -> MidiData -> Bool
$c> :: MidiData -> MidiData -> Bool
> :: MidiData -> MidiData -> Bool
$c>= :: MidiData -> MidiData -> Bool
>= :: MidiData -> MidiData -> Bool
$cmax :: MidiData -> MidiData -> MidiData
max :: MidiData -> MidiData -> MidiData
$cmin :: MidiData -> MidiData -> MidiData
min :: MidiData -> MidiData -> MidiData
Ord, MidiData -> MidiData -> Bool
(MidiData -> MidiData -> Bool)
-> (MidiData -> MidiData -> Bool) -> Eq MidiData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MidiData -> MidiData -> Bool
== :: MidiData -> MidiData -> Bool
$c/= :: MidiData -> MidiData -> Bool
/= :: MidiData -> MidiData -> Bool
Eq, Int -> MidiData -> ShowS
[MidiData] -> ShowS
MidiData -> String
(Int -> MidiData -> ShowS)
-> (MidiData -> String) -> ([MidiData] -> ShowS) -> Show MidiData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MidiData -> ShowS
showsPrec :: Int -> MidiData -> ShowS
$cshow :: MidiData -> String
show :: MidiData -> String
$cshowList :: [MidiData] -> ShowS
showList :: [MidiData] -> ShowS
Show, ReadPrec [MidiData]
ReadPrec MidiData
Int -> ReadS MidiData
ReadS [MidiData]
(Int -> ReadS MidiData)
-> ReadS [MidiData]
-> ReadPrec MidiData
-> ReadPrec [MidiData]
-> Read MidiData
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS MidiData
readsPrec :: Int -> ReadS MidiData
$creadList :: ReadS [MidiData]
readList :: ReadS [MidiData]
$creadPrec :: ReadPrec MidiData
readPrec :: ReadPrec MidiData
$creadListPrec :: ReadPrec [MidiData]
readListPrec :: ReadPrec [MidiData]
Read)

midi_pack :: [Word8] -> MidiData
midi_pack :: [Word8] -> MidiData
midi_pack [Word8]
w =
  case [Word8]
w of
    [Word8
m1, Word8
m2, Word8
m3, Word8
m4] -> Word8 -> Word8 -> Word8 -> Word8 -> MidiData
MidiData Word8
m1 Word8
m2 Word8
m3 Word8
m4
    [Word8]
_ -> String -> MidiData
forall a. HasCallStack => String -> a
error String
"midi_pack?"

-- | Type-specialised pack.
midi_pack_int :: [Int] -> MidiData
midi_pack_int :: [Int] -> MidiData
midi_pack_int = [Word8] -> MidiData
midi_pack ([Word8] -> MidiData) -> ([Int] -> [Word8]) -> [Int] -> MidiData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Word8) -> [Int] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Type-specialised unpack.
midi_unpack_int :: MidiData -> [Int]
midi_unpack_int :: MidiData -> [Int]
midi_unpack_int (MidiData Word8
m1 Word8
m2 Word8
m3 Word8
m4) = (Word8 -> Int) -> [Word8] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Word8
m1, Word8
m2, Word8
m3, Word8
m4]

{- | A real-valued time stamp.
For Osc proper this is an Ntp64 time in real-valued (fractional) form.
For SuperCollider Nrt programs this is elapsed time since the start of the score.
This is the primary form of timestamp used by hosc.
-}
type Time = Double

-- | The basic elements of Osc messages.
data Datum
  = Int32 {Datum -> Int32
d_int32 :: !Int32}
  | Int64 {Datum -> Int64
d_int64 :: !Int64}
  | Float {Datum -> Float
d_float :: !Float}
  | Double {Datum -> Double
d_double :: !Double}
  | AsciiString {Datum -> Ascii
d_ascii_string :: !Ascii}
  | Blob {Datum -> Blob
d_blob :: !Blob}
  | TimeStamp {Datum -> Double
d_timestamp :: !Time} -- ie. real valued Ntp
  | Midi {Datum -> MidiData
d_midi :: !MidiData}
  deriving (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, 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, ReadPrec [Datum]
ReadPrec Datum
Int -> ReadS Datum
ReadS [Datum]
(Int -> ReadS Datum)
-> ReadS [Datum]
-> ReadPrec Datum
-> ReadPrec [Datum]
-> Read Datum
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Datum
readsPrec :: Int -> ReadS Datum
$creadList :: ReadS [Datum]
readList :: ReadS [Datum]
$creadPrec :: ReadPrec Datum
readPrec :: ReadPrec Datum
$creadListPrec :: ReadPrec [Datum]
readListPrec :: ReadPrec [Datum]
Read, 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)

-- * Datum types

-- | List of required data types (tag, name).
osc_types_required :: [(DatumType, String)]
osc_types_required :: [(DatumType, String)]
osc_types_required =
  [ (DatumType
'i', String
"Int32")
  , (DatumType
'f', String
"Float")
  , (DatumType
's', String
"String") -- Ascii
  , (DatumType
'b', String
"Blob")
  ]

-- | List of optional data types (tag,name).
osc_types_optional :: [(DatumType, String)]
osc_types_optional :: [(DatumType, String)]
osc_types_optional =
  [ (DatumType
'h', String
"Int64")
  , (DatumType
't', String
"TimeStamp")
  , (DatumType
'd', String
"Double")
  , -- ,('S',"Symbol")
    -- ,('c',"Character")
    -- ,('r',"RGBA")
    (DatumType
'm', String
"Midi")
    -- ,('T',"True")
    -- ,('F',"False")
    -- ,('N',"Nil")
    -- ,('I',"Infinitum")
    -- ,('[',"Array_Begin")
    -- ,(']',"Array_End")
  ]

-- | List of all data types (tag,name).
osc_types :: [(DatumType, String)]
osc_types :: [(DatumType, String)]
osc_types = [(DatumType, String)]
osc_types_required [(DatumType, String)]
-> [(DatumType, String)] -> [(DatumType, String)]
forall a. [a] -> [a] -> [a]
++ [(DatumType, String)]
osc_types_optional

-- | Lookup name of type.
osc_type_name :: DatumType -> Maybe String
osc_type_name :: DatumType -> Maybe String
osc_type_name DatumType
c = DatumType -> [(DatumType, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup DatumType
c [(DatumType, String)]
osc_types

-- | Erroring variant.
osc_type_name_err :: DatumType -> String
osc_type_name_err :: DatumType -> String
osc_type_name_err = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (ShowS
forall a. HasCallStack => String -> a
error String
"osc_type_name") (Maybe String -> String)
-> (DatumType -> Maybe String) -> DatumType -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DatumType -> Maybe String
osc_type_name

-- | Single character identifier of an Osc datum.
datum_tag :: Datum -> DatumType
datum_tag :: Datum -> DatumType
datum_tag Datum
d =
  case Datum
d of
    Int32 Int32
_ -> DatumType
'i'
    Int64 Int64
_ -> DatumType
'h'
    Float Float
_ -> DatumType
'f'
    Double Double
_ -> DatumType
'd'
    AsciiString Ascii
_ -> DatumType
's'
    Blob Blob
_ -> DatumType
'b'
    TimeStamp Double
_ -> DatumType
't'
    Midi MidiData
_ -> DatumType
'm'

-- | Type and name of 'Datum'.
datum_type_name :: Datum -> (DatumType, String)
datum_type_name :: Datum -> (DatumType, String)
datum_type_name Datum
d = let c :: DatumType
c = Datum -> DatumType
datum_tag Datum
d in (DatumType
c, DatumType -> String
osc_type_name_err DatumType
c)

-- * Generalised element access

{- | 'Datum' as 'Integral' if Int32 or Int64.

>>> let d = [Int32 5,Int64 5,Float 5.5,Double 5.5]
>>> map datum_integral d == [Just (5::Int),Just 5,Nothing,Nothing]
True
-}
datum_integral :: Integral i => Datum -> Maybe i
datum_integral :: forall i. Integral i => Datum -> Maybe i
datum_integral Datum
d =
  case Datum
d of
    Int32 Int32
x -> i -> Maybe i
forall a. a -> Maybe a
Just (Int32 -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
x)
    Int64 Int64
x -> i -> Maybe i
forall a. a -> Maybe a
Just (Int64 -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
x)
    Datum
_ -> Maybe i
forall a. Maybe a
Nothing

{- | 'Datum' as 'Floating' if Int32, Int64, Float, Double or TimeStamp.

>>> let d = [Int32 5,Int64 5,Float 5,Double 5,TimeStamp 5]
>>> mapMaybe datum_floating d == replicate 5 (5::Double)
True
-}
datum_floating :: Floating n => Datum -> Maybe n
datum_floating :: forall n. Floating n => Datum -> Maybe n
datum_floating Datum
d =
  case Datum
d of
    Int32 Int32
n -> n -> Maybe n
forall a. a -> Maybe a
Just (Int32 -> n
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
n)
    Int64 Int64
n -> n -> Maybe n
forall a. a -> Maybe a
Just (Int64 -> n
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
n)
    Float Float
n -> n -> Maybe n
forall a. a -> Maybe a
Just (Float -> n
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
n)
    Double Double
n -> n -> Maybe n
forall a. a -> Maybe a
Just (Double -> n
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
n)
    TimeStamp Double
n -> n -> Maybe n
forall a. a -> Maybe a
Just (Double -> n
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
n)
    Datum
_ -> Maybe n
forall a. Maybe a
Nothing

-- * Constructors

{- | Type generalised 'Int32'.

>>> int32 (1::Int32) == int32 (1::Integer)
True

>>> d_int32 (int32 (maxBound::Int32)) == maxBound
True

>>> int32 (((2::Int) ^ (64::Int))::Int) == Int32 0
True
-}
int32 :: Integral n => n -> Datum
int32 :: forall n. Integral n => n -> Datum
int32 = Int32 -> Datum
Int32 (Int32 -> Datum) -> (n -> Int32) -> n -> Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral

{- | Type generalised Int64.

>>> int64 (1::Int32) == int64 (1::Integer)
True

>>> d_int64 (int64 (maxBound::Int64)) == maxBound
True
-}
int64 :: Integral n => n -> Datum
int64 :: forall n. Integral n => n -> Datum
int64 = Int64 -> Datum
Int64 (Int64 -> Datum) -> (n -> Int64) -> n -> Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

{- | Type generalised Float.

>>> float (1::Int) == float (1::Double)
True

>>> floatRange (undefined::Float)
(-125,128)

>>> isInfinite (d_float (float (encodeFloat 1 256 :: Double)))
True
-}
float :: Real n => n -> Datum
float :: forall n. Real n => n -> Datum
float = Float -> Datum
Float (Float -> Datum) -> (n -> Float) -> n -> Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac

{- | Type generalised Double.

>>> double (1::Int) == double (1::Double)
True

>>> double (encodeFloat 1 256 :: Double) == Double 1.157920892373162e77
True
-}
double :: Real n => n -> Datum
double :: forall n. Real n => n -> Datum
double = Double -> Datum
Double (Double -> Datum) -> (n -> Double) -> n -> Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac

{- | 'AsciiString' of pack.

>>> string "string" == AsciiString (ByteString.Char8.pack "string")
True
-}
string :: String -> Datum
string :: String -> Datum
string = Ascii -> Datum
AsciiString (Ascii -> Datum) -> (String -> Ascii) -> String -> Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Ascii
ascii

{- | Four-tuple variant of 'Midi' '.' 'MidiData'.

>>> midi (0,0,0,0) == Midi (MidiData 0 0 0 0)
True
-}
midi :: (Word8, Word8, Word8, Word8) -> Datum
midi :: (Word8, Word8, Word8, Word8) -> Datum
midi (Word8
p, Word8
q, Word8
r, Word8
s) = MidiData -> Datum
Midi (Word8 -> Word8 -> Word8 -> Word8 -> MidiData
MidiData Word8
p Word8
q Word8
r Word8
s)

-- | 'Blob' of 'blob_pack'.
blob :: [Word8] -> Datum
blob :: [Word8] -> Datum
blob = Blob -> Datum
Blob (Blob -> Datum) -> ([Word8] -> Blob) -> [Word8] -> Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> Blob
blob_pack

-- * Descriptor

{- | Message argument types are given by a signature.

>>> signatureFor [Int32 1,Float 1,string "1"]
",ifs"
-}
signatureFor :: [Datum] -> String
signatureFor :: [Datum] -> String
signatureFor = (DatumType
',' DatumType -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> ([Datum] -> String) -> [Datum] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Datum -> DatumType) -> [Datum] -> String
forall a b. (a -> b) -> [a] -> [b]
map Datum -> DatumType
datum_tag

{- | The descriptor is an Ascii encoded signature.

>>> descriptor [Int32 1,Float 1,string "1"] == ascii ",ifs"
True
-}
descriptor :: [Datum] -> Ascii
descriptor :: [Datum] -> Ascii
descriptor = String -> Ascii
ascii (String -> Ascii) -> ([Datum] -> String) -> [Datum] -> Ascii
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Datum] -> String
signatureFor

-- | Descriptor tags are @comma@ prefixed.
descriptor_tags :: Ascii -> Ascii
descriptor_tags :: Ascii -> Ascii
descriptor_tags = Int -> Ascii -> Ascii
ByteString.Char8.drop Int
1