Ticket #1686: Reproduction.hs

File Reproduction.hs, 1.9 KB (added by simonpj, 8 years ago)

Repo case for #1686

Line 
1module Main where
2
3import Control.Arrow
4import Control.Monad (foldM)
5import Control.Parallel.Strategies (rnf)
6import qualified Data.ByteString.Char8 as B
7import qualified Data.IntMap as M
8import Data.List (foldl')
9import System.Directory
10import System.Environment (getArgs)
11import System.IO (stderr, hPutStr)
12
13loadMovie :: String -> IO (Maybe (Int, M.IntMap Int))
14loadMovie path = 
15    do text <- B.readFile path
16       return $
17          case B.lines text of
18            []     -> Nothing
19            (s:ss) -> 
20                let Just (movie, _) = B.readInt s
21                in Just (movie, ratings ss)
22    where addInt list string = (movie, rating) : list
23              where Just (movie, rest) = B.readInt string
24                    Just (rating, _)   = B.readInt (B.tail rest) 
25          ratings ss = rnf l `seq` M.fromList l
26              where l = foldl' addInt [] ss
27
28load :: String -> IO (M.IntMap (M.IntMap Int))
29load path =
30    do files <- getDirectoryContents path
31       case files of 
32         [] -> return M.empty
33         _  -> foldM addMovie M.empty files
34    where addMovie :: M.IntMap (M.IntMap Int) -> String -> IO (M.IntMap (M.IntMap Int))
35          addMovie map file =
36              if file == "." || file == ".."
37              then return map
38              else do Just (movie, ratings) <- loadMovie (path ++ "\\" ++  file)
39                      hPutStr stderr "."
40                      return $ M.insert movie ratings map
41
42averages path =
43    do movies <- load path
44       let averages = map (\(movie, ratings) -> (movie, M.fold (\rating (sum, count) -> (sum + rating, count + 1)) (0,0) ratings)) (M.toList movies)
45           averages' = map (second (\(sum, length) -> fromIntegral sum / fromIntegral length)) averages
46       mapM_ print averages'
47                     
48
49main = 
50    do args <- getArgs
51       averages (args !! 0)