{-|
Module      : Data.Jdh.Json.Generic
Description : A module for generic Json Value Types
License     : MIT
Maintainer  : brunoczim@gmail.com
Stability   : experimental
Portability : OS-Independent

This module contains the generic version for Json Values. Example: A JSInt can be an Int but also an Integer.
This module also provides the functions for JSON encoding and decoding.
-}
module Data.Jdh.Json.Generic(
    JSValue,
    JSProperty,
    getInt,
    getReal,
    getBool,
    getStr,
    getArray,
    getObj,
    isNull,
    isInt,
    isReal,
    isBool,
    isStr,
    isArray,
    isObj,
    fromNull,
    fromInt,
    fromReal,
    fromBool,
    fromStr,
    fromArray,
    fromProps,
    (=:),
    stringify,
    prettify,
    parse,
    getProp
) where
import Data.String as S
import Data.Char as C

-- | The data JSValue holds any possible JSON Value. Note that its types can be flexible, a JSInt may be of any Integral type, JSReal of any Fractional type, etc.
data JSValue int real str
    = JSNull
    | JSInt {
        -- | Returns the unboxed Integral value of JSValue
        getInt :: int
    }
    | JSReal {
        -- | Returns the unboxed Fractional value of JSValue
        getReal :: real
    }
    | JSBoolean {
        -- | Returns the unboxed Bool value of JSValue
        getBool :: Bool
    }
    | JSString {
        -- | Returns the unboxed IsString value of JSValue
        getStr :: str
    }
    | JSArray {
        -- | Returns the unboxed [JSValue] value of JSValue
        getArray :: [JSValue int real str]
    }
    | JSObject {
        -- | Returns the unboxed [(IsString, JSValue)] value of JSValue
        getObj :: [(str, JSValue int real str)]
    }

-- | The JSProperty type is a synonymous for a tuple containing a String-like value and a JSValue. It represents an object Property.
type JSProperty int real str = (str, JSValue int real str)


-- | This function checks if a JSValue is null (constructed with JSNull constructor).
isNull :: JSValue a b c -> Bool
isNull JSNull = True
isNull _ = False

-- | This function checks if a JSValue is an integer (constructed with JSInt constructor).
isInt :: JSValue a b c -> Bool
isInt (JSInt _ ) = True
isInt _ = False

-- | This function checks if a JSValue is floating point number (constructed with JSReal constructor).
isReal :: JSValue a b c -> Bool
isReal (JSReal _ ) = True
isReal _ = False

-- | This function checks if a JSValue is boolean (constructed with JSBoolean constructor).
isBool :: JSValue a b c -> Bool
isBool (JSBoolean _ ) = True
isBool _ = False

-- | This function checks if a JSValue is string (constructed with JSString constructor).
isStr :: JSValue a b c -> Bool
isStr (JSString _ ) = True
isStr _ = False

-- | This function checks if a JSValue is array (constructed with JSArray constructor).
isArray :: JSValue a b c -> Bool
isArray (JSArray _ ) = True
isArray _ = False

-- | This function checks if a JSValue is object (constructed with JSObject constructor).
isObj :: JSValue a b c -> Bool
isObj (JSObject _ ) = True
isObj _ = False

-- | Creates a null JSValue (no arguments).
fromNull :: (Integral a, Fractional b, S.IsString c) => JSValue a b c
fromNull = JSNull

-- | Creates a JSValue from an Integral value.
fromInt :: (Integral a, Fractional b, S.IsString c) => a -> JSValue a b c
fromInt = JSInt

-- | Creates a JSValue from a Fractional value.
fromReal :: (Integral a, Fractional b, S.IsString c) => b -> JSValue a b c
fromReal = JSReal

-- | Creates a JSValue from a Bool value.
fromBool :: (Integral a, Fractional b, S.IsString c) => Bool -> JSValue a b c
fromBool = JSBoolean

-- | Creates a JSValue from a IsString value.
fromStr :: (Integral a, Fractional b, S.IsString c) => c -> JSValue a b c
fromStr = JSString

-- | Creates an Array JSValue from a list of JSValue.
fromArray :: (Integral a, Fractional b, S.IsString c) => [JSValue a b c] -> JSValue a b c
fromArray = JSArray

-- | Creates an Object JSValue from a list of properties relation (a (IsString,JSValue) tuple).
fromProps :: (Integral a, Fractional b, S.IsString c) => [JSProperty a b c] -> JSValue a b c
fromProps = JSObject

-- | An operator that creates a JSPropery value. Use it as property =: value.
infixl 5 =:
(=:) :: (Integral a, Fractional b, S.IsString c) => c -> JSValue a b c -> JSProperty a b c
propname =: propval = (propname, propval)



tabsize :: String
tabsize = replicate 4 ' '

-- | Encodes a JSValue into a String. Condenses the String; no whitespace will be included.
stringify :: (Integral a, Fractional b, S.IsString c, Show a, Show b, Show c) => JSValue a b c -> String
stringify JSNull = "null"
stringify (JSInt int) = show int
stringify (JSReal real) = show real
stringify (JSBoolean bool) = if bool then "true" else "false"
stringify (JSString str ) = show str
stringify (JSArray arr) = '[' : handle arr where
    handle [] = "]"
    handle [x] = stringify x ++ "]"
    handle (x:xs) = stringify x ++ "," ++ handle xs
stringify (JSObject obj) = '{' : handle obj where
    handle [] = "}"
    handle [(pname, pval)] = show pname ++ (':': stringify pval) ++ "}"
    handle ((pname, pval):xs) = show pname ++ (':': stringify pval) ++ "," ++ handle xs

-- | Encodes a JSValue into a String. Prettifies the output with indentation and linefeeds.
prettify :: (Integral a, Fractional b, S.IsString c, Show a, Show b, Show c) => JSValue a b c -> String
prettify x = prettify' x False ""

prettify' :: (Integral a, Fractional b, S.IsString c, Show a, Show b, Show c) => JSValue a b c -> Bool -> String -> String
prettify' JSNull False tab = tab ++ "null"
prettify' JSNull True _ = "null"
prettify' (JSInt int) False tab = tab ++ show int
prettify' (JSInt int) True _ = show int
prettify' (JSReal real) False tab = tab ++ show real
prettify' (JSReal real) True _ = show real
prettify' (JSBoolean bool) False tab = tab ++ (if bool then "true" else "false")
prettify' (JSBoolean bool) True _ = if bool then "true" else "false"
prettify' (JSString str ) False tab = tab ++ show str
prettify' (JSString str ) True _ = show str
prettify' (JSArray arr) cameFromObj tab = if not cameFromObj
    then tab ++ "[\n" ++ handle arr
    else "[\n" ++ handle arr
    where
        handle [] = tab ++ "]"
        handle [x] = prettify' x False (tab++tabsize) ++ "\n" ++ tab ++ "]"
        handle (x:xs) = prettify' x False (tab++tabsize) ++ ",\n" ++ handle xs
prettify' (JSObject obj) cameFromObj tab = if not cameFromObj
    then tab ++ "{\n" ++ handle obj
    else "{\n" ++ handle obj
    where
        handle [] = tab ++ "}"
        handle [(pname, pval)] = tab ++ tabsize ++ show pname ++ ": "
            ++ prettify' pval True (tab ++ tabsize) ++ "\n" ++ tab ++ "}"
        handle ((pname, pval):xs) = tab ++ tabsize ++ show pname ++ ": "
            ++ prettify' pval True (tab ++ tabsize) ++ ",\n" ++ handle xs

skipWhitespace :: String -> String
skipWhitespace = dropWhile (`elem` " \n\r\t")

-- | Parses an encoded JSON string into JSValues.
parse :: (Integral a, Fractional b, S.IsString c, Read a, Read b, Read c) => String -> [(JSValue a b c, String)]
parse [] = []
parse string
    | null skipped = []
    | C.isDigit $ head skipped = if '.' `elem` takeWhile (\ x -> C.isDigit x || x == '.') skipped
        then
            let readtry = reads skipped :: (Fractional b, Read b) => [(b, String)]
            in if null readtry
                then []
                else let [(number, remains)] = readtry in [(JSReal number, remains)]
        else
            let readtry = reads skipped :: (Integral a, Read a) => [(a, String)]
            in if null readtry
                then []
                else let [(number, remains)] = readtry in [(JSInt number, remains)]
    | head skipped == '"' = let readtry = reads skipped in if null readtry
        then []
        else
            let [(str, remains)] = readtry
            in [(JSString str, remains)]
    | head skipped == 'n' = [(JSNull, drop 4 skipped) | length skipped >= 4 && take 4 skipped == "null"]
    | head skipped == 't' = [(JSBoolean True, drop 4 skipped) | length skipped >= 4 && take 4 skipped == "true"]
    | head skipped == 'f' = [(JSBoolean False, drop 5 skipped) | length skipped >= 5 && take 5 skipped == "false"]
    | head skipped == '[' =
        let str = skipWhitespace (drop 1 skipped) in if null str then [] else if head str == ']'
            then [(JSArray [], drop 1 str)]
            else
                let handle [(tillnow, remains)] = if null readRem then [] else
                        let [(parsed, remains')] = readRem
                            skippedRem = skipWhitespace remains'
                        in if null skippedRem then [] else if head skippedRem == ']'
                            then [(tillnow ++ [parsed], drop 1 skippedRem)]
                            else if head skippedRem == ','
                                then handle [(tillnow ++ [parsed], skipWhitespace $ drop 1 skippedRem)]
                                else []
                                where
                                    readRem = parse remains
                    handle _ = []
                    answer = handle [([], str)]
                in if null answer
                    then []
                    else
                        let [(arr, remstr)] = answer
                        in [(JSArray arr, remstr)]
    | head skipped == '{' = let str = skipWhitespace (drop 1 skipped) in if null str then [] else if head str == '}'
        then [(JSObject [], drop 1 str)]
        else
            let handle [(tillnow, remains)] = if null readRemKey then [] else
                    let [(parsedkey, remainskey)] = readRemKey
                        skippedRemKey = skipWhitespace remainskey
                    in if null skippedRemKey || head skippedRemKey /= ':' then [] else
                        let readRemVal = parse $ skipWhitespace $ drop 1 remainskey
                        in if null readRemVal then [] else
                            let [(parsedVal, remainsVal)] = readRemVal
                                skippedRemVal = skipWhitespace remainsVal
                            in if null skippedRemVal then [] else if head skippedRemVal == '}'
                                then [(tillnow ++ [parsedkey =: parsedVal], drop 1 skippedRemVal)]
                                else if head skippedRemVal == ','
                                    then handle [(tillnow ++ [parsedkey =: parsedVal], skipWhitespace $ drop 1 skippedRemVal)]
                                    else []
                                    where
                                        readRemKey = reads remains
                handle _ = []
                answer = handle [([], str)]
            in if null answer
                then []
                else
                    let [(arr, remstr)] = answer
                    in [(JSObject arr, remstr)]
    | otherwise = []
    where
        skipped = skipWhitespace string

-- | Returns a given property from a object. Note that this function returns type of Maybe (JSValue a b c); if the property is not found, returns Nothing
getProp :: (Integral a, Fractional b, S.IsString c, Eq c) => c -> JSValue a b c -> Maybe (JSValue a b c)
getProp property (JSObject ((propname, val):xs)) = if propname == property
    then Just val
    else getProp property (JSObject xs)
getProp _ _ = Nothing


-- | JSValue Implements the Show class, the method show is implemented with prettify.
instance (Integral a, Fractional b, S.IsString c, Show a, Show b, Show c) => Show (JSValue a b c ) where
    show = prettify

-- | JSValue Implements the Read class, the method readsPrec is implemented with parse.
instance (Integral a, Fractional b, S.IsString c, Read a, Read b, Read c) => Read (JSValue a b c ) where
    readsPrec _ = parse

-- | JSValue Implements the Eq class, the method == is implemented comparing the respectives JSValue types. Example: JSBooleans are compared only with JSBooleans, comparing other types will always return False
instance (Integral a, Fractional b, S.IsString c, Eq a, Eq b, Eq c) => Eq (JSValue a b c) where
    JSNull == JSNull = True
    JSNull == _ = False
    (JSBoolean a) == (JSBoolean b) = a == b
    (JSBoolean _) == _ = False
    (JSString a) == (JSString b) = a == b
    (JSString _) == _ = False
    (JSArray a) == (JSArray b) = a == b
    (JSArray _) == _ = False
    (JSInt a) == (JSInt b) = a == b
    (JSInt _) == _ = False
    (JSReal a) == (JSReal b) = a == b
    (JSReal _) == _ = False
    (JSObject a) == (JSObject b) = a == b
    (JSObject _) == _ = False