JSON.hs

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