Convert JSON back to Data in Haskell - json

I have the following Haskell to call my WCF Service:
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}
module Main where
import Data.Aeson
import Data.Dynamic
import Data.Aeson.Lens
import Data.ByteString.Lazy as BS
import GHC.Generics
import Network.Wreq
import Control.Lens
data Point = Point { x :: Int, y :: Int } deriving (Generic, Show)
instance ToJSON Point
instance FromJSON Point
data Rectangle = Rectangle { width :: Int, height :: Int, point :: Point } deriving (Generic, Show)
instance ToJSON Rectangle
instance FromJSON Rectangle
main = do
let p = Point 1 2
let r = Rectangle 10 20 p
let url = "http://localhost:8000/Rectangle"
let opts = defaults & header "Content-Type" .~ ["application/json"]
r <- postWith opts url (encode r)
let returnData = r ^? responseBody
case (decode returnData) of
Nothing -> BS.putStrLn "Error decoding JSON"
Just json -> BS.putStrLn $ show $ decode json
The output in this case is:
Just "{\"height\":20,\"point\":{\"x\":1,\"y\":2},\"width\":10}"
I already tried it with fromJSON:
print $ fromJSON returnData
and got this error:
Couldn't match expected type `Value'
with actual type `Maybe
bytestring-0.10.6.0:Data.ByteString.Lazy.Internal.ByteString'
In the first argument of `fromJSON', namely `returnData'
In the second argument of `($)', namely `fromJSON returnData'
Failed, modules loaded: none.
My question is now how to convert this JSON string back to an object of type "Rectangle"?
EDIT 1: I changed my code due to Janos Potecki's answer and get now the following error:
Couldn't match type `[Char]' with `ByteString'
Expected type: ByteString
Actual type: String
In the second argument of `($)', namely `show $ decode json'
In the expression: BS.putStrLn $ show $ decode json
In a case alternative:
Just json -> BS.putStrLn $ show $ decode json
Failed, modules loaded: none.
EDIT 2: i changed it to:
main = do
let point = Point 1 2
let rectangle = Rectangle 10 20 point
let url = "http://localhost:8000/Rectangle/Move/100,200"
let opts = defaults & header "Content-Type" .~ ["application/json"]
r <- postWith opts url (encode rectangle)
let returnData = (r ^? responseBody) >>= decode
case returnData of
Nothing -> BS.putStrLn "Error decoding JSON"
Just json -> BS.putStrLn json
and now i get:
No instance for (FromJSON ByteString)
arising from a use of `decode'
In the second argument of `(>>=)', namely `decode'
In the expression: (r ^? responseBody) >>= decode
In an equation for `returnData':
returnData = (r ^? responseBody) >>= decode

working solution
r' <- asJSON =<< postWith opts url (encode rectangle) :: IO Res
case r' of
Nothing -> print "Error decoding JSON"
Just x -> print x
For performance I'd suggest you add the following to your instance ToJSON:
instance ToJSON Point where
toEncoding = genericToEncoding defaultOptions
and the same for Rectangle

Related

Parsing nested JSON into a list of Tuples with Aeson

Say I have the following structure:
data AddressDto = AddressDto
{ addressDtoId :: UUID
, addressDtoCode :: Text
, addressDtoCity :: Maybe Text
, addressDtoStreet :: Text
, addressDtoPostCode :: Text
} deriving (Eq, Show, Generic)
instance FromJSON AddressDto where
parseJSON = genericParseJSON $ apiOptions "addressDto"
instance ToJSON AddressDto where
toJSON = genericToJSON $ apiOptions "addressDto"
toEncoding = genericToEncoding $ apiOptions "addressDto"
This works as you would expect.
Now say I want to parse a JSON structure of the format:
{ UUID: AddressDto, UUID: AddressDto, UUID: AddressDto }
A reasonable Haskell representation would seem to be:
data AddressListDto = AddressListDto [(UUID, AddressDto)]
Creating a helper function like so:
keyAndValueToList :: Either ServiceError AddressListDto -> Text -> DiscountDto -> Either ServiceError AddressListDto
keyAndValueToList (Left err) _ _ = Left err
keyAndValueToList (Right (AddressListDto ald)) k v = do
let maybeUUID = fromString $ toS k
case maybeUUID of
Nothing -> Left $ ParseError $ InvalidDiscountId k
Just validUUID -> Right $ AddressListDto $ (validUUID, v) : ald
and finally an instance of FromJSON:
instance FromJSON AddressListDto where
parseJSON = withObject "tuple" $ \o -> do
let result = foldlWithKey' keyAndValueToList (Right $ AddressListDto []) o
case result of
Right res -> pure res
Left err -> throwError err
This fails to compile with:
Couldn't match type ‘aeson-1.4.5.0:Data.Aeson.Types.Internal.Value’
with ‘AddressDto’
Expected type: unordered-containers-0.2.10.0:Data.HashMap.Base.HashMap
Text AddressDto
Two questions:
1) How do I make sure the nested values in the hashmap get parsed correctly to an AddressDto.
2) How do I avoid forcing the initial value into an either? Is there a function I could use instead of foldlWithKey' that didn't make me wrap the initial value like this?
Funny answer. To implement parseJSON, you can use
parseJSON :: Value -> Parser (HashMap Text AddressDto)
...but even better, why not just use a type alias instead of a fresh data type, so:
type AddressListDto = HashMap UUID AddressDto
This already has a suitable FromJSON instance, so then you don't even need to write any code yourself.

Haskell Aeson json encoding bytestrings

I need to serialize a record in Haskell, and am trying to do it with Aeson. The problem is that some of the fields are ByteStrings, and I can't work out from the examples how to encode them. My idea is to first convert them to text via base64. Here is what I have so far (I put 'undefined' where I didn't know what to do):
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
module Main where
import qualified Data.Aeson as J
import qualified Data.ByteString as B
import qualified Data.ByteString.Base64 as B64
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import qualified GHC.Generics as G
data Data = Data
{ number :: Int
, bytestring :: B.ByteString
} deriving (G.Generic, Show)
instance J.ToJSON Data where
toEncoding = J.genericToEncoding J.defaultOptions
instance J.FromJSON Data
instance J.FromJSON B.ByteString where
parseJSON = undefined
instance J.ToJSON B.ByteString where
toJSON = undefined
byteStringToText :: B.ByteString -> T.Text
byteStringToText = E.decodeUtf8 . B64.encode
textToByteString :: T.Text -> B.ByteString
textToByteString txt =
case B64.decode . E.encodeUtf8 $ txt of
Left err -> error err
Right bs -> bs
encodeDecode :: Data -> Maybe Data
encodeDecode = J.decode . J.encode
main :: IO ()
main = print $ encodeDecode $ Data 1 "A bytestring"
It would be good if it was not necessary to manually define new instances of ToJSON and FromJSON for every record, because I have quite a few different records with bytestrings in them.
parseJson needs to return a value of type Parser B.ByteString, so you just need to call pure on the return value of B64.decode.
import Control.Monad
-- Generalized to any MonadPlus instance, not just Either String
textToByteString :: MonadPlus m => T.Text -> m B.ByteString
textToByteString = case B64.decode (E.encodeUtf8 x) of
Left _ -> mzero
Right bs -> pure bs
instance J.FromJSON B.ByteString where
parseJSON (J.String x) = textToByteString x
parseJSON _ = mzero
Here, I've chosen to return mzero both if you try to decode anything other than a JSON string and if there is a problem with the base-64 decoding.
Likewise, toJSON needs just needs to encode the Text value you create from the base64-encoded ByteString.
instance J.ToJSON B.ByteString where
toJSON = J.toJSON . byteStringToText
You might want to consider using a newtype wrapper instead of defining the ToJSON and FromJSON instances on B.ByteString directly.

Trouble with JSON (Data.Aeson)

I'm new to Haskell and in order to learn the language I am working on a project that involves dealing with JSON. I am currently getting the feeling Haskell is the wrong language for the job, but that isn't the point here.
I've been struggling to understand how this works for a few days. I have searched and everything I have found does not seem to work. Here's the issue:
I have some JSON in the following format:
>>>less "path/to/json"
{
"stringA1_stringA2": {"stringA1":floatA1,
"stringA2":foatA2},
"stringB1_stringB2": {"stringB1":floatB1,
"stringB2":floatB2}
...
}
Here floatX1 and floatX2 are actually strings of the form "0.535613567", "1.221362183" etc. What I want to do is parse this into the following data
data Mydat = Mydat { name :: String, num :: Float} deriving (Show)
where name would correspond to "stringX1_stringX2" and num to floatX1 for X = A,B,...
So far I have reached a 'solution' which feels fairly hackish and convoluted and doesn't work properly.
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}
import Data.Functor
import Data.Monoid
import Data.Aeson
import Data.List
import Data.Text
import Data.Map (Map)
import qualified Data.HashMap.Strict as DHM
--import qualified Data.HashMap as DHM
import qualified Data.ByteString.Lazy as LBS
import System.Environment
import GHC.Generics
import Text.Read
data Mydat = Mydat {name :: String, num :: Float} deriving (Show)
test s = do
d <- LBS.readFile s
let v = decode d :: Maybe (DHM.HashMap String Object)
case v of
-- Just v -> print v
Just v -> return $ Prelude.map dataFromList $ DHM.toList $ DHM.map (DHM.lookup "StringA1") v
good = ['1','2','3','4','5','6','7','8','9','0','.']
f x = elem x good
dataFromList :: (String, Maybe Value) -> Mydat
dataFromList (a,b) = Mydat a (read (Prelude.filter f (show b)) :: Float)
Now I can compile this and run
test "path/to/json"
in ghci and it prints a list of Mydat's in the case where "stringX1"="stringA1" for all X. In reality there are two values for "stringX1" so aside from the hackyness this is not satisfactory. There must be a better way to do this. I get that I need to write my own parser probably but I am confused about how this works so any suggestions would be great. Thanks in advance.
The structure of your JSON is pretty nasty, but here's a basic working solution:
#!/usr/bin/env stack
-- stack --resolver lts-11.5 script --package containers --package aeson
{-# LANGUAGE OverloadedStrings #-}
import qualified Data.Map as Map
import qualified Data.Aeson as Aeson
data Mydat = Mydat { name :: String
, num :: Float
} deriving (Show)
instance Eq Mydat where
(Mydat _ x1) == (Mydat _ x2) = x1 == x2
instance Ord Mydat where
(Mydat _ x1) `compare` (Mydat _ x2) = x1 `compare` x2
type MydatRaw = Map.Map String (Map.Map String String)
processRaw :: MydatRaw -> [Mydat]
processRaw = Map.foldrWithKey go []
where go key value accum =
accum ++ (Mydat key . read <$> Map.elems value)
main :: IO ()
main =
do let json = "{\"stringA1_stringA2\":{\"stringA1\":\"0.1\",\"stringA2\":\"0.2\"}}"
print $ fmap processRaw (Aeson.eitherDecode json)
Note that read is partial and generally not a good idea. But I'll leave it to you to flesh out a safer version :)
As I commented, the best thing would probably be to make your JSON file well-formed in the sense that the float fields should really be floats, not strings.
If that's not an option, I would recommend you phrase out the type that the JSON file seems to represent as simple as possible (but without dynamic Objects), and then convert that to the type you actually want.
import Data.Map (Map)
import qualified Data.Map as Map
type GarbledJSON = Map String (Map String String)
-- ^ you could also stick with hash maps for everything, but
-- usually `Map` is actually more sensible in Haskell.
data MyDat = MyDat {name :: String, num :: Float} deriving (Show)
test :: FilePath -> IO [MyDat]
test s = do
d <- LBS.readFile s
case decode d :: Maybe GarbledJSON of
Just v -> return [ MyDat iName ( read . filter (`elem`good)
$ iVals Map.! valKey )
| (iName, iVals) <- Map.toList v
, let valKey = takeWhile (/='_') iName ]
Note that this will crash completely if any of the items don't contain the first part of the name as a string of float format, and likely give bogus items when you filter out characters that aren't good. If you just want to ignore any malformed items (which is also not a very clean approach...), you can do it this way:
test :: FilePath -> IO [MyDat]
test s = do
d <- LBS.readFile s
return $ case decode d :: Maybe GarbledJSON of
Just v -> [ MyDat iName iVal
| (iName, iVals) <- Map.toList v
, let valKey = takeWhile (/='_') iName
, Just iValStr <- [iVals Map.!? valKey]
, [(iVal,"")] <- [reads iValStr] ]
Nothing -> []

Haskell: Parsing and processing stream of json requests

Following code tries to execute a stream of Request objects.
{-# LANGUAGE DeriveGeneric, DeriveDataTypeable #-}
--OverloadedStrings,
import Data.Aeson
import Data.Data
import Data.ByteString.Lazy.Internal
import GHC.Generics
import qualified Data.Map as Map
data Request a = Request {
name :: String,
payload :: a
} deriving (Show, Generic)
instance FromJSON a => FromJSON (Request a)
instance ToJSON a => ToJSON (Request a)
class Exe a where
exe :: (Request a) -> String
data Createuser = Createuser {
userName :: String
} deriving (Show, Generic)
instance FromJSON Createuser
instance ToJSON Createuser
instance Exe Createuser where
exe r = "creating user"
parseCreateUser json = parse json :: Request Createuser
data Deleteuser = Deleteuser {
userName2 :: String
} deriving (Show, Generic)
instance FromJSON Deleteuser
instance ToJSON Deleteuser
instance Exe Deleteuser where
exe r = "deleting user"
parseDeleteUser json = parse json :: Request Deleteuser
tojson name payload = encode (Request name payload)
parse bs = let Just p = decode bs in p
sampleDeleteUser = tojson "deleteUser" (Deleteuser "Jigar Gosar")
sampleCreateUser = tojson "createUser" (Createuser "Jigar Gosar")
exeTuple tuple = case tuple of
("createUser", a) -> exe $ parseCreateUser $ a
("deleteUser", a) -> exe $ parseDeleteUser $ a
main = do
-- This list would be read from socket.
let tuples = [("createUser", sampleCreateUser), ("deleteUser", sampleDeleteUser)]
putStr $ unlines [exeTuple tup | tup <- tuples]
print "end"
Is there any way to remove the following duplication?
parseCreateUser json = parse json :: Request Createuser
parseDeleteUser json = parse json :: Request Deleteuser
I will have to write this for every (Request p) I create.
Also I will have to keep modifying following function every time I create new (Request p)
exeTuple tuple = case tuple of
("createUser", a) -> exe $ parseCreateUser $ a
("deleteUser", a) -> exe $ parseDeleteUser $ a
Is this idiomatic haskell code?

Conduit with aeson / attoparsec, how to exit cleanly without exception once source has no more data

I'm using aeson / attoparsec and conduit / conduit-http connected by conduit-attoparsec to parse JSON data from a file / webserver. My problem is that my pipeline always throws this exception...
ParseError {errorContexts = ["demandInput"], errorMessage = "not enough bytes", errorPosition = 1:1}
...once the socket closes or we hit EOF. Parsing and passing on the resulting data structures through the pipeline etc. works just fine, but it always ends with the sinkParser throwing this exception. I invoke it like this...
j <- CA.sinkParser json
...inside of my conduit that parses ByteStrings into my message structures.
How can I have it just exit the pipeline cleanly once there is no more data (no more top-level expressions)? Is there any decent way to detect / distinguish this exception without having to look at error strings?
Thanks!
EDIT: Example:
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Control.Applicative
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as B8
import qualified Data.Conduit.Attoparsec as CA
import Data.Aeson
import Data.Conduit
import Data.Conduit.Binary
import Control.Monad.IO.Class
data MyMessage = MyMessage String deriving (Show)
parseMessage :: (MonadIO m, MonadResource m) => Conduit B.ByteString m B.ByteString
parseMessage = do
j <- CA.sinkParser json
let msg = fromJSON j :: Result MyMessage
yield $ case msg of
Success r -> B8.pack $ show r
Error s -> error s
parseMessage
main :: IO ()
main =
runResourceT $ do
sourceFile "./input.json" $$ parseMessage =$ sinkFile "./out.txt"
instance FromJSON MyMessage where
parseJSON j =
case j of
(Object o) -> MyMessage <$> o .: "text"
_ -> fail $ "Expected Object - " ++ show j
Sample input (input.json):
{"text":"abc"}
{"text":"123"}
Outputs:
out: ParseError {errorContexts = ["demandInput"], errorMessage = "not enough bytes", errorPosition = 3:1}
and out.txt:
MyMessage "abc"MyMessage "123"
This is a perfect use case for conduitParserEither:
parseMessage :: (MonadIO m, MonadResource m) => Conduit B.ByteString m B.ByteString
parseMessage =
CA.conduitParserEither json =$= awaitForever go
where
go (Left s) = error $ show s
go (Right (_, msg)) = yield $ B8.pack $ show msg ++ "\n"
If you're on FP Haskell Center, you can clone my solution into the IDE.