ghc-debug-stub-0.1.0.0: LargeThunk.hs

{-# Language BangPatterns #-}
{-# Language DeriveAnyClass #-}
{-# Language DerivingStrategies #-}
{-# Language DuplicateRecordFields #-}
{-# LANGUAGE DeriveGeneric #-}
{-# Language GeneralizedNewtypeDeriving #-}
{-# Language LambdaCase #-}
{-# Language ParallelListComp #-}

import System.Environment (getArgs)
import Data.List (foldl', maximumBy, permutations, sortBy)
import Data.Function
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Control.DeepSeq
import GHC.Generics (Generic)

import GHC.Debug.Stub

import Debug.Trace

data MovieDB = MovieDB
    { users   :: !(Map UserID User)
    , movies  :: !(Map MovieID Movie)
    , ratings :: ![Rating]
    }
    deriving stock (Generic)
    deriving anyclass (NFData)

newtype UserID = UserID Int
    deriving newtype (Eq,Ord,Num,Enum)
    deriving stock (Generic)
    deriving anyclass (NFData)

data User = User
    { name  :: !String
    , trust :: !Double -- ^ How trusted this user is. In range [0,1]. Higher is more trustworthy.
    }
    deriving stock (Generic)
    deriving anyclass (NFData)

newtype MovieID = MovieID Int
    deriving newtype (Eq,Ord,Num,Enum)
    deriving stock (Generic, Show)
    deriving anyclass (NFData)

type Movie = String

data Rating = Rating
    { user   :: !UserID   -- ^ Who rated this movie.
    , movie  :: !MovieID  -- ^ Movie being rated.
    , rating :: !Double   -- ^ Rating In range [1,10]. Higher is better.
    }
    deriving stock (Generic)
    deriving anyclass (NFData)

main :: IO ()
main = withGhcDebug $ do
    -- Parse DB size from arguments
    [nUsersStr, nMoviesStr, nRatingsStr] <- getArgs
    let
        nUsers   = read nUsersStr
        nMovies  = read nMoviesStr
        nRatings = read nRatingsStr

    -- Create the DB
    putStrLn $ "Creating the DB with size ("
                ++ show nUsers ++ " users,"
                ++ show nMovies ++ " movies,"
                ++ show nRatings ++ " ratings)"
    let !movieDB = let
            users = M.fromList
                $ zip
                    [0..]
                    [ User name trust
                    | name <- take nUsers
                        $ fmap unwords
                        $ cycle
                        $ permutations ["abcdefghijklmnopqrstuvwxyz"]
                    | trust <- cycle [0.0, 0.1 .. 1.0]
                    ]

            movies = M.fromList
                $ zip
                    [0..]
                    (take nMovies
                        $ fmap unwords
                        $ cycle
                        $ permutations ["The", "Cat", "In", "The", "Hat", "House", "Mouse", "Story", "Legend"]
                    )

            ratings = take nRatings
                $ cycle
                $ zipWith3
                    Rating
                    (cycle (M.keys users))
                    (cycle (M.keys movies))
                    (cycle [1.0, 1.01 .. 9])

            in force $ MovieDB
                { users = users
                , movies = movies
                , ratings = ratings
                }

    do
        let msg = "DB created."
        traceEventIO msg
        putStrLn msg
    putStrLn "Hit ENTER to continue."
    _ <- getLine


    -- A single user's favorite movie.
    do
        let
            (userIDA, userA) = M.assocs (users movieDB) !! 0
            favoriteMovieID
                = snd
                $ maximumBy (compare `on` fst)
                    [ (rating, movieID)
                    | Rating userIDB movieID rating <- ratings movieDB
                    , userIDA == userIDB
                    ]

        putStrLn $ "User '" ++ name userA ++ "''s favorite movie: " ++ (movies movieDB M.! favoriteMovieID)

    -- Top rated movies
    -- each rating is weighted by the user's trust score.
    do
        let
            weight_movies = foldl' go M.empty (ratings movieDB)

            go :: Map MovieID (Double, Double) -> Rating -> Map MovieID (Double, Double)
            go weights (Rating userID movieID score) = M.alter
                (\case
                    Nothing -> Just (userTrust * score, userTrust)
                    Just (weightedScore, weight) -> let
                        weightedScore' = weightedScore + (userTrust * score)
                        weight'        = weight        + userTrust
                        in Just (weightedScore', weight')
                )
                movieID
                weights
                where
                userTrust = trust ((users movieDB) M.! userID)

        saveClosures [Box weight_movies]
        putStrLn "Pausing"
        getLine

            -- (Movie ID, rating) sorted by rating.
        let movieRatings :: [(MovieID, Double)]
            movieRatings
                = sortBy (compare `on` snd)
                $ fmap (\(movieID, (weightedRating, weight)) -> (movieID, weightedRating / weight))
                $ filter (\(_, (_, weight)) -> weight /= 0)
                $ M.assocs weight_movies

        putStrLn "Top 10 movies:"
        putStrLn $ unlines $ fmap show $ take 10 $ reverse $ movieRatings

    traceEventIO "Top 10 movies done."
    putStrLn "Hit ENTER to continue."
    _ <- getLine

    touch movieDB

{-# NOINLINE touch #-}
touch :: a -> IO ()
touch a = return ()