Tukukkk

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