diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,23 @@ +hosc-json +--------- + +[hosc][hosc] <-> [json][json] + +HOSC JSON +--------------------------- ----------------------------------- +Int32 0 0 +Float 0.0 0.0 +Double 0.1 0.1 +ASCII_String (pack "s") "s" +Blob (pack [0,1]) {"blob":[0,1]} +TimeStamp 0.0 {"timestamp":0.0} +Midi (MIDI 0 1 2 3) {"midi":[0,1,2,3]} +Message "/m" [Int32 0] ["/m",0] +Bundle 0 [Message "/m" []] ["#bundle",{"timestamp":0.0},["/m"]] + +[hosc]: http://rd.slavepianos.org/?t=hosc +[json]: http://www.json.org/ + +© rd, 2013, [gpl] + +[gpl]: http://gnu.org/copyleft/ diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,3 @@ +#!/usr/bin/env runhaskell +import Distribution.Simple +main = defaultMain diff --git a/Sound/OSC/Type/JSON.hs b/Sound/OSC/Type/JSON.hs new file mode 100644 --- /dev/null +++ b/Sound/OSC/Type/JSON.hs @@ -0,0 +1,157 @@ +-- | Encoding and decoding of OSC types as JSON values. +module Sound.OSC.Type.JSON where + +import qualified Data.Aeson as A {- aeson -} +import qualified Data.ByteString.Char8 as C {- bytestring -} +import qualified Data.ByteString.Lazy as B.L {- bytestring -} +import qualified Data.ByteString.Lazy.UTF8 as U {- utf8-string -} +import Sound.OSC as O {- hosc -} +import Sound.OSC.Type.JSON.Aeson {- hosc -} + +-- * Library variant + +-- | The JSON value type. +type Value = A.Value + +-- * String translation + +-- | 'String' variant of 'encode_json'. +encode_json_str :: Value -> String +encode_json_str = U.toString . encode_json + +-- | 'String' variant of 'decode_json'. +decode_json_str :: String -> Maybe Value +decode_json_str = decode_json . U.fromString + +-- * Encoding + +-- | JSON numbers are 'Either' 'Integer' or 'Double'. +type Number = Either Integer Double + +-- | Encode 'Number'. +encode_number :: Number -> Value +encode_number = either encode_integral encode_floating + +-- | Encode 'O.TimeStamp' data ('O.Time'), ie. the @hosc@ real-valued +-- @NRT@ representation. +encode_timestamp :: Time -> Value +encode_timestamp n = encode_assoc ("timestamp",encode_floating n) + +-- | Encode 'O.Blob' data ('B.L.ByteString'). +encode_blob :: B.L.ByteString -> Value +encode_blob b = + let a = encode_list (map encode_integral (B.L.unpack b)) + in encode_assoc ("blob",a) + +-- | Encode 'O.Midi' data ('Word8' tuple). +encode_midi :: MIDI -> A.Value +encode_midi (MIDI p q r s) = + let a = encode_list (map encode_integral [p,q,r,s]) + in encode_assoc ("midi",a) + +-- | 'Datum' encoder. The encoding is shallow, 'O.Int', 'O.Float' and +-- 'O.Double' are all sent to 'A.Number'. 'O.Blob', 'O.TimeStamp' and +-- 'O.Midi' are tagged. +-- +-- > let {t = [(int32 0,"0") +-- > ,(int64 0,"0") +-- > ,(float 0.0,"0.0") +-- > ,(double 0.1,"0.1") +-- > ,(string "s","\"s\"") +-- > ,(Blob (Data.ByteString.Lazy.pack [0,1]),"{\"blob\":[0,1]}") +-- > ,(TimeStamp 0.0,"{\"timestamp\":0.0}") +-- > ,(midi (0,1,2,3),"{\"midi\":[0,1,2,3]}")] +-- > ;r = map (\(d,s) -> encode_json_str (encode_datum d) == s) t} +-- > in all id r == True +encode_datum :: Datum -> Value +encode_datum d = + case d of + Int32 n -> encode_integral n + Int64 n -> encode_integral n + Float n -> encode_floating n + Double n -> encode_floating n + ASCII_String s -> encode_string (C.unpack s) + Blob b -> encode_blob b + TimeStamp n -> encode_timestamp n + Midi m -> encode_midi m + +-- | 'Message' encoder, the representation is a flat array of +-- @address@ and then arguments. +-- +-- > let m = message "/m" [Int32 0,Float 1,string "s"] +-- > in encode_json_str (encode_message m) +-- +-- > import Sound.SC3 +-- > encode_json_str (encode_message (n_free [0])) == "[\"/n_free\",0]" +encode_message :: Message -> Value +encode_message (Message a d) = + let a' = encode_string a + d' = map encode_datum d + in encode_list (a' : d') + +-- | 'O.Bundle' encoder, the representation is a flat array of @#bundle@ +-- tag, 'O.TimeStamp' and then message arrays. +-- +-- > let b = bundle 0 [message "/m" []] +-- > in encode_json_str (encode_bundle b) +-- +-- > let {b = bundle 0 [c_set1 3 4,n_free [0]] +-- > ;r = "[\"#bundle\",{\"timestamp\":0.0}" ++ +-- > ",[\"/c_set\",3,4.0],[\"/n_free\",0]]"} +-- > in encode_json_str (encode_bundle b) == r +encode_bundle :: Bundle -> Value +encode_bundle (Bundle t m) = + let b = encode_string "#bundle" + t' = encode_timestamp t + m' = map encode_message m + in encode_list (b : t' : m') + +-- | 'Packet' encoder. +encode_packet :: Packet -> Value +encode_packet p = + case p of + Packet_Message m -> encode_message m + Packet_Bundle b -> encode_bundle b + +-- * Decoder + +-- | Decode 'Message'. +-- +-- > let m = message "/m" [Int32 1,Float 1] +-- > in decode_message (encode_message m) == Just m +decode_message :: Value -> Maybe Message +decode_message j = + case decode_list j of + Just (m : d) -> + case decode_datum m of + Just (ASCII_String m') -> mapM decode_datum d >>= + Just . message (C.unpack m') + _ -> Nothing + _ -> Nothing + +-- | Decode 'Bundle'. +-- +-- > let b = bundle 0.0 [message "/m" [Int32 1,Float 1]] +-- > in decode_bundle (encode_bundle b) == Just b +-- +-- > let {b = bundle 0 [c_set1 3 4,n_free [0]] +-- > ;j = encode_bundle b} +-- > in (b,decode_bundle j) +decode_bundle :: Value -> Maybe Bundle +decode_bundle j = + case decode_list j of + Just (b : t : m) -> + case (datum_string =<< decode_datum b,decode_datum t) of + (Just "#bundle",Just (TimeStamp t')) -> + mapM decode_message m >>= Just . Bundle t' + _ -> Nothing + _ -> Nothing + +-- | Decode 'Packet'. +decode_packet :: Value -> Maybe Packet +decode_packet v = + case decode_bundle v of + Just b -> Just (Packet_Bundle b) + Nothing -> case decode_message v of + Just m -> Just (Packet_Message m) + Nothing -> Nothing diff --git a/Sound/OSC/Type/JSON/Aeson.hs b/Sound/OSC/Type/JSON/Aeson.hs new file mode 100644 --- /dev/null +++ b/Sound/OSC/Type/JSON/Aeson.hs @@ -0,0 +1,103 @@ +-- | Encoding and decoding of OSC types as JSON values. +module Sound.OSC.Type.JSON.Aeson where + +import qualified Data.Aeson as A {- aeson -} +import qualified Data.Attoparsec.Number as N {- attoparsec -} +import Data.Bifunctor {- bifunctors -} +import qualified Data.ByteString.Lazy as B.L {- bytestring -} +import qualified Data.HashMap.Strict as M {- unordered-containers -} +import qualified Data.Vector as V {- vector -} +import Data.Word {- base -} +import qualified Data.Text as T {- text -} +import Sound.OSC.Type {- hosc -} + +-- * Library variant + +-- | Encode 'A.Value' to 'B.L.ByteString'. +encode_json :: A.Value -> B.L.ByteString +encode_json = A.encode + +-- | Decode 'A.Value' from 'B.L.ByteString'. +decode_json :: B.L.ByteString -> Maybe A.Value +decode_json = A.decode + +-- * Encoders + +-- | All 'Integral' values are packed to 'Integer'. +encode_integral :: Integral n => n -> A.Value +encode_integral = A.Number . N.I . fromIntegral + +-- | All 'Floating' values are packed to 'Double'. +encode_floating :: (Real n,Floating n) => n -> A.Value +encode_floating = A.Number . N.D . realToFrac + +-- | Pack 'String'. +encode_string :: String -> A.Value +encode_string = A.String . T.pack + +-- | Pack @(key,value)@ pair to 'JSObject'. +-- +-- > encode_assoc ("a",encode_int 0) +encode_assoc :: (String,A.Value) -> A.Value +encode_assoc = A.Object . M.fromList . return . first T.pack + +encode_list :: [A.Value] -> A.Value +encode_list = A.Array . V.fromList + +-- * Decoders + +decode_str :: A.Value -> Maybe String +decode_str j = + case j of + A.String t -> Just (T.unpack t) + _ -> Nothing + +decode_list :: A.Value -> Maybe [A.Value] +decode_list j = + case j of + A.Array a -> Just (V.toList a) + _ -> Nothing + +-- > decode_assoc (encode_assoc ("a",encode_int 0)) +decode_assoc :: A.Value -> Maybe (String,A.Value) +decode_assoc j = + case j of + A.Object o -> + case map (first T.unpack) (M.toList o) of + [(k,v)] -> Just (k,v) + _ -> Nothing + _ -> Nothing + +-- > map decode_number [encode_integral 0,encode_floating 1] +decode_number :: A.Value -> Maybe (Either Integer Double) +decode_number j = + case j of + A.Number n -> case n of + N.I i -> Just (Left i) + N.D d -> Just (Right d) + _ -> Nothing + +decode_word8 :: A.Value -> Maybe Word8 +decode_word8 j = + case decode_number j of + Just (Left i) -> if i < 256 + then Just (fromIntegral i) + else Nothing + _ -> Nothing + +decode_datum :: A.Value -> Maybe Datum +decode_datum j = + case j of + A.Number (N.I n) -> Just (Int64 (fromIntegral n)) + A.Number (N.D n) -> Just (Double n) + A.String t -> Just (string (T.unpack t)) + _ -> case decode_assoc j of + Just ("blob",A.Array v) -> + mapM decode_word8 (V.toList v) >>= Just . Blob . B.L.pack + Just ("midi",A.Array v) -> + case mapM decode_word8 (V.toList v) of + Just [p,q,r,s] -> Just (midi (p,q,r,s)) + _ -> Nothing + Just ("timestamp",A.Number (N.D n)) -> Just (TimeStamp n) + _ -> Nothing + diff --git a/hosc-json.cabal b/hosc-json.cabal new file mode 100644 --- /dev/null +++ b/hosc-json.cabal @@ -0,0 +1,35 @@ +Name: hosc-json +Version: 0.14 +Synopsis: Haskell Open Sound Control JSON Serialisation +Description: hosc-json +License: GPL +Category: Sound +Copyright: (c) Rohan Drape, 2013 +Author: Rohan Drape +Maintainer: rd@slavepianos.org +Stability: Experimental +Homepage: http://rd.slavepianos.org/?t=hosc-json +Tested-With: GHC == 7.6.1 +Build-Type: Simple +Cabal-Version: >= 1.8 +Data-Files: README + +Library + Build-Depends: aeson, + attoparsec, + base == 4.*, + bifunctors, + hosc == 0.14, + bytestring, + json, + text, + unordered-containers, + utf8-string, + vector + GHC-Options: -Wall -fwarn-tabs + Exposed-modules: Sound.OSC.Type.JSON + Sound.OSC.Type.JSON.Aeson + +Source-Repository head + Type: darcs + Location: http://rd.slavepianos.org/sw/hosc-json