As a follow up to my previous JSON serialization post I came up with a first draft of some simple record type serialization/deserialization.
What I would like to know is, whether this is the right approach or what better ways there are to make a custom data type an instance of class JSON. Any chance to reduce the amount of boilerplate required to do this? I would be grateful for any feedback (also general style comments are much appreciated). Many thanks! module Test where import Text.JSON data Message = Error { event :: String, channel :: String, id :: String, cause :: String, message :: String} | Join { event :: String, channel :: String, id :: String, name :: String} | Leave { event :: String, channel :: String, id :: String, really :: Bool} deriving (Eq, Show, Read) asJSString :: String -> JSValue asJSString = JSString . toJSString asString :: JSValue -> String asString (JSString s) = fromJSString s asBool :: JSValue -> Bool asBool (JSBool b) = b showErrorJSON, showJoinJSON, showLeaveJSON :: Message -> JSValue showErrorJSON (Test.Error evt cha id cau msg) = showJSON $ toJSObject [("event", evt), ("channel", cha), ("id", id), ("cause", cau), ("message", msg)] showJoinJSON (Join evt cha id nme) = showJSON $ toJSObject [("event", evt), ("channel", cha), ("id", id), ("name", nme)] showLeaveJSON (Leave evt cha id rly) = showJSON $ toJSObject [("event", asJSString evt), ("channel", asJSString cha), ("id", asJSString id), ("really", JSBool rly)] createMessage, readErrorJSON, readJoinJSON, readLeaveJSON :: [(String, JSValue)] -> Maybe Message readErrorJSON xs = do evt <- lookup "event" xs cha <- lookup "channel" xs id <- lookup "id" xs cau <- lookup "cause" xs msg <- lookup "message" xs Just (Test.Error (asString evt) (asString cha) (asString id) (asString cau) (asString msg)) readJoinJSON xs = do evt <- lookup "event" xs cha <- lookup "channel" xs id <- lookup "id" xs nme <- lookup "name" xs Just (Join (asString evt) (asString cha) (asString id) (asString nme)) readLeaveJSON xs = do evt <- lookup "event" xs cha <- lookup "channel" xs id <- lookup "id" xs rly <- lookup "really" xs Just (Leave (asString evt) (asString cha) (asString id) (asBool rly)) createMessage obj = do evt <- lookup "event" obj case asString evt of "/error" -> readErrorJSON obj "/me/add" -> readJoinJSON obj "/me/remove" -> readLeaveJSON obj _ -> Nothing instance JSON Message where showJSON x@(Test.Join _ _ _ _) = showJoinJSON x showJSON x@(Test.Leave _ _ _ _) = showLeaveJSON x showJSON x@(Test.Error _ _ _ _ _) = showErrorJSON x readJSON (JSObject o) = case createMessage . fromJSObject $ o of Just m -> Ok m Nothing -> Text.JSON.Error "Parsing failed." readJSON _ = Text.JSON.Error "Records must be JSObjects" _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe