json parsing in haskell part 2 - Non-exhaustive patterns in lambda - json

Question

This is actually in continuation of the question I asked a few days back. I took the applicative functors route and made my own instances.
I need to parse a huge number of json statements all in a file, one line after the other. An example json statement is something like this -
{"question_text": "How can NBC defend tape delaying the Olympics when everyone has
Twitter?", "context_topic": {"followers": 21, "name": "NBC Coverage of the London
Olympics (July & August 2012)"}, "topics": [{"followers": 2705,
"name": "NBC"},{"followers": 21, "name": "NBC Coverage of the London
Olympics (July & August 2012)"},
{"followers": 17828, "name": "Olympic Games"},
{"followers": 11955, "name": "2012 Summer Olympics in London"}],
"question_key": "AAEAABORnPCiXO94q0oSDqfCuMJ2jh0ThsH2dHy4ATgigZ5J",
"__ans__": true, "anonymous": false}
sorry for the json formatting. It got bad
I have about 10000 such json statements and I need to parse them. The code I have written is
something like this -
parseToRecord :: B.ByteString -> Question
parseToRecord bstr = (\(Ok x) -> x) decodedObj where decodedObj = decode (B.unpack bstr) :: Result Question
main :: IO()
main = do
-- my first line in the file tells how many json statements
-- are there followed by a lot of other irrelevant info...
ts <- B.getContents >>= return . fst . fromJust . B.readInteger . head . B.lines
json_text <- B.getContents >>= return . tail . B.lines
let training_data = take (fromIntegral ts) json_text
let questions = map parseToRecord training_data
print $ questions !! 8922
This code gives me a runtime error Non-exhaustive patterns in lambda. The error references to \(Ok x) -> x in the code. By hit and trial, I came to the conclusion that the program works ok till the 8921th index and fails on the 8922th iteration.
I checked the corresponding json statement and tried to parse it standalone by calling the function on it and it works. However, it doesn't work when I call map. I don't really understand what is going on. Having learnt a little bit of haskell in "learn haskell for a great good", I wanted to dive into a real world programming project but seem to have got stuck here.
EDIT :: complete code is as follows
{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_GHC -O2 -optc-O2 #-}
{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}
import qualified Data.ByteString.Lazy.Char8 as B
import Data.Maybe
import NLP.Tokenize
import Control.Applicative
import Control.Monad
import Text.JSON
data Topic = Topic
{ followers :: Integer,
name :: String
} deriving (Show)
data Question = Question
{ question_text :: String,
context_topic :: Topic,
topics :: [Topic],
question_key :: String,
__ans__ :: Bool,
anonymous :: Bool
} deriving (Show)
(!) :: (JSON a) => JSObject JSValue -> String -> Result a
(!) = flip valFromObj
instance JSON Topic where
-- Keep the compiler quiet
showJSON = undefined
readJSON (JSObject obj) =
Topic <$>
obj ! "followers" <*>
obj ! "name"
readJSON _ = mzero
instance JSON Question where
-- Keep the compiler quiet
showJSON = undefined
readJSON (JSObject obj) =
Question <$>
obj ! "question_text" <*>
obj ! "context_topic" <*>
obj ! "topics" <*>
obj ! "question_key" <*>
obj ! "__ans__" <*>
obj ! "anonymous"
readJSON _ = mzero
isAnswered (Question _ _ _ _ status _) = status
isAnonymous (Question _ _ _ _ _ status) = status
parseToRecord :: B.ByteString -> Question
parseToRecord bstr = handle decodedObj
where handle (Ok k) = k
handle (Error e) = error (e ++ "\n" ++ show bstr)
decodedObj = decode (B.unpack bstr) :: Result Question
--parseToRecord bstr = (\(Ok x) -> x) decodedObj where decodedObj = decode (B.unpack bstr) :: Result Question
main :: IO()
main = do
ts <- B.getContents >>= return . fst . fromJust . B.readInteger . head . B.lines
json_text <- B.getContents >>= return . tail . B.lines
let training_data = take (fromIntegral ts) json_text
let questions = map parseToRecord training_data
let correlation = foldr (\x acc -> if (isAnonymous x == isAnswered x) then (fst acc + 1, snd acc + 1) else (fst acc, snd acc + 1)) (0,0) questions
print $ fst correlation
here's the data which can be given as input to the executable. I'm using ghc 7.6.3. If the program name is ans.hs, I followed these steps.
$ ghc --make ans.hs
$ ./ans < path/to/the/file/sample/answered_data_10k.in
thanks a lot!

Answer 1

The lambda function (\(Ok x) -> x) is partial in that it will only be able to match objects that were successfully decoded. If you are experiencing this, it indicates that your JSON parser is failing to parse a record, for some reason.
Making the parseToRecord function more informative would help you find the error. Try actually reporting the error, rather than reporting a failed pattern match.
parseToRecord :: B.ByteString -> Question
parseToRecord bstr = handle decodedObj
where handle (Ok k) = k
handle (Error e) = error e
decodedObj = decode (B.unpack bstr) :: Result Question
If you want more help, it might be useful to include the parser code.
Update
Based on your code and sample JSON, it looks like your code is first failing
when it encounters a null in the context_topic field of your JSON.
Your current code cannot handle a null, so it fails to parse. My fix would
be something like the following, but you could come up with other ways to
handle it.
data Nullable a = Null
| Full a
deriving (Show)
instance JSON a => JSON (Nullable a) where
showJSON Null = JSNull
showJSON (Full a) = showJSON a
readJSON JSNull = Ok Null
readJSON c = Full `fmap` readJSON c
data Question = Question
{ question_text :: String,
context_topic :: Nullable Topic,
topics :: [Topic],
question_key :: String,
__ans__ :: Bool,
anonymous :: Bool
} deriving (Show)
It also seems to fail on line 9002, where there is a naked value of "1000" on
that line, and it seems that several JSON values after that line lack the
'__ans__' field.

Answer 2

I would have suggestion to use Maybe in order to parse the null values:
data Question = Question
{ question_text :: String
, context_topic :: Maybe Topic
, topics :: [Topic]
, question_key :: String
, __ans__ :: Bool
, anonymous :: Bool
} deriving (Show)
And then change the readJSON function as follows (in addition, the missing ans-fields can be fixed by returning False on an unsuccessful parsing attempt):
instance JSON Question where
-- Keep the compiler quiet
showJSON = undefined
readJSON (JSObject obj) = Question <$>
obj ! "question_text" <*>
(fmap Just (obj ! "context_topic") <|> return Nothing) <*>
obj ! "topics" <*>
obj ! "question_key" <*>
(obj ! "__ans__" <|> return False) <*>
obj ! "anonymous"
readJSON _ = mzero
After getting rid of the 1000 in line 9000-something (like sabauma mentioned), I got 4358 as result. So maybe these slight changes are enough?