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 Char8 {- bytestring -}
import qualified Data.ByteString.Lazy as Lazy {- bytestring -}
import qualified Data.ByteString.Lazy.UTF8 as UTF8 {- utf8-string -}

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

-- | The JSON value type.
type Value = A.Value

-- * String translation

-- | 'String' variant of 'encode_json'.
encode_json_str :: Value -> String
encode_json_str = UTF8.toString . J.encode_json

-- | 'String' variant of 'decode_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 = J.decode_json . UTF8.fromString

-- * Encoding

-- | JSON numbers are 'Either' 'Integer' or 'Double'.
type Number = Either Integer Double

-- | Encode 'Number'.
encode_number :: Number -> Value
encode_number = either J.encode_integer J.encode_double

-- | Encode 'O.TimeStamp' data ('O.Time'), ie. the @hosc@ real-valued
-- @NRT@ representation.
encode_timestamp :: O.Time -> Value
encode_timestamp n = J.encode_assoc ("timestamp",J.encode_double n)

encode_integral :: Integral n => n -> Value
encode_integral = J.encode_integer . fromIntegral

encode_floating :: Real n => n -> Value
encode_floating = J.encode_double . realToFrac

-- | Encode 'O.Blob' data ('Lazy.ByteString').
encode_blob :: Lazy.ByteString -> Value
encode_blob b =
    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 :: 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
-- '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 :: O.Datum -> Value
encode_datum d =
    case d of
      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.
--
-- > 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 :: O.Message -> Value
encode_message (O.Message a d) =
    let a' = J.encode_string a
        d' = map encode_datum 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.
--
-- > 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 :: 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 J.encode_list (b : t' : m')

-- | 'Packet' encoder.
encode_packet :: O.Packet -> Value
encode_packet p =
    case p of
      O.Packet_Message m -> encode_message m
      O.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 O.Message
decode_message j =
    case J.decode_list j of
      Just (m : d) ->
          case J.decode_datum m of
            Just (O.ASCII_String m') ->
                mapM J.decode_datum d >>=
                Just . O.message (Char8.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 O.Bundle
decode_bundle j =
    case J.decode_list j of
      Just (b : t : m) ->
          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 O.Packet
decode_packet v =
    case decode_bundle v of
      Just b -> Just (O.Packet_Bundle b)
      Nothing -> case decode_message v of
                   Just m -> Just (O.Packet_Message m)
                   Nothing -> Nothing