{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FunctionalDependencies, GeneralizedNewtypeDeriving, DeriveDataTypeable #-}

-- | The generalisation of a JSON object.
module Text.JSON.JSONLike
(
  JSONLike(..)
, StringMap(..)
) where

import Data.ByteString
import qualified Data.Trie as T
import Text.JSONb
import qualified Text.JSON as J
import qualified Text.HJson as H
import qualified Data.Aeson.Types as A
import Text.JSON.Types
import qualified Data.Map as M
import Data.Foldable
import Data.Traversable
import Data.Monoid
import Data.Text
import Data.Vector
import Data.Data

-- | The generalisation of a JSON object.
class JSONLike j s a o | j -> s, j -> a, j -> o where
  -- | Deconstructs a JSON object.
  foldJSON ::
    x -- ^ If a JSON null value.
    -> x -- ^ If a JSON true value.
    -> x -- ^ If a JSON false value.
    -> (Rational -> x) -- ^ If a JSON number value.
    -> (s -> x) -- ^ If a JSON string value.
    -> (a j -> x) -- ^ If a JSON array value.
    -> (o j -> x) -- ^ If a JSON object value.
    -> j
    -> x
  -- | Constructs a JSON null value.
  jnull ::
    j
  -- | Constructs a JSON true value.
  jtrue ::
    j
  -- | Constructs a JSON false value.
  jfalse ::
    j
  -- | Constructs a JSON number value from the given rational.
  jnumber ::
    Rational
    -> j
  -- | Constructs a JSON string value from the given string.
  jstring ::
    s
    -> j
  -- | Constructs a JSON array value from the given array.
  jarray ::
    a j
    -> j
  -- | Constructs a JSON object value from the given object.
  jobject ::
    o j
    -> j

instance JSONLike JSON ByteString [] T.Trie where
  foldJSON n _ _ _ _ _ _ Null =
    n
  foldJSON _ t f _ _ _ _ (Boolean b) =
    if b then t else f
  foldJSON _ _ _ r _ _ _ (Number r') =
    r r'
  foldJSON _ _ _ _ s _ _ (String s') =
    s s'
  foldJSON _ _ _ _ _ a _ (Array a') =
    a a'
  foldJSON _ _ _ _ _ _ o (Object o') =
    o o'
  jnull =
    Null
  jtrue =
    Boolean True
  jfalse =
    Boolean False
  jnumber =
    Number
  jstring =
    String
  jarray =
    Array
  jobject =
    Object

instance JSONLike J.JSValue [Char] [] J.JSObject where
  foldJSON n _ _ _ _ _ _ J.JSNull =
    n
  foldJSON _ t f _ _ _ _ (J.JSBool b) =
    if b then t else f
  foldJSON _ _ _ r _ _ _ (J.JSRational _ r') =
    r r'
  foldJSON _ _ _ _ s _ _ (J.JSString (JSONString s')) =
    s s'
  foldJSON _ _ _ _ _ a _ (J.JSArray a') =
    a a'
  foldJSON _ _ _ _ _ _ o (J.JSObject o') =
    o o'
  jnull =
    J.JSNull
  jtrue =
    J.JSBool True
  jfalse =
    J.JSBool False
  jnumber =
    J.JSRational False
  jstring =
    J.JSString . JSONString
  jarray =
    J.JSArray
  jobject =
    J.JSObject

newtype StringMap a =
  StringMap {
    runStringMap :: M.Map String a
  } deriving (Eq, Show, Read, Functor, Foldable, Traversable, Monoid, Data, Typeable)

instance JSONLike H.Json [Char] [] StringMap where
  foldJSON n _ _ _ _ _ _ H.JNull =
    n
  foldJSON _ t f _ _ _ _ (H.JBool b) =
    if b then t else f
  foldJSON _ _ _ r _ _ _ (H.JNumber r') =
    r r'
  foldJSON _ _ _ _ s _ _ (H.JString s') =
    s s'
  foldJSON _ _ _ _ _ a _ (H.JArray a') =
    a a'
  foldJSON _ _ _ _ _ _ o (H.JObject o') =
    o (StringMap o')
  jnull =
    H.JNull
  jtrue =
    H.JBool True
  jfalse =
    H.JBool False
  jnumber =
    H.JNumber
  jstring =
    H.JString
  jarray =
    H.JArray
  jobject =
    H.JObject . runStringMap

newtype TextMap a =
  TextMap {
    runTextMap :: M.Map Text a
  } deriving (Eq, Show, Read, Functor, Foldable, Traversable, Monoid, Data, Typeable)

instance JSONLike A.Value Text Vector TextMap where
  foldJSON n _ _ _ _ _ _ A.Null =
    n
  foldJSON _ t f _ _ _ _ (A.Bool b) =
    if b then t else f
  foldJSON _ _ _ r _ _ _ (A.Number r') =
    r (toRational r')
  foldJSON _ _ _ _ s _ _ (A.String s') =
    s s'
  foldJSON _ _ _ _ _ a _ (A.Array a') =
    a a'
  foldJSON _ _ _ _ _ _ o (A.Object o') =
    o (TextMap o')
  jnull =
    A.Null
  jtrue =
    A.Bool True
  jfalse =
    A.Bool False
  jnumber =
    A.Number . fromRational
  jstring =
    A.String
  jarray =
    A.Array
  jobject =
    A.Object . runTextMap

-- orphan instance, boooo
instance Functor J.JSObject where
  fmap f =
    J.toJSObject . fmap (fmap f) . J.fromJSObject