Haskell Aeson destructuring generic parse - haskell

I have a JSON request in the style of
{"command":"get","params":{"something":"something else"}}
and this code snippet from the Yesod book
{-# LANGUAGE OverloadedStrings #-}
import Network.Wai (Response, responseLBS, Application, requestBody)
import Network.HTTP.Types (status200, status400)
import Network.Wai.Handler.Warp (run)
import Data.Aeson.Parser (json)
import Data.Conduit.Attoparsec (sinkParser)
import Control.Monad.IO.Class (liftIO)
import Data.Aeson (Value(..), encode, object, (.=))
import Control.Exception (SomeException)
import Data.ByteString (ByteString)
import Data.Conduit (ResourceT, ($$))
import Control.Exception.Lifted (handle)
main :: IO ()
main = run 3000 app
app :: Application
app req = handle invalidJson $ do
value <- requestBody req $$ sinkParser json
newValue <- liftIO $ modValue value
return $ responseLBS
status200
[("Content-Type", "application/json")]
$ encode newValue
invalidJson :: SomeException -> ResourceT IO Response
invalidJson ex = return $ responseLBS
status400
[("Content-Type", "application/json")]
$ encode $ object
[ ("message" .= show ex)
]
-- Application-specific logic would go here.
modValue :: Value -> IO Value
modValue (Object o)
| -- key "command" corresponds to value "get"
| otherwise = fail "Invalid command"
But I can't wrap my head around how I would destructure the generated Value data structure. How do I go about getting the values of keys etc. I realise I could parse to an explicitly defined data structure, but that would bring other kinds of problems to my use case.
In modValue I've put a comment where I can't figure out what to put. I tried treating it as a Map, since that's how it is implemented inside Aeson, but that obviously doesn't type check.
EDIT:
Adding Data.HashMap to imports and using the line
| M.lookup "command" o == Just "get" = return $ object [("result" .= (String "YAY"))]
gives the following error message.
main.hs:39:26:
Couldn't match expected type `M.Map k0 a0'
with actual type `aeson-0.6.0.2:Data.Aeson.Types.Internal.Object'
In the second argument of `M.lookup', namely `o'
In the first argument of `(==)', namely `M.lookup "command" o'
In the expression: M.lookup "command" o == Just "get"
EDIT2:
On a sudden hunch, I tracked down an error message I got earlier involving "unordered-containers". This is the package that Aeson uses. But I realised that I also had the package hashmap installed, which is imported as Data.HashMap. The hashmaps from unordered-containers are imported as Data.HashMap.Strict or Lazy!
Changing the line import qualified Data.HashMap as M to import qualified Data.HashMap.Strict as M fixed it anyway. Now the given answer works!

Since an aeson JSON object is a Hashmap, you can use the Hasmap interface, in this case lookup.
import qualified Data.HashMap.Strict as M
M.lookup "command" o == Just "get"

Related

Type mismatch error in making HTTP request

Trying to make a HTTP request, I got the error:
{-# LANGUAGE OverloadedStrings #-}
import Network.HTTP.Conduit -- the main module
-- The streaming interface uses conduits
import Data.Conduit
import Data.Conduit.Binary (sinkFile)
import qualified Data.ByteString.Lazy as L
import Control.Monad.IO.Class (liftIO)
main :: IO ()
main = do
simpleHttp "http://www.example.com/foo.txt" >>= L.writeFile "foo.txt"
The error is:
Couldn't match type `L.ByteString'
with `bytestring-0.10.0.2:Data.ByteString.Lazy.Internal.ByteString'
Expected type: bytestring-0.10.0.2:Data.ByteString.Lazy.Internal.ByteString
-> IO ()
Actual type: L.ByteString -> IO ()
In the return type of a call of `L.writeFile'
In the second argument of `(>>=)', namely `L.writeFile "foo.txt"'
In a stmt of a 'do' block:
simpleHttp "http://www.example.com/foo.txt"
>>= L.writeFile "foo.txt"
I can't figure out how to solve it because the text of the error doesn't really make sense.
You have two conflicting versions on bytestring package. Try ghc-pkg list bytestring. I'd suggest you to cabalize your code and use cabal sandbox.
See also "Couldn't match expected type with actual type" error when using Codec.BMP
BTW, the error message should be better in ghc-7.8, see https://ghc.haskell.org/trac/ghc/ticket/8278

Haskell Aeson JSON Library ByteString Issue

I'm having trouble finding a function or workaround to convert a String to Data.ByteString.Lazy.Internal.ByteString
One of the functions in the Aeson Json library is decode and has the following description:
decode :: FromJSON a => bytestring-0.10.0.2:Data.ByteString.Lazy.Internal.ByteString -> Maybe a
I've tried using the pack function in Data.ByteString.Lazy.Char8 but that returns a different ByteString. Any one know how this can be fixed?
The following is the example I'm working on:
import Data.Aeson
import Data.Text
import Control.Applicative
import Control.Monad (mzero)
import qualified Data.ByteString.Lazy.Internal as BLI
import qualified Data.ByteString.Lazy.Char8 as BSL
data Person = Person
{ name :: Text
, age :: Int
} deriving Show
instance FromJSON Person where
parseJSON (Object v) = Person <$>
v .: (pack "name") <*>
v .: (pack "age")
parseJSON _ = mzero
I tried using decode (BSL.pack "{\"name\":\"Joe\",\"age\":12}") :: Maybe Person
and got the following error message:
Couldn't match expected type `bytestring-0.10.0.2:Data.ByteString.Lazy.Internal.ByteString'
with actual type `BSL.ByteString'
In the return type of a call of `BSL.pack'
In the first argument of `decode', namely
`(BSL.pack "{\"name\":\"Joe\",\"age\":12}")'
In the expression:
decode (BSL.pack "{\"name\":\"Joe\",\"age\":12}") :: Maybe Person
Help!
You need to convert Char to Word8 using c2w (in Data.ByteString.Internal)
Data.ByteString.Lazy.pack $ map c2w "abcd"
I wrote out the fully qualified name for pack also to guarantee using the correct one, but you can clean this up in the imports section. When I run
> :t Data.ByteString.Lazy.pack $ map c2w "abcd"
I get ":: Data.ByteString.Lazy.Internal.ByteString"
Remember that Data.ByteString.Lazy represents strings of number values (you can't even run its pack on strings, you need to supply an array of numbers "pack [1, 2, 3, 4]"), so you might actually want to use the char equivalent Data.ByteString.Lazy.Char8.
You can also use for convenience fromString from Data.ByteString.Lazy.UTF8 from utf8-string.
It's a module of functions for the same ByteString type as aeson uses. It relyies on UTF8 as the encoding used in the buffers.

Aeson deriveJSON combined with conduit sinkParser

Continuing my exploration of conduit and aeson, how would I go about using my own data type in stead of Value in this (slightly modified) code snippet from the Yesod book.
{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}
import Network.Wai (Response, responseLBS, Application, requestBody)
import Network.HTTP.Types (status200, status400)
import Network.Wai.Handler.Warp (run)
import Data.Aeson.Parser (json)
import Data.Conduit.Attoparsec (sinkParser)
import Control.Monad.IO.Class (liftIO)
import Data.Aeson (Value(..), encode, object, (.=))
import Control.Exception (SomeException)
import Data.ByteString (ByteString)
import Data.Conduit (ResourceT, ($$))
import Control.Exception.Lifted (handle)
import qualified Data.HashMap.Strict as M
import Data.Aeson.TH (deriveJSON)
-- I ADDED THIS
data JSONRequest = JSONRequest {
command :: ByteString,
params :: M.HashMap ByteString ByteString
}
deriveJSON id ''JSONRequest
-- END OF WHAT I ADDED
main :: IO ()
main = run 3000 app
app :: Application
app req = handle invalidJson $ do
value <- requestBody req $$ sinkParser json
newValue <- liftIO $ dispatch value
return $ responseLBS
status200
[("Content-Type", "application/json")]
$ encode newValue
invalidJson :: SomeException -> ResourceT IO Response
invalidJson ex = return $ responseLBS
status400
[("Content-Type", "application/json")]
$ encode $ object
[ ("message" .= show ex)
]
-- Application-specific logic would go here.
dispatch :: Value -> IO Value
dispatch = return
Basically, I want to change the type of dispatch to JSONRequest -> IO JSONRequest. How do I tell the parser to use my own derived instance of fromJSON?
I tried just adding a type declaration, praying for polymorphic return type on json, but I realised it is strictly for Value.
Just looking at the types, don't you just need to fmap your fromJSON over the result coming from json? With a suitable signature for dispatch we just need:
-- import Data.Aeson
app :: Application
app req = handle invalidJson $ do
result <- requestBody req $$ sinkParser (fmap fromJSON json)
next_result <- liftIO $ dispatch result
return $ responseLBS status200 [("Content-Type", "application/json")]
$ encode next_result
dispatch :: Result JSONRequest -> IO JSONRequest
dispatch (Error str) = undefined
dispatch (Success jsonreq) = return jsonreq
But maybe it's a little clearer written thus:
-- import Data.Aeson
-- import qualified Data.Attoparsec as Atto
toRequest :: Value -> Result JSONRequest
toRequest = fromJSON -- specialized now to your fromJSON
jsonRequestParser :: Atto.Parser (Result JSONRequest)
jsonRequestParser = fmap toRequest json
app :: Application
app req = handle invalidJson $ do
result <- requestBody req $$ sinkParser jsonRequestParser
next_result <- liftIO $ dispatch result
return $ responseLBS status200 [("Content-Type", "application/json")]
$ encode next_result
dispatch :: Result JSONRequest -> IO JSONRequest
dispatch (Error str) = undefined
dispatch (Success jsonreq) = return jsonreq
I left the parser returning a Result JSONRequest so dispatch is handling Error cases too, which might mean you need your exception handling somehow?

lifting function into IO monad to parse a json string read from a file

I am having the problem that readFile returns an IO String but parse expects a regular String (or in the example below a ByteString). I though I simply use liftM but the example below still fails. What is the problem?
import Data.Aeson
import Data.Attoparsec
import Data.ByteString (ByteString, pack)
import Data.Maybe
import Network.HTTP
import Network.URI
import qualified Data.ByteString.Char8 as C
import Control.Monad
main = do
myres <- liftM parse json (C.readFile "dummy.json")
print myres
ERROR:
Couldn't match expected type `t0 -> Parser a0'
with actual type `Parser Value'
In the second argument of `liftM', namely `json'
In a stmt of a 'do' block:
myres <- liftM parse json (C.readFile "dummy.json")
In the expression:
do { myres <- liftM parse json (C.readFile "dummy.json");
print myres }
You miss parentheses around (parse json), so liftM is applied to parse

Haskell. MongoDB driver or Aeson charset problem

Good day, i have mongodb database filled with some data, i ensured that data stored in correct charset, to fetch data i use following snippet:
{-# LANGUAGE OverloadedStrings #-}
import Network.Wai
import Network.Wai.Handler.Warp (run)
import Data.Enumerator (Iteratee (..))
import Data.Either (either)
import Control.Monad (join)
import Data.Maybe (fromMaybe)
import Network.HTTP.Types (statusOK, status404)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import Data.ByteString.Char8 (unpack)
import Data.ByteString.Lazy.Char8 (pack)
import qualified Data.Text.Lazy as T
import Data.Text (Text(..))
import Control.Monad.IO.Class (liftIO, MonadIO)
import Data.Aeson (encode)
import qualified Data.Map as Map
import qualified Database.MongoDB as DB
application dbpipe req = do
case unpack $ rawPathInfo req of
"/items" -> itemsJSON dbpipe req
_ -> return $ responseLBS status404 [("Content-Type", "text/plain")] "404"
indexPage :: Iteratee B.ByteString IO Response
indexPage = do
page <- liftIO $ processTemplate "templates/index.html" []
return $ responseLBS statusOK [("Content-Type", "text/html; charset=utf-8")] page
processTemplate f attrs = do
page <- L.readFile f
return page
itemsJSON :: DB.Pipe -> Request -> Iteratee B.ByteString IO Response
itemsJSON dbpipe req = do
dbresult <- liftIO $ rundb dbpipe $ DB.find (DB.select [] $ tu "table") >>= DB.rest
let docs = either (const []) id dbresult
-- liftIO $ L.putStrLn $ encode $ show $ map docToMap docs
return $ responseLBS statusOK [("Content-Type", "text/plain; charset=utf-8")]
(encode $ map docToMap docs)
docToMap doc = Map.fromList $ map (\f -> (T.dropAround (== '"') $ T.pack $ show $ DB.label f, T.dropAround (== '"') $ T.pack $ show $ DB.value f)) doc
main = do
pipe <- DB.runIOE $ DB.connect $ DB.host "127.0.0.1"
run 3000 $ application pipe
rundb pipe act = DB.access pipe DB.master database act
tu :: B.ByteString -> UString
tu = DB.u . C8.unpack
Then the result is suprprising, DB.label works well, but DB.value giving me native characters as some escape codes, so the result is look like:
curl http://localhost:3000/items gives:
[{"Марка": "\1058\1080\1087 \1087\1086\1076",
"Model": "BD-W LG BP06LU10 Slim \1058\1080\1087 \1087\1086\1076\1082\1083\1102\1095\1077\1085\1080\1103"},
...
]
This happens in case i trying to print data and also in case i return data encoded as JSON
Any idea how correctly extract values from MongoDB driver ?
The following line confirms that aeson's encoding works properly (using the utf8-string library to read utf8 data off the lazy bytestring back to a haskell string:
> putStrLn $ Data.ByteString.Lazy.UTF8.toString $ encode $ ("\1058\1080\1087 \1087\1086\1076",12)
["Тип под",12]
Looking at your code more closely I see the real problem. You're calling T.pack $ show $ DB.value -- this will render out as literal codepoints, and then pack those into a text object. The fix is to switch from show to something smarter. Look at this (untested)
smartShow :: DB.Value -> Text
smartShow (String s) = Data.Text.Encoding.decodeUtf8 $ Data.CompactString.UTF8.toByteString s
smartShow x = T.pack $ show x
Obviously to handle the recursive cases, etc. you need to be smarter than that, but that's the general notion...
In fact, the "best" thing to do is to write a function of BSON -> JSON directly, rather than go through any intermediate structures at all.
Everything is working as expected -- only your expectations are wrong. =)
What you're seeing there are not raw Strings; they are String's which have been escaped to exist purely in the printable ASCII range by the show function, called by print:
print = putStrLn . show
Never fear: in memory, the string that prints as "\1058" is in fact a single Unicode codepoint long. You can observe this by printing the length of one of the Strings you're interested in and comparing that to the number of Unicode codepoints you expect.

Resources