Reddit

example.hs

{-# LANGUAGE EmptyCase         #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}

module Reddit where

import           Control.Monad   (forM_, join)
import           Data.Maybe      (isJust)
import           Data.Semigroup  ((<>))
import           Data.String     (fromString)
import           Data.Text       (Text)
import           Test.QuickCheck

data Category =
      Internet
    | Animal
    | Funny
    | Math
    | Science
    | Haskell
    | Barbados
    | Video
    | News
    deriving (Eq, Show, Enum)

data Article = Article
    { aId            :: !Integer
    , aTitle         :: !Text
    , aAuthor        :: !User
    , aDescription   :: !Text
    , aCategory      :: !Category
    , aComments      :: ![Comment]
    , aTotalPoint    :: !Int
    , aTotalResponse :: !Int
    } deriving Show

data Comment = Comment
    { cId          :: !Integer
    , cAuthor      :: !User
    , cParentId    :: !(Maybe Integer)
    , cPoint       :: !Int
    , cDescription :: !Text
    , cResponse    :: ![Comment]
    } deriving Show

data User = User
    { userId   :: !Integer
    , userName :: !Text
    } deriving Show

instance Arbitrary Text where
    arbitrary = fromString <$> arbitrary

instance Arbitrary User where
    arbitrary = do
        userName <- elements ["Hiroto", "Ikuma", "Anna"]
        userId   <- choose (1, 10000000)

        pure User {..}

instance Arbitrary Comment where
     arbitrary = do
         cId          <- arbitrary
         cParentId    <- arbitrary
         cAuthor      <- arbitrary
         cPoint       <- choose (1, 100)
         cDescription <- arbitrary
         -- Problem!!
         listLen      <- choose (0,2)
         cResponse    <- vectorOf listLen arbitrary

         pure Comment {..}

instance Arbitrary Article where
    arbitrary = do
        aId          <- arbitrary
        aTitle       <- elements [ "Fishing with dolphins", "Fruits on genoside"
        　　　　　　　　　　　　　　　, "Franklin??", "Haskell in Barbados"]
        aAuthor      <- arbitrary
        aDescription <- arbitrary
        aCategory    <- elements [Internet .. News]
        aComments    <- arbitrary
        let aTotalPoint    = sum $ map sumPoint aComments
            aTotalResponse = length aComments + sum (map sumResponse aComments)

        pure Article {..}

sumPoint :: Comment -> Int
sumPoint Comment{..} =
    if null cResponse
    then cPoint
    else cPoint + sum (map sumPoint cResponse)

sumResponse :: Comment -> Int
sumResponse Comment{..} =
    if null cResponse
    then 0
    else length cResponse + sum (map sumResponse cResponse)

sumPointAndResponse :: Comment -> (Int, Int)
sumPointAndResponse comment =
    let totalPoint    = sumPoint comment
        totalResponse = sumResponse comment
    in (totalPoint, totalResponse)

sumPointArticle :: Article -> Int
sumPointArticle Article{..} = sum $ map sumPoint aComments

sumResponseArticle :: Article -> Int
sumResponseArticle Article{..} = length aComments + sum (map sumResponse aComments)

findCommentById :: Integer -> Article -> Maybe Comment
findCommentById commentId Article{..} = join $ safeHead $ map (findComment commentId) aComments
  where
    findComment :: Integer -> Comment -> Maybe Comment
    findComment comId comment@Comment{..}
        | comId == cId = Just comment
        | null cResponse =
          join $ safeHead $ map (findComment comId) cResponse
        | otherwise = Nothing

isCommentAvailable :: Integer -> Article -> Bool
isCommentAvailable commentId article = isJust $ findCommentById commentId article

safeHead :: [a] -> Maybe a
safeHead xs
   | null xs = Nothing
   | otherwise = Just $ head xs

runSumComment :: Int -> IO ()
runSumComment num = do
    randomComments <- generate $ vectorOf num (arbitrary :: Gen Comment)
    let accComments = map sumPointAndResponse randomComments
    forM_ accComments (\(point, response) ->
        putStrLn $ "The total point is: " <> show point <> ", # of responses " <> show response)