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

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

import qualified Data.ByteString.Lazy as ByteString.Lazy {- bytestring -}
import qualified Data.ByteString.Char8 as ByteString.Char8 {- 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 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 = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral 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
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
min :: MidiData -> MidiData -> MidiData
$cmin :: MidiData -> MidiData -> MidiData
max :: MidiData -> MidiData -> MidiData
$cmax :: MidiData -> MidiData -> MidiData
>= :: MidiData -> MidiData -> Bool
$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
compare :: MidiData -> MidiData -> Ordering
$ccompare :: MidiData -> MidiData -> Ordering
Ord, MidiData -> MidiData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MidiData -> MidiData -> Bool
$c/= :: MidiData -> MidiData -> Bool
== :: MidiData -> MidiData -> Bool
$c== :: MidiData -> MidiData -> Bool
Eq, Int -> MidiData -> ShowS
[MidiData] -> ShowS
MidiData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MidiData] -> ShowS
$cshowList :: [MidiData] -> ShowS
show :: MidiData -> String
$cshow :: MidiData -> String
showsPrec :: Int -> MidiData -> ShowS
$cshowsPrec :: Int -> MidiData -> ShowS
Show, ReadPrec [MidiData]
ReadPrec MidiData
Int -> ReadS MidiData
ReadS [MidiData]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MidiData]
$creadListPrec :: ReadPrec [MidiData]
readPrec :: ReadPrec MidiData
$creadPrec :: ReadPrec MidiData
readList :: ReadS [MidiData]
$creadList :: ReadS [MidiData]
readsPrec :: Int -> ReadS MidiData
$creadsPrec :: Int -> ReadS 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]
_ -> forall a. HasCallStack => String -> a
error String
"midi_pack?"

-- | 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) = forall a b. (a -> b) -> [a] -> [b]
map 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
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
min :: Datum -> Datum -> Datum
$cmin :: Datum -> Datum -> Datum
max :: Datum -> Datum -> Datum
$cmax :: Datum -> Datum -> Datum
>= :: Datum -> Datum -> Bool
$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
compare :: Datum -> Datum -> Ordering
$ccompare :: Datum -> Datum -> Ordering
Ord, Datum -> Datum -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Datum -> Datum -> Bool
$c/= :: Datum -> Datum -> Bool
== :: Datum -> Datum -> Bool
$c== :: Datum -> Datum -> Bool
Eq, ReadPrec [Datum]
ReadPrec Datum
Int -> ReadS Datum
ReadS [Datum]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Datum]
$creadListPrec :: ReadPrec [Datum]
readPrec :: ReadPrec Datum
$creadPrec :: ReadPrec Datum
readList :: ReadS [Datum]
$creadList :: ReadS [Datum]
readsPrec :: Int -> ReadS Datum
$creadsPrec :: Int -> ReadS Datum
Read, Int -> Datum -> ShowS
[Datum] -> ShowS
Datum -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Datum] -> ShowS
$cshowList :: [Datum] -> ShowS
show :: Datum -> String
$cshow :: Datum -> String
showsPrec :: Int -> Datum -> ShowS
$cshowsPrec :: Int -> 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 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 = 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 = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"osc_type_name") 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]
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 -> forall a. a -> Maybe a
Just (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
x)
      Int64 Int64
x -> forall a. a -> Maybe a
Just (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
x)
      Datum
_ -> 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)
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 -> forall a. a -> Maybe a
Just (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
n)
      Int64 Int64
n -> forall a. a -> Maybe a
Just (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
n)
      Float Float
n -> forall a. a -> Maybe a
Just (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
n)
      Double Double
n -> forall a. a -> Maybe a
Just (forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
n)
      TimeStamp Double
n -> forall a. a -> Maybe a
Just (forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
n)
      Datum
_ -> forall a. Maybe a
Nothing

-- * Constructors

-- | Type generalised 'Int32'.
--
-- > int32 (1::Int32) == int32 (1::Integer)
-- > d_int32 (int32 (maxBound::Int32)) == maxBound
-- > int32 (((2::Int) ^ (64::Int))::Int) == Int32 0
int32 :: Integral n => n -> Datum
int32 :: forall n. Integral n => n -> Datum
int32 = Int32 -> Datum
Int32 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Type generalised Int64.
--
-- > int64 (1::Int32) == int64 (1::Integer)
-- > d_int64 (int64 (maxBound::Int64)) == maxBound
int64 :: Integral n => n -> Datum
int64 :: forall n. Integral n => n -> Datum
int64 = Int64 -> Datum
Int64 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Type generalised Float.
--
-- > float (1::Int) == float (1::Double)
-- > 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Real a, Fractional b) => a -> b
realToFrac

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

-- | 'AsciiString' of pack.
--
-- > string "string" == AsciiString (ByteString.Char8.pack "string")
string :: String -> Datum
string :: String -> Datum
string = Ascii -> Datum
AsciiString 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)
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 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
',' forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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"
-}
descriptor :: [Datum] -> Ascii
descriptor :: [Datum] -> Ascii
descriptor = String -> Ascii
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