Stack Exchange API Reader

Question

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

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 using field=field in 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.