diff --git a/README b/README --- a/README +++ b/README @@ -3,6 +3,7 @@ [hosc][hosc] <-> [json][json] +~~~~ HOSC JSON --------------------------- ----------------------------------- Int32 0 0 @@ -14,10 +15,23 @@ 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"]] +~~~~ +## cli + +[json-cat](?t=hosc-json&e=md/json-cat.md), +[json-cgi](?t=hosc-json&e=md/json-cgi.md), +[json-console](?t=hosc-json&e=md/json-console.md), +[json-nrt](?t=hosc-json&e=md/json-nrt.md), +[json-ws](?t=hosc-json&e=md/json-ws.md), +[print](?t=hosc-json&e=md/print.md) + +[hosc]: http://rd.slavepianos.org/?t=hosc +[hosc-json]: http://rd.slavepianos.org/?t=hosc-json + [hosc]: http://rd.slavepianos.org/t/hosc [json]: http://www.json.org/ -© [rd](http://rd.slavepianos.org), 2013-2014, [gpl] +© [rd](http://rd.slavepianos.org), 2013-2017, [gpl] [gpl]: http://gnu.org/copyleft/ diff --git a/Sound/OSC/Transport/JSON.hs b/Sound/OSC/Transport/JSON.hs new file mode 100644 --- /dev/null +++ b/Sound/OSC/Transport/JSON.hs @@ -0,0 +1,67 @@ +-- | Trivial UDP server functions. +module Sound.OSC.Transport.JSON where + +import Control.Monad.IO.Class {- transformers -} +import qualified Data.ByteString as B {- bytestring -} +import qualified Data.ByteString.Lazy as B.L {- bytestring -} +import qualified Data.ByteString.Lazy.UTF8 as U {- utf8-string -} +import qualified Data.Text as T {- text -} +import qualified Data.Text.Encoding as T {- text -} +import qualified Data.Text.Lazy as T.L {- text -} +import qualified Data.Text.Lazy.Encoding as T.L {- text -} +import System.Environment {- base -} + +import qualified Sound.OSC as O {- hosc -} + +import qualified Sound.OSC.Type.JSON as J {- hosc-json -} +import qualified Sound.OSC.Type.JSON.Aeson as J {- hosc-json -} + +die :: Show a => a -> t +die = error . show + +type WithT = (O.Connection O.UDP () -> IO ()) + +handle_json :: MonadIO m => WithT -> J.Value -> m () +handle_json withT j = + case J.decode_packet j of + Just o -> liftIO (withT (O.sendOSC o)) + _ -> die ("json_packet",j) + +proc_lb :: MonadIO m => WithT -> B.L.ByteString -> m () +proc_lb withT b = + case J.decode_json b of + Just j -> handle_json withT j + _ -> die ("JSON.decode",b) + +proc_b :: MonadIO m => WithT -> B.ByteString -> m () +proc_b withT = proc_lb withT . B.L.fromStrict + +proc_s :: MonadIO m => WithT -> String -> m () +proc_s withT = proc_lb withT . U.fromString + +proc_t :: MonadIO m => WithT -> T.Text -> m () +proc_t withT = proc_b withT . T.encodeUtf8 + +proc_lt :: MonadIO m => WithT -> T.L.Text -> m () +proc_lt withT = proc_lb withT . T.L.encodeUtf8 + +-- * Options + +opt_parse :: [String] -> (String,Int,Int) +opt_parse a = + case a of + [] -> ("127.0.0.1",57110,9160) + ["-h",h,"-p",p] -> (h,read p,9160) + ["-h",h,"-p",p,"-w",w] -> (h,read p,read w) + _ -> die ("-h host-name -p port-number -w port-number",a) + +data Opt = Opt {with_t :: WithT + ,o_host :: String + ,w_port :: Int} + +opt_arg :: MonadIO m => m Opt +opt_arg = do + a <- liftIO getArgs + let (h,p,w) = opt_parse a + liftIO (print ("(h,p,w)=",(h,p,w))) + return (Opt (O.withTransport (O.openUDP h p)) h w) diff --git a/Sound/OSC/Type/JSON.hs b/Sound/OSC/Type/JSON.hs --- a/Sound/OSC/Type/JSON.hs +++ b/Sound/OSC/Type/JSON.hs @@ -2,12 +2,13 @@ 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 qualified Data.ByteString.Char8 as Char8 {- bytestring -} +import qualified Data.ByteString.Lazy as Lazy {- bytestring -} +import qualified Data.ByteString.Lazy.UTF8 as UTF8 {- utf8-string -} -import Sound.OSC as O {- hosc -} -import Sound.OSC.Type.JSON.Aeson {- hosc-json -} +import qualified Sound.OSC as O {- hosc -} +import qualified Sound.OSC.Datum.Datem as D {- hosc -} +import qualified Sound.OSC.Type.JSON.Aeson as J {- hosc-json -} -- * Library variant @@ -18,15 +19,15 @@ -- | 'String' variant of 'encode_json'. encode_json_str :: Value -> String -encode_json_str = U.toString . encode_json +encode_json_str = UTF8.toString . J.encode_json -- | 'String' variant of 'decode_json'. -- --- > import Sound.OSC.Type.JSON +-- > import Sound.OSChar8.Type.JSON -- > let j = decode_json_str "[\"/n_set\",-1,\"c1\",66]" -- > fmap decode_message j decode_json_str :: String -> Maybe Value -decode_json_str = decode_json . U.fromString +decode_json_str = J.decode_json . UTF8.fromString -- * Encoding @@ -35,30 +36,30 @@ -- | Encode 'Number'. encode_number :: Number -> Value -encode_number = either encode_integer encode_double +encode_number = either J.encode_integer J.encode_double -- | Encode 'O.TimeStamp' data ('O.Time'), ie. the @hosc@ real-valued -- @NRT@ representation. -encode_timestamp :: Time -> Value -encode_timestamp n = encode_assoc ("timestamp",encode_double n) +encode_timestamp :: O.Time -> Value +encode_timestamp n = J.encode_assoc ("timestamp",J.encode_double n) encode_integral :: Integral n => n -> Value -encode_integral = encode_integer . fromIntegral +encode_integral = J.encode_integer . fromIntegral -encode_floating :: (Real n,Floating n) => n -> Value -encode_floating = encode_double . realToFrac +encode_floating :: Real n => n -> Value +encode_floating = J.encode_double . realToFrac --- | Encode 'O.Blob' data ('B.L.ByteString'). -encode_blob :: B.L.ByteString -> Value +-- | Encode 'O.Blob' data ('Lazy.ByteString'). +encode_blob :: Lazy.ByteString -> Value encode_blob b = - let a = encode_list (map encode_integral (B.L.unpack b)) - in encode_assoc ("blob",a) + let a = J.encode_list (map encode_integral (Lazy.unpack b)) + in J.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) +encode_midi :: O.MIDI -> A.Value +encode_midi (O.MIDI p q r s) = + let a = J.encode_list (map encode_integral [p,q,r,s]) + in J.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 @@ -74,17 +75,17 @@ -- > ,(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 :: O.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 + O.Int32 n -> encode_integral n + O.Int64 n -> encode_integral n + O.Float n -> encode_floating n + O.Double n -> encode_floating n + O.ASCII_String s -> J.encode_string (Char8.unpack s) + O.Blob b -> encode_blob b + O.TimeStamp n -> encode_timestamp n + O.Midi m -> encode_midi m -- | 'Message' encoder, the representation is a flat array of -- @address@ and then arguments. @@ -94,11 +95,11 @@ -- -- > 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 +encode_message :: O.Message -> Value +encode_message (O.Message a d) = + let a' = J.encode_string a d' = map encode_datum d - in encode_list (a' : d') + in J.encode_list (a' : d') -- | 'O.Bundle' encoder, the representation is a flat array of @#bundle@ -- tag, 'O.TimeStamp' and then message arrays. @@ -110,19 +111,19 @@ -- > ;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" +encode_bundle :: O.Bundle -> Value +encode_bundle (O.Bundle t m) = + let b = J.encode_string "#bundle" t' = encode_timestamp t m' = map encode_message m - in encode_list (b : t' : m') + in J.encode_list (b : t' : m') -- | 'Packet' encoder. -encode_packet :: Packet -> Value +encode_packet :: O.Packet -> Value encode_packet p = case p of - Packet_Message m -> encode_message m - Packet_Bundle b -> encode_bundle b + O.Packet_Message m -> encode_message m + O.Packet_Bundle b -> encode_bundle b -- * Decoder @@ -130,13 +131,14 @@ -- -- > let m = message "/m" [Int32 1,Float 1] -- > in decode_message (encode_message m) == Just m -decode_message :: Value -> Maybe Message +decode_message :: Value -> Maybe O.Message decode_message j = - case decode_list j of + case J.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') + case J.decode_datum m of + Just (O.ASCII_String m') -> + mapM J.decode_datum d >>= + Just . O.message (Char8.unpack m') _ -> Nothing _ -> Nothing @@ -148,21 +150,21 @@ -- > 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 :: Value -> Maybe O.Bundle decode_bundle j = - case decode_list j of + case J.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' + case (D.datum_string =<< J.decode_datum b,J.decode_datum t) of + (Just "#bundle",Just (O.TimeStamp t')) -> + mapM decode_message m >>= Just . O.Bundle t' _ -> Nothing _ -> Nothing -- | Decode 'Packet'. -decode_packet :: Value -> Maybe Packet +decode_packet :: Value -> Maybe O.Packet decode_packet v = case decode_bundle v of - Just b -> Just (Packet_Bundle b) + Just b -> Just (O.Packet_Bundle b) Nothing -> case decode_message v of - Just m -> Just (Packet_Message m) + Just m -> Just (O.Packet_Message m) Nothing -> Nothing diff --git a/Sound/OSC/Type/JSON/Aeson.hs b/Sound/OSC/Type/JSON/Aeson.hs --- a/Sound/OSC/Type/JSON/Aeson.hs +++ b/Sound/OSC/Type/JSON/Aeson.hs @@ -10,7 +10,7 @@ import Data.Word {- base -} import qualified Data.Text as T {- text -} -import Sound.OSC.Type {- hosc -} +import Sound.OSC.Datum {- hosc -} import Sound.OSC.Type.JSON.Math {- hosc-json -} diff --git a/hosc-json.cabal b/hosc-json.cabal --- a/hosc-json.cabal +++ b/hosc-json.cabal @@ -1,15 +1,15 @@ Name: hosc-json -Version: 0.15 +Version: 0.16 Synopsis: Haskell Open Sound Control JSON Serialisation Description: hosc-json License: GPL Category: Sound -Copyright: (c) Rohan Drape, 2013-2014 +Copyright: (c) Rohan Drape, 2013-2017 Author: Rohan Drape Maintainer: rd@slavepianos.org Stability: Experimental Homepage: http://rd.slavepianos.org/t/hosc-json -Tested-With: GHC == 7.8.2 +Tested-With: GHC == 8.0.1 Build-Type: Simple Cabal-Version: >= 1.8 Data-Files: README @@ -17,17 +17,19 @@ Library Build-Depends: aeson >= 0.7, attoparsec, - base == 4.*, + base >= 4.8 && < 5, bifunctors, - hosc == 0.15.*, + hosc == 0.16.*, bytestring, json, text, + transformers, unordered-containers, utf8-string, vector GHC-Options: -Wall -fwarn-tabs - Exposed-modules: Sound.OSC.Type.JSON + Exposed-modules: Sound.OSC.Transport.JSON + Sound.OSC.Type.JSON Sound.OSC.Type.JSON.Aeson Sound.OSC.Type.JSON.Math