Aeson.hs

-- | Encoding and decoding of OSC types as JSON values.
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 qualified Data.Vector as V {- vector -}
import Data.Word {- base -}
import qualified Data.Text as T {- text -}
import Sound.OSC.Type {- hosc -}

-- * Library variant

-- | Encode 'A.Value' to 'B.L.ByteString'.
encode_json :: A.Value -> B.L.ByteString
encode_json = A.encode

-- | Decode 'A.Value' from 'B.L.ByteString'.
decode_json :: B.L.ByteString -> Maybe A.Value
decode_json = A.decode

-- * Encoders

-- | All 'Integral' values are packed to 'Integer'.
encode_integral :: Integral n => n -> A.Value
encode_integral = A.Number . N.I . fromIntegral

-- | All 'Floating' values are packed to 'Double'.
encode_floating :: (Real n,Floating n) => n -> A.Value
encode_floating = A.Number . N.D . realToFrac

-- | Pack 'String'.
encode_string :: String -> A.Value
encode_string = A.String . T.pack

-- | Pack @(key,value)@ pair to 'JSObject'.
--
-- > encode_assoc ("a",encode_int 0)
encode_assoc :: (String,A.Value) -> A.Value
encode_assoc = A.Object . M.fromList . return . first T.pack

encode_list :: [A.Value] -> A.Value
encode_list = A.Array . V.fromList

-- * Decoders

decode_str :: A.Value -> Maybe String
decode_str j =
    case j of
      A.String t -> Just (T.unpack t)
      _ -> Nothing

decode_list :: A.Value -> Maybe [A.Value]
decode_list j =
    case j of
      A.Array a -> Just (V.toList a)
      _ -> Nothing

-- > decode_assoc (encode_assoc ("a",encode_int 0))
decode_assoc :: A.Value -> Maybe (String,A.Value)
decode_assoc j =
    case j of
      A.Object o ->
          case map (first T.unpack) (M.toList o) of
            [(k,v)] -> Just (k,v)
            _ -> Nothing
      _ -> Nothing

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

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
      _ -> 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.String t -> Just (string (T.unpack t))
      _ -> case decode_assoc j of
             Just ("blob",A.Array v) ->
                 mapM decode_word8 (V.toList v) >>= Just . Blob . B.L.pack
             Just ("midi",A.Array v) ->
                 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)
             _ -> Nothing