{-# LANGUAGE FlexibleInstances #-} -- | -- This module contains the Json Parser. module Json ( decodeJSON, JsonTree ) where import Text.JSON (decode, Result(..), JSValue(..), fromJSString, fromJSObject) import Data.Ratio (denominator) import Data.Text (pack) import qualified Data.Tree as DataTree import Parsers instance Tree JsonTree where getLabel (DataTree.Node l _) = l getChildren (DataTree.Node _ cs) = cs -- | -- JsonTree is a tree that can be validated by Relapse. type JsonTree = DataTree.Tree Label -- | -- decodeJSON returns a JsonTree, given an input string. decodeJSON :: String -> Either String [JsonTree] decodeJSON s = case decode s of (Error e) -> Left e (Ok v) -> Right (uValue v) uValue :: JSValue -> [JsonTree] uValue JSNull = [] uValue (JSBool b) = [DataTree.Node (Bool b) []] uValue (JSRational _ r) = if denominator r /= 1 then [DataTree.Node (Double (fromRational r :: Double)) []] else [DataTree.Node (Int $ truncate r) []] uValue (JSString s) = [DataTree.Node (String $ pack $ fromJSString s) []] uValue (JSArray vs) = uArray 0 vs uValue (JSObject o) = uObject $ fromJSObject o uArray :: Int -> [JSValue] -> [JsonTree] uArray _ [] = [] uArray index (v:vs) = DataTree.Node (Int index) (uValue v):uArray (index+1) vs uObject :: [(String, JSValue)] -> [JsonTree] uObject = map uKeyValue uKeyValue :: (String, JSValue) -> JsonTree uKeyValue (name, value) = DataTree.Node (String $ pack name) (uValue value)