module Sound.OSC.Datum where
import Data.Int
import Data.List
import Data.Maybe
import Data.Word
import Numeric
import Text.Read
import qualified Data.ByteString.Lazy as Lazy
import qualified Data.ByteString.Char8 as Char8
import qualified Sound.OSC.Time as Time
type Datum_Type = Char
type ASCII = Char8.ByteString
ascii :: String -> ASCII
ascii :: String -> ASCII
ascii = String -> ASCII
Char8.pack
ascii_to_string :: ASCII -> String
ascii_to_string :: ASCII -> String
ascii_to_string = ASCII -> String
Char8.unpack
type BLOB = Lazy.ByteString
blob_pack :: [Word8] -> BLOB
blob_pack :: [Word8] -> BLOB
blob_pack = [Word8] -> BLOB
Lazy.pack
blob_unpack :: BLOB -> [Word8]
blob_unpack :: BLOB -> [Word8]
blob_unpack = BLOB -> [Word8]
Lazy.unpack
data MIDI = MIDI Word8 Word8 Word8 Word8
deriving (MIDI -> MIDI -> Bool
(MIDI -> MIDI -> Bool) -> (MIDI -> MIDI -> Bool) -> Eq MIDI
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MIDI -> MIDI -> Bool
$c/= :: MIDI -> MIDI -> Bool
== :: MIDI -> MIDI -> Bool
$c== :: MIDI -> MIDI -> Bool
Eq,Int -> MIDI -> ShowS
[MIDI] -> ShowS
MIDI -> String
(Int -> MIDI -> ShowS)
-> (MIDI -> String) -> ([MIDI] -> ShowS) -> Show MIDI
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MIDI] -> ShowS
$cshowList :: [MIDI] -> ShowS
show :: MIDI -> String
$cshow :: MIDI -> String
showsPrec :: Int -> MIDI -> ShowS
$cshowsPrec :: Int -> MIDI -> ShowS
Show,ReadPrec [MIDI]
ReadPrec MIDI
Int -> ReadS MIDI
ReadS [MIDI]
(Int -> ReadS MIDI)
-> ReadS [MIDI] -> ReadPrec MIDI -> ReadPrec [MIDI] -> Read MIDI
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MIDI]
$creadListPrec :: ReadPrec [MIDI]
readPrec :: ReadPrec MIDI
$creadPrec :: ReadPrec MIDI
readList :: ReadS [MIDI]
$creadList :: ReadS [MIDI]
readsPrec :: Int -> ReadS MIDI
$creadsPrec :: Int -> ReadS MIDI
Read)
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}
| ASCII_String {Datum -> ASCII
d_ascii_string :: ASCII}
| Blob {Datum -> BLOB
d_blob :: BLOB}
| TimeStamp {Datum -> Double
d_timestamp :: Time.Time}
| Midi {Datum -> MIDI
d_midi :: MIDI}
deriving (Datum -> Datum -> Bool
(Datum -> Datum -> Bool) -> (Datum -> Datum -> Bool) -> Eq Datum
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]
(Int -> ReadS Datum)
-> ReadS [Datum]
-> ReadPrec Datum
-> ReadPrec [Datum]
-> Read 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
(Int -> Datum -> ShowS)
-> (Datum -> String) -> ([Datum] -> ShowS) -> Show Datum
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)
osc_types_required :: [(Datum_Type,String)]
osc_types_required :: [(Datum_Type, String)]
osc_types_required =
[('i',"Int32")
,('f',"Float")
,('s',"ASCII_String")
,('b',"ByteArray")
]
osc_types_optional :: [(Datum_Type,String)]
osc_types_optional :: [(Datum_Type, String)]
osc_types_optional =
[('h',"Int64")
,('t',"TimeStamp")
,('d',"Double")
,('m',"MIDI")
]
osc_types :: [(Datum_Type,String)]
osc_types :: [(Datum_Type, String)]
osc_types = [(Datum_Type, String)]
osc_types_required [(Datum_Type, String)]
-> [(Datum_Type, String)] -> [(Datum_Type, String)]
forall a. [a] -> [a] -> [a]
++ [(Datum_Type, String)]
osc_types_optional
osc_type_name :: Datum_Type -> Maybe String
osc_type_name :: Datum_Type -> Maybe String
osc_type_name c :: Datum_Type
c = Datum_Type -> [(Datum_Type, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Datum_Type
c [(Datum_Type, String)]
osc_types
osc_type_name_err :: Datum_Type -> String
osc_type_name_err :: Datum_Type -> String
osc_type_name_err = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (ShowS
forall a. HasCallStack => String -> a
error "osc_type_name") (Maybe String -> String)
-> (Datum_Type -> Maybe String) -> Datum_Type -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Datum_Type -> Maybe String
osc_type_name
datum_tag :: Datum -> Datum_Type
datum_tag :: Datum -> Datum_Type
datum_tag d :: Datum
d =
case Datum
d of
Int32 _ -> 'i'
Int64 _ -> 'h'
Float _ -> 'f'
Double _ -> 'd'
ASCII_String _ -> 's'
Blob _ -> 'b'
TimeStamp _ -> 't'
Midi _ -> 'm'
datum_type_name :: Datum -> (Datum_Type,String)
datum_type_name :: Datum -> (Datum_Type, String)
datum_type_name d :: Datum
d = let c :: Datum_Type
c = Datum -> Datum_Type
datum_tag Datum
d in (Datum_Type
c,Datum_Type -> String
osc_type_name_err Datum_Type
c)
datum_integral :: Integral i => Datum -> Maybe i
datum_integral :: Datum -> Maybe i
datum_integral d :: Datum
d =
case Datum
d of
Int32 x :: 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 x :: 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)
_ -> Maybe i
forall a. Maybe a
Nothing
datum_floating :: Floating n => Datum -> Maybe n
datum_floating :: Datum -> Maybe n
datum_floating d :: Datum
d =
case Datum
d of
Int32 n :: 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 n :: 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 n :: 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 n :: 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 n :: 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)
_ -> Maybe n
forall a. Maybe a
Nothing
int32 :: Integral n => n -> Datum
int32 :: 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
int64 :: Integral n => n -> Datum
int64 :: 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
float :: Real n => n -> Datum
float :: 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
double :: Real n => n -> Datum
double :: 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
string :: String -> Datum
string :: String -> Datum
string = ASCII -> Datum
ASCII_String (ASCII -> Datum) -> (String -> ASCII) -> String -> Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ASCII
Char8.pack
midi :: (Word8,Word8,Word8,Word8) -> Datum
midi :: (Word8, Word8, Word8, Word8) -> Datum
midi (p :: Word8
p,q :: Word8
q,r :: Word8
r,s :: Word8
s) = MIDI -> Datum
Midi (Word8 -> Word8 -> Word8 -> Word8 -> MIDI
MIDI Word8
p Word8
q Word8
r Word8
s)
descriptor :: [Datum] -> ASCII
descriptor :: [Datum] -> ASCII
descriptor l :: [Datum]
l = String -> ASCII
Char8.pack (',' Datum_Type -> ShowS
forall a. a -> [a] -> [a]
: (Datum -> Datum_Type) -> [Datum] -> String
forall a b. (a -> b) -> [a] -> [b]
map Datum -> Datum_Type
datum_tag [Datum]
l)
descriptor_tags :: ASCII -> ASCII
descriptor_tags :: ASCII -> ASCII
descriptor_tags = Int -> ASCII -> ASCII
Char8.drop 1
type FP_Precision = Maybe Int
floatPP :: RealFloat n => Maybe Int -> n -> String
floatPP :: Maybe Int -> n -> String
floatPP p :: Maybe Int
p n :: n
n =
let s :: String
s = Maybe Int -> n -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
p n
n ""
s' :: String
s' = (Datum_Type -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Datum_Type -> Datum_Type -> Bool
forall a. Eq a => a -> a -> Bool
== '0') (ShowS
forall a. [a] -> [a]
reverse String
s)
in case String
s' of
'.':_ -> ShowS
forall a. [a] -> [a]
reverse ('0' Datum_Type -> ShowS
forall a. a -> [a] -> [a]
: String
s')
_ -> ShowS
forall a. [a] -> [a]
reverse String
s'
timePP :: FP_Precision -> Time.Time -> String
timePP :: Maybe Int -> Double -> String
timePP = Maybe Int -> Double -> String
forall n. RealFloat n => Maybe Int -> n -> String
floatPP
vecPP :: Show a => [a] -> String
vecPP :: [a] -> String
vecPP v :: [a]
v = '<' Datum_Type -> ShowS
forall a. a -> [a] -> [a]
: String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "," ((a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map a -> String
forall a. Show a => a -> String
show [a]
v) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ">"
datumPP :: FP_Precision -> Datum -> String
datumPP :: Maybe Int -> Datum -> String
datumPP p :: Maybe Int
p d :: Datum
d =
case Datum
d of
Int32 n :: Int32
n -> Int32 -> String
forall a. Show a => a -> String
show Int32
n
Int64 n :: Int64
n -> Int64 -> String
forall a. Show a => a -> String
show Int64
n
Float n :: Float
n -> Maybe Int -> Float -> String
forall n. RealFloat n => Maybe Int -> n -> String
floatPP Maybe Int
p Float
n
Double n :: Double
n -> Maybe Int -> Double -> String
forall n. RealFloat n => Maybe Int -> n -> String
floatPP Maybe Int
p Double
n
ASCII_String s :: ASCII
s -> ShowS
forall a. Show a => a -> String
show (ASCII -> String
Char8.unpack ASCII
s)
Blob s :: BLOB
s -> BLOB -> String
forall a. Show a => a -> String
show BLOB
s
TimeStamp t :: Double
t -> Maybe Int -> Double -> String
timePP Maybe Int
p Double
t
Midi (MIDI b1 :: Word8
b1 b2 :: Word8
b2 b3 :: Word8
b3 b4 :: Word8
b4) -> [Word8] -> String
forall a. Show a => [a] -> String
vecPP [Word8
b1,Word8
b2,Word8
b3,Word8
b4]
datum_pp_typed :: FP_Precision -> Datum -> String
datum_pp_typed :: Maybe Int -> Datum -> String
datum_pp_typed fp :: Maybe Int
fp d :: Datum
d = Maybe Int -> Datum -> String
datumPP Maybe Int
fp Datum
d String -> ShowS
forall a. [a] -> [a] -> [a]
++ ":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Datum_Type, String) -> String
forall a b. (a, b) -> b
snd (Datum -> (Datum_Type, String)
datum_type_name Datum
d)
parse_datum :: Datum_Type -> String -> Maybe Datum
parse_datum :: Datum_Type -> String -> Maybe Datum
parse_datum ty :: Datum_Type
ty =
case Datum_Type
ty of
'i' -> (Int32 -> Datum) -> Maybe Int32 -> Maybe Datum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int32 -> Datum
Int32 (Maybe Int32 -> Maybe Datum)
-> (String -> Maybe Int32) -> String -> Maybe Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Int32
forall a. Read a => String -> Maybe a
readMaybe
'h' -> (Int64 -> Datum) -> Maybe Int64 -> Maybe Datum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> Datum
Int64 (Maybe Int64 -> Maybe Datum)
-> (String -> Maybe Int64) -> String -> Maybe Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Int64
forall a. Read a => String -> Maybe a
readMaybe
'f' -> (Float -> Datum) -> Maybe Float -> Maybe Datum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Float -> Datum
Float (Maybe Float -> Maybe Datum)
-> (String -> Maybe Float) -> String -> Maybe Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Float
forall a. Read a => String -> Maybe a
readMaybe
'd' -> (Double -> Datum) -> Maybe Double -> Maybe Datum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> Datum
Double (Maybe Double -> Maybe Datum)
-> (String -> Maybe Double) -> String -> Maybe Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Double
forall a. Read a => String -> Maybe a
readMaybe
's' -> (String -> Datum) -> Maybe String -> Maybe Datum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ASCII -> Datum
ASCII_String (ASCII -> Datum) -> (String -> ASCII) -> String -> Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ASCII
Char8.pack) (Maybe String -> Maybe Datum)
-> (String -> Maybe String) -> String -> Maybe Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
forall a. Read a => String -> Maybe a
readMaybe
'b' -> ([Word8] -> Datum) -> Maybe [Word8] -> Maybe Datum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (BLOB -> Datum
Blob (BLOB -> Datum) -> ([Word8] -> BLOB) -> [Word8] -> Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> BLOB
blob_pack) (Maybe [Word8] -> Maybe Datum)
-> (String -> Maybe [Word8]) -> String -> Maybe Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe [Word8]
forall a. Read a => String -> Maybe a
readMaybe
't' -> String -> String -> Maybe Datum
forall a. HasCallStack => String -> a
error "parse_datum: timestamp not implemented"
'm' -> ((Word8, Word8, Word8, Word8) -> Datum)
-> Maybe (Word8, Word8, Word8, Word8) -> Maybe Datum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word8, Word8, Word8, Word8) -> Datum
midi (Maybe (Word8, Word8, Word8, Word8) -> Maybe Datum)
-> (String -> Maybe (Word8, Word8, Word8, Word8))
-> String
-> Maybe Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe (Word8, Word8, Word8, Word8)
forall a. Read a => String -> Maybe a
readMaybe
_ -> String -> String -> Maybe Datum
forall a. HasCallStack => String -> a
error "parse_datum: unknown type"
parse_datum_err :: Datum_Type -> String -> Datum
parse_datum_err :: Datum_Type -> String -> Datum
parse_datum_err ty :: Datum_Type
ty = Datum -> Maybe Datum -> Datum
forall a. a -> Maybe a -> a
fromMaybe (String -> Datum
forall a. HasCallStack => String -> a
error "parse_datum") (Maybe Datum -> Datum)
-> (String -> Maybe Datum) -> String -> Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Datum_Type -> String -> Maybe Datum
parse_datum Datum_Type
ty