hosc-json 0.15 → 0.16

raw patch · 5 files changed

+148/−63 lines, 5 filesdep +transformersdep ~basedep ~hoscPVP ok

version bump matches the API change (PVP)

Dependencies added: transformers

Dependency ranges changed: base, hosc

API changes (from Hackage documentation)

Files

• README +15/−1
• Sound/OSC/Transport/JSON.hs +67/−0
• Sound/OSC/Type/JSON.hs +57/−55
• Sound/OSC/Type/JSON/Aeson.hs +1/−1
• hosc-json.cabal +8/−6

@@ -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/

@@ -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)

@@ -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

@@ -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 -} 

@@ -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