-- | Encoding and decoding of OSC types as JSON values.
module Sound.OSC.Type.JSON.Aeson where

import qualified Data.Aeson as A {- aeson -}
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'.
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_integer :: Integer -> A.Value
encode_integer = A.toJSON

-- | All 'Floating' values are packed to 'Double'.
encode_double :: Double -> A.Value
encode_double = A.toJSON

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

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 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_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 _ -> 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) ->
                 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",n) -> Just (TimeStamp (decode_double_err n))
             _ -> Nothing