import "Prelude"
import "StringBuilder" as StringBuilder
import "Coercion"

class JSON a where
    toJSON :: a -> String
    buildJSON :: StringBuilder.T -> a -> <Proc> StringBuilder.T
    buildJSONList :: StringBuilder.T -> [a] -> <Proc> StringBuilder.T
    
    toJSON v = runProc (StringBuilder.toString (buildJSON StringBuilder.new v))
    buildJSONList sb v = printList buildJSON (sb << "[") v << "]"

// Basic types

instance JSON Integer where
    buildJSON = (<+)
instance JSON Long where
    buildJSON = (<+)
instance JSON Float where
    buildJSON = (<+)
instance JSON Double where
    buildJSON = (<+)
instance JSON String where
    buildJSON = (<+)
instance JSON Boolean where
    buildJSON sb v = if v then sb << "true" else sb << "false"
    
// Compound types

@private
@inline
printList :: (StringBuilder.T -> a -> <Proc> StringBuilder.T) -> StringBuilder.T -> [a] -> <Proc> StringBuilder.T
printList f sb l = loop 0
  where
    len = length l
    loop i = if i >= len then sb
             else do
                 f (if i==0 then sb else sb << ",") (l!i)
                 loop (i+1)

instance (JSON a) => JSON [a] where
    buildJSON = buildJSONList
instance JSON () where
    buildJSON sb _ = sb << "[]" 
instance (JSON a,JSON b) => JSON (a,b) where
    buildJSON sb (a,b) = buildJSON (buildJSON (sb << "[") a << ",") b << "]"
instance (JSON a,JSON b,JSON c) => JSON (a,b,c) where
    buildJSON sb (a,b,c) = buildJSON (buildJSON (buildJSON (sb << "[") a << ",") b << ",") c << "]"
instance (JSON a,JSON b,JSON c,JSON d) => JSON (a,b,c,d) where
    buildJSON sb (a,b,c,d) = buildJSON (buildJSON (buildJSON (buildJSON (sb << "[") a << ",") b << ",") c << ",") d << "]"
instance (JSON a) => JSON (Maybe a) where
    buildJSON sb (Just a) = buildJSON sb a
    buildJSON sb Nothing  = sb << "null"

// Building custom objects

data JSEntry = JSEntry String (StringBuilder.T -> <Proc> StringBuilder.T)

(:::) :: JSON a => String -> a -> JSEntry
key ::: value = JSEntry key (\sb -> buildJSON sb value)

instance JSON JSEntry where
    buildJSON _ _ = fail "JSEntry cannot be directly serialized to JSON."
    buildJSONList sb v = printList printJSEntry (sb << "{") v << "}"
      where
        printJSEntry sb (JSEntry key value) = value (sb <+ key << ":")

//

data JSObject = JSObject (StringBuilder.T -> <Proc> StringBuilder.T)

toJSONList :: JSON a => [a] -> [JSObject]
toJSONList = map (\v -> JSObject (\sb -> buildJSON sb v))

instance JSON JSObject where
    buildJSON sb (JSObject f) = f sb