1{-# LANGUAGE ParallelListComp,
2             TransformListComp,
3             RecordWildCards #-}
4module Test10312 where
5-- From
6-- https://ocharles.org.uk/blog/guest-posts/2014-12-07-list-comprehensions.html
7
8import GHC.Exts
9import qualified Data.Map as M
10import Data.Ord (comparing)
11import Data.List (sortBy)
12
13-- Let’s look at a simple, normal list comprehension to start:
14
15regularListComp :: [Int]
16regularListComp = [ x + y * z
17                  | x <- [0..10]
18                  , y <- [10..20]
19                  , z <- [20..30]
20                  ]
21
22parallelListComp :: [Int]
23parallelListComp = [ x + y * z
24                   | x <- [0..10]
25                   | y <- [10..20]
26                   | z <- [20..30]
27                   ]
28
29-- fibs :: [Int]
30-- fibs = 0 : 1 : zipWith (+) fibs (tail fibs)
31
32fibs :: [Int]
33fibs = 0 : 1 : [ x + y
34               | x <- fibs
35               | y <- tail fibs
36               ]
37
38fiblikes :: [Int]
39fiblikes = 0 : 1 : [ x + y + z
40                   | x <- fibs
41                   | y <- tail fibs
42                   | z <- tail (tail fibs)
43                   ]
44
45-- TransformListComp
46data Character = Character
47  { firstName :: String
48  , lastName :: String
49  , birthYear :: Int
50  } deriving (Show, Eq)
51
52friends :: [Character]
53friends = [ Character "Phoebe" "Buffay" 1963
54          , Character "Chandler" "Bing" 1969
55          , Character "Rachel" "Green" 1969
56          , Character "Joey" "Tribbiani" 1967
57          , Character "Monica" "Geller" 1964
58          , Character "Ross" "Geller" 1966
59          ]
60
61oldest :: Int -> [Character] -> [String]
62oldest k tbl = [ firstName ++ " " ++ lastName
63               | Character{..} <- tbl
64               , then sortWith by birthYear
65               , then take k
66               ]
67
68groupByLargest :: Ord b => (a -> b) -> [a] -> [[a]]
69groupByLargest f = sortBy (comparing (negate . length)) . groupWith f
70
71bestBirthYears :: [Character] -> [(Int, [String])]
72bestBirthYears tbl = [ (the birthYear, firstName)
73                     | Character{..} <- tbl
74                     , then group by birthYear using groupByLargest
75                     ]
76
77uniq_fs = [ (n, the p, the d') | (n, Fixity p d) <- fs
78                                   , let d' = ppDir d
79                                   , then group by Down (p,d') using groupWith ]
80