module Sound.OSC.Datum where
import Data.Char
import Data.Int
import Data.List
import Data.Maybe
import Data.Word
import Numeric
import Text.Printf
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
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
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]
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 -> Time
d_double :: !Double}
| ASCII_String {Datum -> ASCII
d_ascii_string :: !ASCII}
| Blob {Datum -> BLOB
d_blob :: !BLOB}
| TimeStamp {Datum -> Time
d_timestamp :: !Time.Time}
| Midi {Datum -> MIDI
d_midi :: !MIDI}
deriving (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)
osc_types_required :: [(Datum_Type,String)]
osc_types_required :: [(Datum_Type, String)]
osc_types_required =
[(Datum_Type
'i',String
"Int32")
,(Datum_Type
'f',String
"Float")
,(Datum_Type
's',String
"ASCII_String")
,(Datum_Type
'b',String
"ByteArray")
]
osc_types_optional :: [(Datum_Type,String)]
osc_types_optional :: [(Datum_Type, String)]
osc_types_optional =
[(Datum_Type
'h',String
"Int64")
,(Datum_Type
't',String
"TimeStamp")
,(Datum_Type
'd',String
"Double")
,(Datum_Type
'm',String
"MIDI")
]
osc_types :: [(Datum_Type,String)]
osc_types :: [(Datum_Type, String)]
osc_types = [(Datum_Type, String)]
osc_types_required 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 Datum_Type
c = 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 = 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
. Datum_Type -> Maybe String
osc_type_name
datum_tag :: Datum -> Datum_Type
datum_tag :: Datum -> Datum_Type
datum_tag Datum
d =
case Datum
d of
Int32 Int32
_ -> Datum_Type
'i'
Int64 Int64
_ -> Datum_Type
'h'
Float Float
_ -> Datum_Type
'f'
Double Time
_ -> Datum_Type
'd'
ASCII_String ASCII
_ -> Datum_Type
's'
Blob BLOB
_ -> Datum_Type
'b'
TimeStamp Time
_ -> Datum_Type
't'
Midi MIDI
_ -> Datum_Type
'm'
datum_type_name :: Datum -> (Datum_Type,String)
datum_type_name :: Datum -> (Datum_Type, String)
datum_type_name 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 :: 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_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 Time
n -> forall a. a -> Maybe a
Just (forall a b. (Real a, Fractional b) => a -> b
realToFrac Time
n)
TimeStamp Time
n -> forall a. a -> Maybe a
Just (forall a b. (Real a, Fractional b) => a -> b
realToFrac Time
n)
Datum
_ -> forall a. Maybe a
Nothing
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
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
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
double :: Real n => n -> Datum
double :: forall n. Real n => n -> Datum
double = Time -> Datum
Double forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Real a, Fractional b) => a -> b
realToFrac
string :: String -> Datum
string :: String -> Datum
string = ASCII -> Datum
ASCII_String 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 (Word8
p,Word8
q,Word8
r,Word8
s) = MIDI -> Datum
Midi (Word8 -> Word8 -> Word8 -> Word8 -> MIDI
MIDI Word8
p Word8
q Word8
r Word8
s)
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 :: [Datum] -> ASCII
descriptor :: [Datum] -> ASCII
descriptor [Datum]
l = String -> ASCII
Char8.pack (Datum_Type
',' forall a. a -> [a] -> [a]
: 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 Int
1
type FP_Precision = Maybe Int
floatPP :: RealFloat n => FP_Precision -> n -> String
floatPP :: forall n. RealFloat n => FP_Precision -> n -> String
floatPP FP_Precision
p n
n =
let s :: String
s = forall a. RealFloat a => FP_Precision -> a -> ShowS
showFFloat FP_Precision
p n
n String
""
s' :: String
s' = forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
== Datum_Type
'0') (forall a. [a] -> [a]
reverse String
s)
in case String
s' of
Datum_Type
'.':String
_ -> forall a. [a] -> [a]
reverse (Datum_Type
'0' forall a. a -> [a] -> [a]
: String
s')
String
_ -> forall a. [a] -> [a]
reverse String
s'
timePP :: FP_Precision -> Time.Time -> String
timePP :: FP_Precision -> Time -> String
timePP = forall n. RealFloat n => FP_Precision -> n -> String
floatPP
vecPP :: (a -> String) -> [a] -> String
vecPP :: forall a. (a -> String) -> [a] -> String
vecPP a -> String
f [a]
v = Datum_Type
'<' forall a. a -> [a] -> [a]
: forall a. [a] -> [[a]] -> [a]
intercalate String
"," (forall a b. (a -> b) -> [a] -> [b]
map a -> String
f [a]
v) forall a. [a] -> [a] -> [a]
++ String
">"
blobPP :: BLOB -> String
blobPP :: BLOB -> String
blobPP = (Datum_Type
'B'forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> String) -> [a] -> String
vecPP (forall r. PrintfType r => String -> r
printf String
"%02X") forall b c a. (b -> c) -> (a -> b) -> a -> c
. BLOB -> [Word8]
Lazy.unpack
stringPP :: String -> String
stringPP :: ShowS
stringPP String
x = if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Datum_Type -> Bool
isSpace String
x then forall a. Show a => a -> String
show String
x else String
x
datumPP :: FP_Precision -> Datum -> String
datumPP :: FP_Precision -> Datum -> String
datumPP FP_Precision
p Datum
d =
case Datum
d of
Int32 Int32
n -> forall a. Show a => a -> String
show Int32
n
Int64 Int64
n -> forall a. Show a => a -> String
show Int64
n
Float Float
n -> forall n. RealFloat n => FP_Precision -> n -> String
floatPP FP_Precision
p Float
n
Double Time
n -> forall n. RealFloat n => FP_Precision -> n -> String
floatPP FP_Precision
p Time
n
ASCII_String ASCII
s -> ShowS
stringPP (ASCII -> String
Char8.unpack ASCII
s)
Blob BLOB
s -> BLOB -> String
blobPP BLOB
s
TimeStamp Time
t -> FP_Precision -> Time -> String
timePP FP_Precision
p Time
t
Midi (MIDI Word8
b1 Word8
b2 Word8
b3 Word8
b4) -> Datum_Type
'M'forall a. a -> [a] -> [a]
: forall a. (a -> String) -> [a] -> String
vecPP forall a. Show a => a -> String
show [Word8
b1,Word8
b2,Word8
b3,Word8
b4]
datum_pp_typed :: FP_Precision -> Datum -> String
datum_pp_typed :: FP_Precision -> Datum -> String
datum_pp_typed FP_Precision
fp Datum
d = FP_Precision -> Datum -> String
datumPP FP_Precision
fp Datum
d forall a. [a] -> [a] -> [a]
++ String
":" forall a. [a] -> [a] -> [a]
++ 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 Datum_Type
ty =
case Datum_Type
ty of
Datum_Type
'i' -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int32 -> Datum
Int32 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> Maybe a
readMaybe
Datum_Type
'h' -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> Datum
Int64 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> Maybe a
readMaybe
Datum_Type
'f' -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Float -> Datum
Float forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> Maybe a
readMaybe
Datum_Type
'd' -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Time -> Datum
Double forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> Maybe a
readMaybe
Datum_Type
's' -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ASCII -> Datum
ASCII_String forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ASCII
Char8.pack) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> Maybe a
readMaybe
Datum_Type
'b' -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (BLOB -> Datum
Blob forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> BLOB
blob_pack) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> Maybe a
readMaybe
Datum_Type
't' -> forall a. HasCallStack => String -> a
error String
"parse_datum: timestamp not implemented"
Datum_Type
'm' -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word8, Word8, Word8, Word8) -> Datum
midi forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> Maybe a
readMaybe
Datum_Type
_ -> forall a. HasCallStack => String -> a
error String
"parse_datum: unknown type"
parse_datum_err :: Datum_Type -> String -> Datum
parse_datum_err :: Datum_Type -> String -> Datum
parse_datum_err Datum_Type
ty = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"parse_datum") forall b c a. (b -> c) -> (a -> b) -> a -> c
. Datum_Type -> String -> Maybe Datum
parse_datum Datum_Type
ty