{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE IncoherentInstances #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-|
1. /Pretty prints/

Re-export module Data.JSON2.Pretty. Example of use:

@
    *ghci>  pp $ mkObj [(show x, x) | x <- [0..7]]
    {"0": 0, "1": 1, "2": 2, "3": 3, "4": 4, "5": 5, "6": 6, "7": 7}
@

2. /Renders JSON to String/

Haskell value has a JSON string:

@
     HASKELL value                             JSON string (toString . toJson)
    -------------------------------           -----------------------------
    Just \"bla\" :: Maybe String                \"bla\"
    Nothing :: Maybe String                   null
    Left 1 :: Either Int Int                  [[1], []]
    Right 1 :: Either Int Int                 [[], [1]]
    \'a\' :: Char                               97
    () :: ()                                  []
    (1, \"bla\") :: (Int, String)               [1, \"bla\"]
    fromList [1,2,3,4] :: Set Int             [1, 2, 3, 4]
    fromList [(\"0\",0),(\"1\",10),(\"2\",20)]      {\"0\": 0, \"1\": 10, \"2\": 20}
        :: Map String Int
@

3. /Conversion haskell values from and to JSON/

This module provides many instances classes `FromJson` and `ToJson`
for haskell data types.
See instances class `ToJson` for SQL (HDBC) in module  Database.HDBC.JSON2
(package json2-hdbc).

 /Adding Instance class ToJson or FromJson/


Transformation of algebraic product in `Json`. For example:

@
    data Person = Person {name :: String, age:: Int}
        deriving (Typeable, Show, Eq)
@

@
    instance ToJson Person where
        toJson (Person s n) = toJson [toJson s, toJson n]
@

@
    instance FromJson Person where
        safeFromJson (JArray [js, jn])
                       = return $ Person (fromJson js) (fromJson jn)
        safeFromJson x = mkError x
@

Converting `Bounded` and `Enum` values to Json. For example:

@
    data Color = Red | Green | Blue | Black
        deriving (Typeable, Show, Eq, Enum, Bounded)
@

@
    instance ToJson Color where
        toJson = JNumber . toRational . fromEnum
    instance FromJson Color where
        safeFromJson (JNumber x) = checkBoundsEnum (toEnum . round) x
        safeFromJson x =  mkError x
@
-}

module Data.JSON2
  ( -- * Re-export module for pretty printing
    module Data.JSON2.Pretty 
    -- * Base data types
  , Json (..)
  , Jsons (..)
    -- * Renders JSON to string
  , toString
    -- * Conversion haskell values from and to JSON
  , ToJson (toJson)
  , FromJson(safeFromJson)
  , fromJson
    -- * Building JSON objects
  , emptyObj,  (.=), mkObj
    -- * Merges JSON objects
  , (+=), merges, mergeRec
  )
where

import Data.JSON2.Internal
import Data.JSON2.Types
import Data.JSON2.Pretty
import Data.Typeable (Typeable)

import Data.List
import Data.Ratio
import Data.Int
import Data.Word
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Set (Set)
import qualified Data.Set as Set

import qualified Data.ByteString           as B   (ByteString)
import qualified Data.ByteString.Lazy      as L   (ByteString)
import qualified Data.ByteString.UTF8      as U8  (fromString, toString)
import qualified Data.ByteString.Lazy.UTF8 as LU8 (fromString, toString)

infixl 4 +=
infixr 6 .=

-------------- Conversion from and to JSON --------------------------------------

-- | Class for conversion from `Json`.
class Typeable a => ToJson a where
    toJson :: a -> Json

-- | Class for conversion from `Json`.
class Typeable a => FromJson a where
    safeFromJson :: Json  -> ConvResult a

-- | Conversion from `Json`.
fromJson :: FromJson a  => Json -> a
fromJson x = case safeFromJson x of
    Left  e -> error (show e)
    Right r -> r


---------------- Building and manipulation JSON objects ---------

--  Building JSON objects

-- | Create empty `Json` object.
--
-- > pp $ emptyObj   ==   {}
emptyObj :: Json
emptyObj = JObject Map.empty

-- | Create single `Json` object.
--
-- >  pp ("key" .= (Just False))   ==   {"key": false}
(.=) :: (ToJson v, Typeable v) => String  -> v -> Json
k .= v = JObject $ Map.singleton k (toJson v)

-- | Create `Json` object from list.
--
-- >  pp $ mkObj [("a", "old"), ("a", "new"), ("bb", "other")]   == {"a": "new", "bb": "other"}
mkObj :: (ToJson v, Typeable v) => [(String ,v)] -> Json
mkObj xs = JObject $ Map.fromList (map (\(k,v) -> (k, toJson v)) xs)

-- * Merges JSON objects

-- | Merge two  `JObject`. Other `Json` values interpreted as `emptyObj`.
--
-- > pp $ ("a" .= "old") += ("a" .= "new") += ("bb" .= "other")  ==   {"a": "new", "bb": "other"}
--
-- > obj += emptyObj   ==   emptyObj += obj
-- > obj += obj   ==   emptyObj += obj   ==   obj += emptyObj  
-- > obj1 += (obj2 += obj3)   ==   (obj1 += obj2) += obj3
(+=) :: Json -> Json -> Json
(+=) (JObject x ) (JObject y) = JObject $ Map.union y x
(+=) (JObject x ) _           = JObject x
(+=) _           (JObject y)  = JObject y
(+=) _            _           = emptyObj

-- | Merge `Json` objects from list.
--
-- >  pp $ merges [("a" .= "old"), ("a" .= "new"), ("bb" .= "other")]   ==   {"a": "new", "bb": "other"}
merges :: [Json] -> Json
merges = foldl (+=) emptyObj

-- | Recursively merge the two `Json` objects.
mergeRec :: Json -> Json -> Json
mergeRec ox@(JObject x) oy@(JObject y) = mergeRec' ox oy
mergeRec _              _              = emptyObj

mergeRec' (JObject x) (JObject y) = JObject $  Map.unionWith mergeRec' x y
mergeRec' _           js          = js


------------------------- Instances -----------------------------

-- Mix instances

instance ToJson Json where
    toJson = id
instance FromJson Json where
    safeFromJson = return

instance  ToJson () where
    toJson () = JArray []
instance FromJson () where
    safeFromJson (JArray []) = return ()
    safeFromJson x =  mkError x

instance ToJson a => ToJson (Maybe a) where
    toJson = maybe JNull toJson
instance FromJson a => FromJson (Maybe a) where
    safeFromJson x = if x == JNull then return Nothing
                                   else return $ Just (fromJson x)
instance ToJson Bool where
    toJson = JBool
instance FromJson Bool where
    safeFromJson (JBool x) = return x
    safeFromJson x =  mkError x

instance (ToJson a, ToJson b) => ToJson (Either a b) where
    toJson (Right x) = toJson [[], [x]]  
    toJson (Left x)  = toJson [[x], []]
instance (FromJson a, FromJson b) => FromJson (Either a b) where
    safeFromJson (JArray [JArray [], JArray [x]]) = (return . Right . fromJson) x
    safeFromJson (JArray [JArray [x], JArray []]) = (return . Left .  fromJson) x
    safeFromJson x =  mkError x


-- Instances String

instance ToJson String where
    toJson = JString
instance FromJson String where
    safeFromJson (JString x) = return  x
    safeFromJson x  =  mkError x

instance ToJson B.ByteString where
    toJson = JString . U8.toString
instance FromJson B.ByteString where
    safeFromJson (JString x) =  (return . U8.fromString) x
    safeFromJson x =  mkError x

instance ToJson L.ByteString where
    toJson = JString . LU8.toString
instance FromJson L.ByteString where
    safeFromJson (JString x) =  (return . LU8.fromString) x
    safeFromJson x =  mkError x

-- Instances Char

instance  ToJson Char where
    toJson = jsonifyIntegral . fromEnum
instance FromJson Char where
    safeFromJson (JNumber x) = checkBoundsEnum (toEnum . round) x
    safeFromJson x =  mkError x

-- Instances Numeric

instance ToJson Integer where
    toJson = jsonifyIntegral
instance FromJson Integer where
    safeFromJson (JNumber x) = return (round x)
    safeFromJson x =  mkError x

-- Instances Int

instance ToJson Int where
    toJson = jsonifyIntegral
instance FromJson Int where
    safeFromJson (JNumber x) = checkBoundsIntegral round x
    safeFromJson x =  mkError x

instance ToJson Int8 where
    toJson = jsonifyIntegral
instance FromJson Int8 where
    safeFromJson (JNumber x) = checkBoundsIntegral round x
    safeFromJson x =  mkError x

instance ToJson Int16 where
    toJson = jsonifyIntegral
instance FromJson Int16 where
    safeFromJson (JNumber x) = checkBoundsIntegral round x
    safeFromJson x =  mkError x

instance ToJson Int32 where
    toJson = jsonifyIntegral
instance FromJson Int32 where
    safeFromJson (JNumber x) = checkBoundsIntegral round x
    safeFromJson x =  mkError x

instance ToJson Int64 where
    toJson = jsonifyIntegral
instance FromJson Int64 where
    safeFromJson (JNumber x) = checkBoundsIntegral round x
    safeFromJson x =  mkError x

-- Instances Word

instance ToJson Word where
    toJson = jsonifyIntegral
instance FromJson Word where
    safeFromJson (JNumber x) = checkBoundsIntegral round x
    safeFromJson x =  mkError x

instance ToJson Word8 where
    toJson = jsonifyIntegral
instance FromJson Word8 where
    safeFromJson (JNumber x) = checkBoundsIntegral round x
    safeFromJson x =  mkError x

instance ToJson Word16 where
    toJson = jsonifyIntegral
instance FromJson Word16 where
    safeFromJson (JNumber x) = checkBoundsIntegral round x
    safeFromJson x =  mkError x

instance ToJson Word32 where
    toJson = jsonifyIntegral
instance FromJson Word32 where
    safeFromJson (JNumber x) = checkBoundsIntegral round x
    safeFromJson x =  mkError x

instance ToJson Word64 where
    toJson = jsonifyIntegral
instance FromJson Word64 where
    safeFromJson (JNumber x) = checkBoundsIntegral round x
    safeFromJson x =  mkError x
--
jsonifyIntegral :: (Integral a) => a -> Json
jsonifyIntegral i = JNumber (fromIntegral i % 1)

-- Instances Floating and Rational

instance ToJson Double where
    toJson = jsonifyRealFrac
instance FromJson Double where
    safeFromJson (JNumber x) = checkInfinite fromRational x
    safeFromJson x =  mkError x

instance ToJson Float where
    toJson = jsonifyRealFrac
instance FromJson Float where
    safeFromJson (JNumber x) = checkInfinite fromRational x
    safeFromJson x =  mkError x


instance ToJson Rational where
    toJson = JNumber
instance FromJson Rational where
    safeFromJson (JNumber x) = return x
    safeFromJson x =  mkError x

--
jsonifyRealFrac :: (RealFrac a) => a -> Json
jsonifyRealFrac i = JNumber (approxRational i 1e-666)

-- ** Instances Containers


instance ToJson a => ToJson [a] where
    toJson = JArray . map toJson
instance FromJson a => FromJson [a] where
    safeFromJson (JArray xs) = return (map fromJson xs)
    safeFromJson x =  mkError x

instance ToJson v => ToJson (Map String v) where
    toJson = JObject . Map.map toJson
instance FromJson v => FromJson (Map String v) where
    safeFromJson (JObject m) = return  $ Map.map fromJson m
    safeFromJson x =  mkError x

instance ToJson a => ToJson (Set a) where
    toJson = JArray . (map  toJson) . Set.toList
instance (FromJson a, Ord a) => FromJson (Set a) where
    safeFromJson (JArray xs) = return . Set.fromList $ map fromJson xs
    safeFromJson x =  mkError x

-- Instances Tuples

instance ( ToJson t1,  ToJson t2)
          => ToJson (t1, t2) where
    toJson (x1, x2) = JArray [toJson x1, toJson x2]
instance (FromJson t1, FromJson t2)
          => FromJson (t1, t2) where
    safeFromJson (JArray [x1, x2]) = return (fromJson x1, fromJson x2)
    safeFromJson x =  mkError x

instance (ToJson t1, ToJson t2, ToJson t3)
           => ToJson (t1, t2, t3) where
    toJson (x1, x2, x3) = JArray [toJson x1, toJson x2, toJson x3]
instance (FromJson t1, FromJson t2, FromJson t3)
          => FromJson (t1, t2, t3) where
    safeFromJson (JArray [x1, x2, x3]) = return (fromJson x1, fromJson x2, fromJson x3)
    safeFromJson x =  mkError x

instance (ToJson t1, ToJson t2, ToJson t3, ToJson t4) => ToJson (t1, t2, t3, t4) where
    toJson (x1, x2, x3, x4) = JArray [toJson x1, toJson x2, toJson x3, toJson x4]
instance (FromJson t1, FromJson t2, FromJson t3, FromJson t4)
          => FromJson (t1, t2, t3, t4) where
    safeFromJson (JArray [x1, x2, x3, x4]) = return (fromJson x1, fromJson x2, fromJson x3,
                                                     fromJson x4)
    safeFromJson x =  mkError x

instance (ToJson t1, ToJson t2, ToJson t3, ToJson t4, ToJson t5)
          => ToJson (t1, t2, t3, t4, t5) where
    toJson (x1, x2, x3, x4, x5) = JArray [toJson x1, toJson x2, toJson x3, toJson x4, toJson x5]
instance (FromJson t1, FromJson t2, FromJson t3, FromJson t4, FromJson t5)
          => FromJson (t1, t2, t3, t4, t5) where
    safeFromJson (JArray [x1, x2, x3, x4, x5]) = return (fromJson x1, fromJson x2, fromJson x3,
                                                         fromJson x4, fromJson x5)
    safeFromJson x =  mkError x