1
\$\begingroup\$

I'm learning Haskell and even though I have experience with Functional Programming the Typesystem has been a challenge. I did this yesterday (after like 2 days) and I would like to know whether this is idiomatic Haskell. What this does is basically receive a Tweet ID and if the Tweet is replying to something then it pull all tweets in the thread and prints them to the screen. Here's a recording of the functionality https://asciinema.org/a/459103

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}

module Main where

import Configuration.Dotenv (defaultConfig, loadFile)
import Control.Monad (void)
import Data.Aeson (FromJSON (..) ToJSON (..), Value, decode, withObject, (.:), (.:?))
import Data.Aeson.Types (Parser (..))
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import Data.Maybe (fromJust)
import GHC.Generics
import Network.HTTP.Client
  ( Request (method, requestBody, requestHeaders),
    RequestBody (RequestBodyLBS),
    Response (..),
    httpLbs,
    newManager,
    setQueryString,
  )
import Network.HTTP.Client.Conduit (applyBearerAuth)
import Network.HTTP.Client.TLS (tlsManagerSettings)
import Network.HTTP.Simple (getResponseBody, parseRequest)
import System.Environment (getArgs, getEnv)

data TweetUser = TweetUser
  { name :: String,
    username :: String
  }
  deriving (Generic, Show)

data Tweet = Tweet
  { tweetId :: String,
    statusIdReply :: Maybe String,
    text :: String,
    user :: TweetUser
  }
  deriving (Generic, Show)

instance FromJSON Tweet where
  parseJSON = tweetParser

instance FromJSON TweetUser where
  parseJSON = tweetUserParser

tweetParser :: Value -> Parser Tweet
tweetParser = withObject "Tweet" $ \obj -> do
  tweetId <- obj .: "id_str"
  statusIdReply <- obj .:? "in_reply_to_status_id_str"
  text <- obj .: "full_text"
  user <- obj .: "user"
  pure (Tweet {tweetId = tweetId, statusIdReply = statusIdReply, text = text, user = user})

tweetUserParser :: Value -> Parser TweetUser
tweetUserParser = withObject "TweetUser" $ \obj -> do
  name <- obj .: "name"
  username <- obj .: "screen_name"
  pure (TweetUser {name = name, username = username})

bearerToken :: IO (BS.ByteString)
bearerToken = do
  tokenEnv <- getEnv "BEARER_TOKEN"
  return $ BS8.pack tokenEnv

baseUrl :: String
baseUrl = "https://api.twitter.com/1.1/statuses/show.json"

applyQueryStringAndAuth :: String -> BS.ByteString -> Request -> Request
applyQueryStringAndAuth tweetId token request = queryStr $ authReq
  where
    idParam = ("id", Just (BS8.pack tweetId))
    tweetMode = ("tweet_mode", Just "extended")
    queryStr = setQueryString [idParam, tweetMode]
    authReq = applyBearerAuth token request

tweetResponse :: String -> IO (Tweet)
tweetResponse tweetId = do
  manager <- newManager tlsManagerSettings
  nakedRequest <- parseRequest baseUrl
  token <- bearerToken
  let request = applyQueryStringAndAuth tweetId token nakedRequest
  response <- httpLbs request manager
  return $ fromJust $ decode $ getResponseBody response

-- Based on the reply id (Whether a tweet is replying to another one)
-- we're asking for more tweets and putting them in an accumulator
moreTweets :: Maybe String -> [Tweet] -> IO ([Tweet])
moreTweets Nothing accTweets = return accTweets
moreTweets (Just replyId) accTweets = do
  newTweet <- tweetResponse replyId
  moreTweets (statusIdReply newTweet) (newTweet : accTweets)

parseTweets :: [Tweet] -> [String]
parseTweets = map convertToStr
  where
    convertToStr x = "\nusername: @" ++ (username $ user x) ++ "\nname: " ++ (name $ user x) ++ "\ntext: " ++ text x ++ "\n---"

-- Just follows a thread by Tweet ID
getThread :: String -> IO ()
getThread tweetId = do
  tweet <- tweetResponse tweetId
  tweets <- moreTweets (statusIdReply tweet) [tweet]
  let parsedTweets = parseTweets tweets
  mapM_ putStrLn parsedTweets

main :: IO ()
main = do
  void $ loadFile defaultConfig
  [tweetId] <- getArgs
  getThread tweetId

I'd appreciate any feedback, this language is awesome so I would like to do it correctly :)

\$\endgroup\$
5
\$\begingroup\$

Big disclaimer: Whilst I review a lot of code, I'm not even close to a Haskell expert, so some of these ideas are probably not perfect, or even plain wrong, so take as starter points.


A few style ideas

Reduce imports

There are lots of redundant imports there. Tidying imports, like in most languages is important, but perhaps a bit harder in Haskell due to the nuances of importing. Good linters / IDEs can help here (see below).

Ditch unnecessary extensions

There are so many powerful extensions in Haskell that it's important to keep on top of what you need and what you don't need (there are linters that can help) In particular, you don't need Generic (and so {-# LANGUAGE DeriveGeneric #-}) for JSON if you're defining your own parsers.

Use hlint

hlint is probably the best linter (well, static analyser really) I have used in 12+ languages. Due to the strong typing and guarantees in Haskell, it can provide deep insights using various laws, and as a beginner (and now intermediate) I learned -- and helped colleagues learn -- a lot of Haskell just from listening to its wonderful suggestions.

Also a linter

stylish-haskell is great IMO, but if you want a more opinionated linter, try Ormolu (or Fourmolu) or Brittany

Code changes

Scoping

Beware of global scope of records! Coming from other languages (as I did) this is hard to understand. tweetId in your Haskell module is now a function (of Tweet -> String) that you get "for free" by defining that record type Tweet. This means, whilst it works as is, there's scope overriding going on every time you use a binding called tweetId later on. One day this will bite you hard... Consequently, annoyingly, it's idiomatic to prefix record fields with a bit, e.g. tweetId, tweetStatusIdReply, tweetText etc, though there are strong opinions around this, and actually things with record accessing are now changing

Use stronger types

Strings are useful, but type blindness is all too easy with say, foo :: String -> String -> String -> Int - i.e. mixing up the order is a common bug. By defining custom data types or using newtype (to wrap strings), you get much stronger guarantees for very little overhead:

getTweetResponse :: String -> IO Tweet
-- vs
getTweetResponse :: TweetID -> IO Tweet

See https://mmhaskell.com/liftoff/data-types for some good background reading.

Ditch partial functions

It's often said that partial functions should be avoided For example, fromJust is evil - It blows up at runtime just by giving it a Nothing! Much better is to pass around this uncertainty (Maybe) and make it part of your data / control flow e.g.

tweetResponse :: String -> IO (Maybe Tweet)

Ditch partial pattern matches too!

Your pattern match:

[tweetId] <- getArgs

blows up with a runtime error (!) if there are zero args, or two or more args. Better to handle this with case (or various other ways). This makes code more lengthy but it's totally worth it.

Use decodeEither for nicer messages

Aeson's decode just gives you a result or Nothing. By using eitherDecode, you can get a helpful error message when things go wrong.

Handle non-200 responses

Currently the code parses any HTTP response the same (e.g. 401), even if it's an error. This will produce errors that are very confusing when things go wrong

Unwrap function parameters

It's often not that helpful to do the container processing ("unwrapping") - just keep it simple! e.g. why have parseTweets which takes a list of tweets and gives you a list of their strings; rather, just define parseTweet and let the user call map (or maybe fmap etc, i.e. using some other container type). The code looks simpler this way too:

parseTweet :: Tweet -> String
parseTweet x = "\nusername: @" ++ userUsername (tweetUser x) ++ "\nname: " ++ userFullName (tweetUser x) ++ "\ntext: " ++ tweetText x ++ "\n---"

Likewise, with Maybes:

moreTweets :: Maybe String -> [Tweet] -> IO ([Tweet])

Why process a Nothing to a Nothing manually?... just call it moreTweets :: String -> [Tweet] -> IO ([Tweet]) leave it to fmap (or maybeToList), or...

Neater recursion

It seems the current code has tweetResponse, getThread moreTweets, all of which are various twists on taking tweetID and getting back tweets. Do we need all of these, or perhaps they could be combined?...

Use list methods for neatness

intercalate is very useful for turning a list of strings into, say, lines of text (avoiding all the \ns, and lists are much easier to read in code).

Reduce reliance on IO side-effects

IO in Haskell is clever and different, but looking back was maybe a slight mistake that so many things operate in it.

This often results in the IO Monad "polluting" code if not kept in check. But this is sometimes not necessary, and you should aim to keep all functions pure wherever possible (in many languages, arguably); makes testing and reasoning easier. Even when not doing that, it's nice to pass data around, so perhaps getThread :: String -> IO () should be getThread :: String -> IO [String] i.e. it returns a list of strings that the caller could print if they want (or ignore, or write to a DB, etc etc). In short, avoid IO () especially.

In fact, if you're interested to go deeper, read about Monad Transformers

Consider using Data.Text

It's annoying but eventually as a project gets bigger you should make the switch to Text (or something similar) from String. Some reading:

Related: I like using <> (mappend) instead of ++ as it works on more types of data, including, say, Text...

A refactored version

FWIW, here's an updated version I did. Lots more improvements could be done no doubt but hopefully this illustrates all the points above (and a few more naming things):

{-# LANGUAGE OverloadedStrings #-}

module Main where

import           Configuration.Dotenv    (defaultConfig, loadFile)
import           Data.Aeson              (FromJSON (..), eitherDecode,
                                          withObject, (.:), (.:?))
import qualified Data.ByteString         as BS
import qualified Data.ByteString.Char8   as BS8
import           Data.List               (intercalate)
import           Network.HTTP.Client     (Request, applyBearerAuth, httpLbs,
                                          newManager, parseRequest,
                                          setQueryString)
import           Network.HTTP.Client.TLS (tlsManagerSettings)
import           Network.HTTP.Simple     (getResponseBody,
                                          getResponseStatusCode)
import           System.Environment      (getArgs, getEnv)


newtype TweetID = TweetID String
  deriving (Show, Eq)

newtype Token = Token BS.ByteString
  deriving (Show, Eq)

data User = User
  { userFullName :: String,
    userUsername :: String
  }
  deriving (Show, Eq)

data Tweet = Tweet
  { tweetId          :: TweetID,
    tweetInReplyToId :: Maybe TweetID,
    tweetText        :: String,
    tweetUser        :: User
  }
  deriving (Show, Eq)

instance FromJSON Tweet where
  parseJSON =  withObject "Tweet" $ \obj -> do
    tid <- obj .: "id_str"
    statusIdReply <- obj .:? "in_reply_to_status_id_str"
    text <- obj .: "full_text"
    user <- obj .: "user"
    pure (Tweet {tweetId = TweetID tid, tweetInReplyToId = TweetID <$> statusIdReply, tweetText = text, tweetUser = user})

instance FromJSON User where
  parseJSON = withObject "TweetUser" $ \obj -> do
    name <- obj .: "name"
    username <- obj .: "screen_name"
    pure $ User name username

getBearerToken :: IO Token
getBearerToken = do
  tokenEnv <- getEnv "BEARER_TOKEN"
  (return . Token . BS8.pack) tokenEnv

baseUrl :: String
baseUrl = "https://api.twitter.com/1.1/statuses/show.json"

applyQueryStringAndAuth :: Token -> TweetID -> Request -> Request
applyQueryStringAndAuth (Token rawToken) (TweetID tid) request = queryStr authReq
  where
    idParam = ("id", Just (BS8.pack tid))
    tweetMode = ("tweet_mode", Just "extended")
    queryStr = setQueryString [idParam, tweetMode]
    authReq = applyBearerAuth rawToken request

-- | Gets a Tweet by ID from the API
getTweetResponse :: Token -> TweetID -> IO (Either String Tweet)
getTweetResponse token tid = do
  manager <- newManager tlsManagerSettings
  nakedRequest <- parseRequest baseUrl
  let request = applyQueryStringAndAuth token tid nakedRequest
  response <- httpLbs request manager
  let body = getResponseBody response
  return $
    case getResponseStatusCode response of
      200 -> eitherDecode body
      badCode -> Left ("Got Bad status code: HTTP " <> show badCode <> ": " <> show body)

-- | Get all tweets in a thread, accumulating to the given list
getTweetThread :: Token -> TweetID -> IO [Tweet]
getTweetThread token = recurse []
  where
    recurse tweets tid = do
      response <- getTweetResponse token tid
      case response of
        Right replyTweet ->
          let allTweets = replyTweet : tweets
              maybeReplyId = tweetInReplyToId replyTweet
          in maybe (return allTweets) (recurse allTweets) maybeReplyId
        Left message -> error message

renderTweet :: Tweet -> String
renderTweet tweet = intercalate "\n" fields
  where
    fields =
      [ "username: @" <> userUsername user,
        "name: " <> userFullName user,
        "text: " <> tweetText tweet
      ]
    user = tweetUser tweet

main :: IO ()
main = do
  _ <- loadFile defaultConfig
  token <- getBearerToken
  args <- getArgs
  case args of
    [tid] -> do
      tweets <- getTweetThread token (TweetID tid)
      putStrLn $ intercalate "\n---\n" (renderTweet <$> tweets)
    _ -> error "Usage: shrink <TWEET ID>"
\$\endgroup\$
1
  • 1
    \$\begingroup\$ Thanks a lot @declension! This has been really helpful, even though I was aware of some of the design decisions behind this (Like pattern matching on a single item in the list of the tweet ID and doing fromJust) I still appreciate all the feedback for a safer approach. I will be taking a look at the links you provided as well. \$\endgroup\$
    – Aguxez
    Jan 1 at 20:38

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.