diff --git a/README b/README --- a/README +++ b/README @@ -15,9 +15,9 @@ Message "/m" [Int32 0] ["/m",0] Bundle 0 [Message "/m" []] ["#bundle",{"timestamp":0.0},["/m"]] -[hosc]: http://rd.slavepianos.org/?t=hosc +[hosc]: http://rd.slavepianos.org/t/hosc [json]: http://www.json.org/ -© rd, 2013, [gpl] +© [rd](http://rd.slavepianos.org), 2013-2014, [gpl] [gpl]: http://gnu.org/copyleft/ 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 @@ -5,8 +5,9 @@ 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 -} +import Sound.OSC.Type.JSON.Aeson {- hosc-json -} -- * Library variant @@ -20,6 +21,10 @@ encode_json_str = U.toString . encode_json -- | 'String' variant of 'decode_json'. +-- +-- > import Sound.OSC.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 @@ -30,12 +35,18 @@ -- | Encode 'Number'. encode_number :: Number -> Value -encode_number = either encode_integral encode_floating +encode_number = either encode_integer 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_floating n) +encode_timestamp n = encode_assoc ("timestamp",encode_double n) + +encode_integral :: Integral n => n -> Value +encode_integral = encode_integer . fromIntegral + +encode_floating :: (Real n,Floating n) => n -> Value +encode_floating = encode_double . realToFrac -- | Encode 'O.Blob' data ('B.L.ByteString'). encode_blob :: B.L.ByteString -> Value 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 @@ -2,15 +2,18 @@ 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 Data.Maybe {- base -} import qualified Data.Vector as V {- vector -} import Data.Word {- base -} import qualified Data.Text as T {- text -} + import Sound.OSC.Type {- hosc -} +import Sound.OSC.Type.JSON.Math {- hosc-json -} + -- * Library variant -- | Encode 'A.Value' to 'B.L.ByteString'. @@ -24,12 +27,12 @@ -- * Encoders -- | All 'Integral' values are packed to 'Integer'. -encode_integral :: Integral n => n -> A.Value -encode_integral = A.Number . N.I . fromIntegral +encode_integer :: Integer -> A.Value +encode_integer = A.toJSON -- | All 'Floating' values are packed to 'Double'. -encode_floating :: (Real n,Floating n) => n -> A.Value -encode_floating = A.Number . N.D . realToFrac +encode_double :: Double -> A.Value +encode_double = A.toJSON -- | Pack 'String'. encode_string :: String -> A.Value @@ -68,28 +71,51 @@ _ -> Nothing _ -> Nothing +result_maybe :: A.Result a -> Maybe a +result_maybe r = + case r of + A.Success r' -> Just r' + A.Error _ -> Nothing + +decode_integer :: A.Value -> Maybe Integer +decode_integer = result_maybe . A.fromJSON + +decode_double :: A.Value -> Maybe Double +decode_double = result_maybe . A.fromJSON + -- > 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 + case decode_integer j of + Just i -> Just (Left i) + Nothing -> case decode_double j of + Just d -> Just (Right d) + Nothing -> Nothing +decode_double_err :: A.Value -> Double +decode_double_err = fromMaybe (error "decode_double") . decode_double + +decode_number_err :: A.Value -> Either Integer Double +decode_number_err = fromMaybe (error "decode_number") . decode_number + 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 + case decode_integer j of + Just 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.Number _ -> case decode_number_err j of + Left n -> if in_int32 n + then Just (Int32 (fromIntegral n)) + else Just (Int64 (fromIntegral n)) + Right n -> if True + then Just (Float (realToFrac n)) + else Just (Double n) A.String t -> Just (string (T.unpack t)) _ -> case decode_assoc j of Just ("blob",A.Array v) -> @@ -98,6 +124,6 @@ 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) + Just ("timestamp",n) -> Just (TimeStamp (decode_double_err n)) _ -> Nothing diff --git a/Sound/OSC/Type/JSON/Math.hs b/Sound/OSC/Type/JSON/Math.hs new file mode 100644 --- /dev/null +++ b/Sound/OSC/Type/JSON/Math.hs @@ -0,0 +1,44 @@ +module Sound.OSC.Type.JSON.Math where + +import Data.Int {- base -} +import Data.Ratio {- base -} +import Data.Word {- base -} + +in_range :: (Integral r,Integral n) => r -> r -> n -> Bool +in_range l r n = + let f :: Integral i => i -> Integer + f = fromIntegral + in f n >= f l && f n <= f r + +-- > map in_int8 [-129,-128,0,127,128] +in_int8 :: Integral a => a -> Bool +in_int8 = in_range (minBound::Int8) (maxBound::Int8) + +in_int16 :: Integral a => a -> Bool +in_int16 = in_range (minBound::Int16) (maxBound::Int16) + +in_int32 :: Integral a => a -> Bool +in_int32 = in_range (minBound::Int32) (maxBound::Int32) + +in_int64 :: Integral a => a -> Bool +in_int64 = in_range (minBound::Int64) (maxBound::Int64) + +-- * Rational number predicates + +-- | Is /n/ integral, ie. is 'denominator' @1@. +ratio_is_integral :: Integral n => Ratio n -> Bool +ratio_is_integral = (== 1) . denominator + +-- | Is /n/ integral, and '<=' to /m/. +ratio_is_bounded_integral :: Integral n => n -> Ratio n -> Bool +ratio_is_bounded_integral m n = + ratio_is_integral n && + numerator n <= m + +-- | Is /n/ integral and in range for 'Int'. +ratio_is_int :: Integral n => Ratio n -> Bool +ratio_is_int = ratio_is_bounded_integral (fromIntegral (maxBound::Int)) + +-- | Is /n/ integral and in range for 'Word8'. +ratio_is_word8 :: Integral n => Ratio n -> Bool +ratio_is_word8 = ratio_is_bounded_integral (fromIntegral (maxBound::Word8)) diff --git a/hosc-json.cabal b/hosc-json.cabal --- a/hosc-json.cabal +++ b/hosc-json.cabal @@ -1,25 +1,25 @@ Name: hosc-json -Version: 0.14 +Version: 0.15 Synopsis: Haskell Open Sound Control JSON Serialisation Description: hosc-json License: GPL Category: Sound -Copyright: (c) Rohan Drape, 2013 +Copyright: (c) Rohan Drape, 2013-2014 Author: Rohan Drape Maintainer: rd@slavepianos.org Stability: Experimental -Homepage: http://rd.slavepianos.org/?t=hosc-json -Tested-With: GHC == 7.6.1 +Homepage: http://rd.slavepianos.org/t/hosc-json +Tested-With: GHC == 7.8.2 Build-Type: Simple Cabal-Version: >= 1.8 Data-Files: README Library - Build-Depends: aeson, + Build-Depends: aeson >= 0.7, attoparsec, base == 4.*, bifunctors, - hosc == 0.14, + hosc == 0.15.*, bytestring, json, text, @@ -29,6 +29,7 @@ GHC-Options: -Wall -fwarn-tabs Exposed-modules: Sound.OSC.Type.JSON Sound.OSC.Type.JSON.Aeson + Sound.OSC.Type.JSON.Math Source-Repository head Type: darcs