module EventLoop.Json(JSONMember(..), JSONMessage(..), retrieve, retrieveError, FromJSON(..), JSONAble(..), stringToJsonObject)  where

import Data.Char (isDigit, isLower, isUpper)
import FPPrac

data JSONMember = JSONMember [Char] JSONMessage

data JSONMessage = JSONFloat Float
                | JSONString [Char]
                | JSONBool Bool
                | JSONObject [JSONMember]
                | JSONArray [JSONMessage]
                

retrieve :: [Char] -> [JSONMember] -> Maybe JSONMessage
retrieve search [] = Nothing
retrieve search ((JSONMember name member):list) | search == name = Just member
                                               | otherwise = retrieve search list                
                
retrieveError :: [Char] -> [JSONMember] -> JSONMessage
retrieveError search members = case (retrieve search members) of
                                Nothing -> error ("Could not find " ++ search ++ " in JSON members")
                                Just result -> result

class FromJSON a where
    fromJsonMessage :: JSONMessage -> a
    
instance Show JSONMessage where    
    show (JSONFloat f)       = show f
    show (JSONString s)      = "\"" ++ escapeStringJson s ++ "\""
    show (JSONBool bool)     | bool      = "true"
                             | otherwise = "false"
    show (JSONObject (r:rs)) = "{" ++ rows ++ "}"
                                    where
                                        rows = foldl insertComma (show r) (map show rs)
    show (JSONArray [])       = "[]"
    show (JSONArray (x:xs))     = "[" ++ list ++ "]"
                                    where
                                        list = foldl insertComma (show x) (map show xs)

insertComma :: [Char] -> [Char] -> [Char]
insertComma a b = a ++ "," ++ b                

instance Show JSONMember where
    show (JSONMember name m) = "\"" ++ name ++ "\": " ++ (show m)

escapeStringJson :: [Char] -> [Char]
escapeStringJson [] = ""
escapeStringJson (c:cs) | c == '"' || c == '\\' = '\\':c:rest
                        | otherwise = c:rest
                        where
                            rest = escapeStringJson cs


class JSONAble a where
    toJsonMessage :: a -> JSONMessage
  
-- JSON Grammar for 1 object
-- Grammar returns (Rest, JSONObject [JSONRow])
-- O: '{' R+ '}'
-- R: '"' W '"' ':' V
-- V: '"' (JSONInt N | JSONString W) '"'
-- N: ('1' | '2' | '3' | ... | '0')+
-- W: ('a' | 'b' | 'c' | ... | 'z') (N | W | -)

data Grammer = O | R
type Rest = [Char]

stringToJsonObject :: [Char] -> JSONMessage
stringToJsonObject string = snd $ parse O string (JSONObject [])

errorMsg :: [Char] -> [Char] -> [Char]
errorMsg exp act = "Fault at parsing, expected '" ++ exp ++ "' but found '" ++ act ++ "'"

parse :: Grammer -> Rest -> JSONMessage -> (Rest, JSONMessage)
parse O [] _ = error (errorMsg "something" "premature end (start of message)")
parse O (c1:cs) (JSONObject rows)     | c1 == '{' = result
                                    | otherwise = error (errorMsg "{" [c1])
                                    where
                                        ((c1':cs'), object) = parse R cs (JSONObject rows)
                                        result     | c1' == '}' = (cs', object)
                                                | otherwise = error (errorMsg "}" [c1'])

parse R [] _ = error (errorMsg "something" "premature end (reading a row)")                                        
parse R (t:ts) (JSONObject rows) = object
                                    where
                                        ((r:rs), rowName) | t == '"' = parseWord ts                 -- Read row name
                                                          | otherwise = error (errorMsg "\"" [t])  
                                        rs'    | r == ':' = rs                                         -- Read row delimiter
                                            | otherwise = error (errorMsg ":" [r])
                                        ((r'':rs''), var2) = parseVariable rs'                      -- Read variable for row
                                        rows' = rows ++ [(JSONMember rowName var2)]                 -- Add found result to other rows
                                        object     | r'' == '}' = ((r'':rs''), JSONObject rows')       -- End, return result
                                                | r'' == ',' = parse R rs'' (JSONObject rows')      -- Read next row
                                                | otherwise = error (errorMsg "',' or '}'" [r''])                                    

-- Possibilities:
-- "\"string123value\"" -> JSONString "string123value" or "12345" -> JSONInt 12345                                    
parseVariable :: Rest -> (Rest, JSONMessage)                                        
parseVariable [] = error (errorMsg "something" "premature end")
parseVariable [c1] = error (errorMsg "longer variable" (c1:" and premature end"))                
parseVariable (c1:cs)    | c1 == '"'  = (r1, JSONString word)
                         | isDigit c1 = (r2, JSONFloat (read number))
                         | otherwise = error (errorMsg "\" or digit" [c1])
                            where
                                (r1, word)   = parseWord (cs)
                                (r2, number) = parseNumber (c1:cs)

parseWord :: Rest -> (Rest, [Char])
parseWord [] = error (errorMsg "something" "premature end")
parseWord (c1:cs)   | c1 == '"' = (cs, [])
                    | otherwise = (r1, c1:result')
                    where
                        (r1, result') = parseWord cs

parseNumber :: Rest -> (Rest, [Char])                         
parseNumber [] = error (errorMsg "something" "premature end")                         
parseNumber (c1:cs) | isDigit c1 || c1 == '.' = (r1, c1:result')
                    | c1 == ',' || c1 == '}' = (c1:cs, [])
                    | otherwise = error (errorMsg "number" [c1])
                            where
                                (r1, result') = parseNumber cs