I've been working on some code to pull questions from the realtime feed on stackexchange.com and query more information about them from the API. It works, but I'd love some feedback on how I could make better use of some of the monads and how I could make better use of Aeson. I'd also love general refactoring/code organization tips.
I've split my code into 3 sections (imports, aeson/type stuff, main code) to make it easier for reviewers. To run the code, just remove the text between them. In addition to the text above and below each section, I also added comments where I'm unsure about stuff in the code.
First, my imports. If there's any best-practices I should be aware of related to my use of language extensions or best-practices regarding how I import things, please let me know.
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DuplicateRecordFields #-}
-- Also, is this the right way to declare Main? I've seen it done in different ways in different places.
module Main (main) where
import Control.Concurrent (forkIO)
import Control.Monad (forever, unless)
import Control.Monad.Trans (liftIO)
import Network.Socket (withSocketsDo)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Network.WebSockets as WS
import qualified Data.ByteString.Lazy.Char8 (unpack)
import Data.CaseInsensitive ( CI )
import Data.Aeson
import GHC.Exts (fromString)
import Data.Maybe (fromJust)
import Data.List (intercalate)
import Network.HTTP.Conduit
import qualified Network.URI.Encode (encode)
import Data.Either.Unwrap (fromRight)
import Data.Aeson.Encode.Pretty
Next, my data types and aeson fromJSON instances. It seems like I've got a ton of repetition with field <- o .: "field" and then using field=field in the record syntax. Is there a better way to do that? I'm trying to avoid doing it with positional arguments to make it more flexible, in case I want to change the order for some reason.
Also, in my fromJSON declaration for QAThread, I create a Post instance which really could be created from the top level of the QAThread json. I feel like there must be a way to do that more efficiently.
I'm also open to ideas for better code organization/style/indentation/formatting in this section.
data WSResponse = WSResponse {action :: String, innerJSON :: String}
deriving(Show)
instance FromJSON WSResponse where
parseJSON = withObject "HashMap" $ \o ->
WSResponse <$> o .: "action"
<*> o .: "data"
data WSPost = WSPost {
siteBaseHostAddress :: String,
nativeId :: Int,
titleEncodedFancy :: String,
bodySummary :: String,
tags :: [String],
lastActivityDate :: Int,
url :: String,
ownerUrl :: String,
ownerDisplayName :: String,
apiSiteParameter :: String
}
deriving(Show)
instance FromJSON WSPost where
parseJSON = withObject "WSPost" $ \o -> do
siteBaseHostAddress <- o .: "siteBaseHostAddress"
nativeId <- o .: "id"
titleEncodedFancy <- o .: "titleEncodedFancy"
bodySummary <- o .: "bodySummary"
tags <- o .: "tags"
lastActivityDate <- o .: "lastActivityDate"
url <- o .: "url"
ownerUrl <- o .: "ownerUrl"
ownerDisplayName <- o .: "ownerDisplayName"
apiSiteParameter <- o .: "apiSiteParameter"
return WSPost {
siteBaseHostAddress=siteBaseHostAddress,
nativeId=nativeId,
titleEncodedFancy=titleEncodedFancy,
bodySummary=bodySummary,
tags=tags,
lastActivityDate=lastActivityDate,
url=url,
ownerUrl=ownerUrl,
ownerDisplayName=ownerDisplayName,
apiSiteParameter=apiSiteParameter
}
data APIResponse a = APIResponse {
items :: [a],
has_more :: Bool,
quota :: APIQuota
}
deriving(Show)
-- Only used in APIResponse, does not need its own fromJSON instance (although that might be prettier)
data APIQuota = APIQuota { total :: Int, remaining :: Int}
deriving(Show)
instance FromJSON b => FromJSON (APIResponse b) where
parseJSON = withObject "APIResponse" $ \o -> do
has_more <- o .: "has_more"
items <- o .: "items"
quota_max <- o .: "quota_max"
quota_remaining <- o .: "quota_remaining"
-- page, page_size, total, type
return APIResponse {
items=items,
has_more=has_more,
quota=APIQuota {total=quota_max, remaining=quota_remaining}
}
data User = User {
display_name :: String,
link :: String,
user_type :: String, -- Could prolly be its own type
reputation :: Int,
se_id :: Int
}
deriving(Show)
instance FromJSON User where
parseJSON = withObject "User" $ \o -> do
display_name <- o .: "display_name"
link <- o .: "link"
user_type <- o .: "user_type"
reputation <- o .: "reputation"
se_id <- o .: "user_id"
return User {
display_name=display_name,
link=link,
user_type=user_type,
reputation=reputation,
se_id=se_id
}
data Comment = Comment {
score :: Int,
link :: String,
owner :: User,
se_id :: Int,
creation_date :: Int,
edited :: Bool,
body :: String,
body_markdown :: String
}
deriving(Show)
instance FromJSON Comment where
parseJSON = withObject "Comment" $ \o -> do
score <- o .: "score"
link <- o .: "link"
owner <- o .: "owner"
se_id <- o .: "comment_id"
creation_date <- o .: "creation_date"
edited <- o .: "edited"
body <- o .: "body"
body_markdown <- o .: "body_markdown"
return Comment {
score=score,
link=link,
owner=owner,
se_id=se_id,
creation_date=creation_date,
edited=edited,
body=body,
body_markdown=body_markdown
}
data QAThread = QAThread {
title :: String,
tags :: [String],
question :: Post,
answers :: [Post]
}
deriving(Show)
instance FromJSON QAThread where
parseJSON = withObject "QAThread" $ \o -> do
tags <- o .: "tags"
title <- o .: "title"
answers <- o .:? "answers" .!= []
-- Stuff
q_se_id <- o .: "question_id"
q_up_vote_count <- o .: "up_vote_count"
q_down_vote_count <- o .: "down_vote_count"
q_owner <- o .: "owner"
q_last_edit_date <- o .:? "last_edit_date" .!= 0
q_last_activity_date <- o .:? "last_activity_date" .!= 0
q_creation_date <- o .: "creation_date"
q_comments <- o .:? "comments" .!= []
q_body <- o .: "body"
q_body_markdown <- o .: "body_markdown"
let question = Post {
se_id=q_se_id,
up_vote_count=q_up_vote_count,
down_vote_count=q_down_vote_count,
owner=q_owner,
last_edit_date=q_last_edit_date,
last_activity_date=q_last_activity_date,
creation_date=q_creation_date,
comments=q_comments,
body=q_body,
body_markdown=q_body_markdown
}
return QAThread {
title=title,
tags=tags,
question=question,
answers=answers
}
data Post = Post {
se_id :: Int,
up_vote_count :: Int,
down_vote_count :: Int,
owner :: User,
last_edit_date :: Int,
last_activity_date :: Int,
creation_date :: Int,
comments :: [Comment],
body :: String,
body_markdown :: String
}
deriving(Show)
instance FromJSON Post where
parseJSON = withObject "Post" $ \o -> do
answer_id <- o .: "answer_id"
question_id <- o .:? "question_id" .!= 0
let se_id = if question_id == 0 then answer_id else question_id
up_vote_count <- o .: "up_vote_count"
down_vote_count <- o .: "down_vote_count"
owner <- o .: "owner"
last_edit_date <- o .:? "last_edit_date" .!= 0
last_activity_date <- o .:? "last_activity_date" .!= 0
creation_date <- o .: "creation_date"
comments <- o .:? "comments" .!= []
body <- o .: "body"
body_markdown <- o .: "body_markdown"
return Post {
se_id=se_id,
up_vote_count=up_vote_count,
down_vote_count=down_vote_count,
owner=owner,
last_edit_date=last_edit_date,
last_activity_date=last_activity_date,
creation_date=creation_date,
comments=comments,
body=body,
body_markdown=body_markdown
}
And finally, the actual code for everything. Here's where most of my messy code is, and where I foresee needing the most improvement. All of my thoughts will be inline:
-- I have no idea how to write a type signature for this
-- Also, I really think that these Maybes should be propogated out to avoid errors. However, doing
-- that requires a bit more monad knowledge than I have.
parseWSJSON msg = fromJust (decode (fromString . innerJSON . fromJust $ (decode msg :: Maybe WSResponse)) :: Maybe WSPost)
-- This function declaration doesn't really make sense to me. It looks like it takes no argument, but
-- then it actually takes a connection?
app :: WS.ClientApp ()
app conn = do
putStrLn "Connected!" -- and how does this go to STDOUT if the monad here is a WS.ClientApp?
WS.sendTextData conn ("155-questions-active" :: Text)
-- Fork a thread that writes WS data to stdout
_ <- forkIO $ forever $ do
msg <- WS.receiveData conn -- and how does this work, aren't we in an IO monad now?
let post = parseWSJSON msg -- See comment by parseWSJSON above
apiPost <- getAPIPost post
-- I'd like to have a scanQaThread :: APIResponse QAThread -> ??? that does various things using
-- the data in the QAThread object. I have a feeling that I should do something monadic there to
-- preserve the Either-ness, but I don't know how. Suggestions appreciated.
let qa_thread = fromRight (eitherDecode apiPost :: Either String (APIResponse QAThread))
-- This is my take on pretty printing the json. I'm sure there's a better way, but it's not too important
liftIO $ T.putStrLn . T.pack $ unlines . map (take 100) . lines . Data.ByteString.Lazy.Char8.unpack $ (encodePretty (fromJust (decode apiPost :: Maybe Object)))
-- This is where we actually decode the json to a APIResponse QAThread
liftIO $ T.putStrLn . T.pack $ show (eitherDecode apiPost :: Either String (APIResponse QAThread))
-- Read from stdin and write to WS
let loop = do
line <- T.getLine
if line == "exit" then WS.sendClose conn ("Bye!" :: Text) else loop
loop
-- GHCi reports the type signature as of simpleHttp as Control.Monad.IO.Class.MonadIO m => String -> m Data.ByteString.Lazy.Internal.ByteString
-- but if I actually type IO Data.ByteString.Lazy.Internal.ByteString, I get an error.
-- getAPIPost :: WSPost -> IO ???
getAPIPost WSPost {apiSiteParameter=site, nativeId=nativeId} = simpleHttp $ "https://api.stackexchange.com/questions/" ++ show nativeId ++ generateQueryString [("site", site), ("filter", "!)F8(_jKugA9t(M_HBgMTswzW5VgyIjFl-O-sNR)ZYeihN)0*(")]
generateQueryString :: [(String, String)] -> String
generateQueryString = ("?"++) . intercalate "&" . map (\(k,v) -> Network.URI.Encode.encode k ++ "=" ++ Network.URI.Encode.encode v)
main :: IO ()
main = withSocketsDo $ WS.runClient "qa.sockets.stackexchange.com" 80 "/" app
1 Answer 1
As you've noticed yourself, your FromJSON instances suffer from duplication. You could use the automatic instance generation with -XDeriveGeneric, however, some of your fields would mismatch (namely id).
We can still fix this if we use custom options, which simply remove the native:
fixName :: String -> String
fixName xs
| "native" `isPrefixOf` xs = let (a:as) = drop 6 xs in toLower a : as
| otherwise = xs
data WSPost = WSPost {
... snip ...
}
deriving(Show, Generic)
instance FromJSON WSPost where
parseJSON = genericParseJSON customOptions
where customOptions = defaultOptions
{ fieldLabelModifier = fixNames
}
However, this still falls short on complicated fields like APIQuota. Here, we still suffer from duplication as you've noticed:
It seems like I've got a ton of repetition with
field <- o .: "field"and then usingfield=fieldin the record syntax. Is there a better way to do that?
Enter -XRecordWildCards. It does exactly what you want:
instance FromJSON b => FromJSON (APIResponse b) where
parseJSON = withObject "APIResponse" $ \o -> do
has_more <- o .: "has_more"
items <- o .: "items"
quota_max <- o .: "quota_max"
quota_remaining <- o .: "quota_remaining"
-- page, page_size, total, type
let quota = APIQuota {total=quota_max, remaining=quota_remaining}
return APIResponse { .. } -- no duplication here
Note that you can shuffle your elements in your types arbitrarily.
Unfortunately, I don't have time for a further in-depth analysis, but these remarks should help you improve the code and make it more readable. That being said, if you find yourself often in a situation where you want to describe code and still make it compileable or runnable, have a look at Literate Haskell.
Explore related questions
See similar questions with these tags.