File: Fusion.hs

package info (click to toggle)
haskell-infinite-list 0.1.1-1
  • links: PTS
  • area: main
  • in suites: forky, sid, trixie
  • size: 168 kB
  • sloc: haskell: 1,648; makefile: 5
file content (324 lines) | stat: -rw-r--r-- 14,106 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
-- |
-- Copyright:   (c) 2022 Bodigrim
-- Licence:     BSD3

{-# LANGUAGE PostfixOperators #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -O -dsuppress-all -dno-suppress-type-signatures -fplugin=Test.Tasty.Inspection.Plugin #-}

module Main where

import Test.Tasty
import Test.Tasty.ExpectedFailure
import Test.Tasty.Inspection
import Test.Tasty.Runners

import Data.Coerce
import Data.Ord
import Data.List.Infinite (Infinite(..))
import qualified Data.List.Infinite as I
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NE

foldrMap :: Infinite Int -> Infinite Int
foldrMap xs = I.foldr (\x acc -> fromIntegral x :< acc) (I.map fromIntegral xs :: Infinite Word)

foldrConsMap :: Int -> Infinite Int -> Infinite Int
foldrConsMap i xs = I.foldr (\x acc -> fromIntegral x :< acc) (fromIntegral i :< (I.map fromIntegral xs :: Infinite Word))

mapMap :: Infinite Int -> Infinite Int
mapMap xs = I.map fromIntegral (I.map fromIntegral xs :: Infinite Word)

mapId :: Infinite Int -> Infinite Int
mapId xs = I.map id (I.map id xs)

mapCoerce :: Infinite Int -> Infinite (Down Int)
mapCoerce xs = I.map coerce xs

headIterate :: Int -> Int
headIterate x = I.head (I.iterate (+ 1) x)

foldrIterate :: Int -> [Int]
foldrIterate x = I.foldr (\a acc -> a : a : acc) (I.iterate (+ 1) x)

foldrIterate' :: Int -> [Int]
foldrIterate' x = I.foldr (\a acc -> a : a : acc) (I.iterate (+ 1) x)

foldrRepeat :: Int -> [Int]
foldrRepeat x = I.foldr (\a acc -> a : a : acc) (I.repeat x)

headFilterIterate :: Int -> Int
headFilterIterate x = I.head (I.filter (> 10) (I.iterate (+ 1) x))

filterFilter :: Infinite Int -> Infinite Int
filterFilter xs = I.filter (> 10) (I.filter (> 5) xs)

filterFilter' :: Infinite Int -> Infinite Int
filterFilter' xs = I.filter (\x -> x > 10 && x > 5) xs

foldrScanl :: Infinite Int -> Infinite Int
foldrScanl xs = I.foldr (\a acc -> fromIntegral a :< acc)
  (I.scanl (\_acc a -> fromIntegral a) (0 :: Word) xs)

foldrScanl' :: Infinite Int -> Infinite Int
foldrScanl' xs = I.foldr (\a acc -> fromIntegral a :< acc)
  (I.scanl' (\_acc a -> fromIntegral a) (0 :: Word) xs)

takeRepeat :: Int -> [Int]
takeRepeat x = I.take x (I.repeat x)

takeWhileIterate :: Int -> [Int]
takeWhileIterate x = I.takeWhile (< 10) (I.iterate (+ 1) x)

foldrCycle :: NonEmpty Int -> [Int]
foldrCycle xs = I.foldr (:) (I.cycle xs)

foldrWordsCycle :: [Char] -> [Char]
foldrWordsCycle xs = I.foldr (\a acc -> NE.head a : acc) (I.words (I.cycle (' ' :| xs)))

foldrMapAccumL :: Infinite Int -> Infinite Int
foldrMapAccumL xs = I.foldr (\a acc -> fromIntegral a :< acc)
  (I.mapAccumL (\acc x -> (acc, fromIntegral x :: Word)) (0 :: Int) xs)

mapAccumLRepeat :: Int -> Infinite Int
mapAccumLRepeat n =
  I.mapAccumL (\acc x -> (acc, fromIntegral x)) 'q' (I.repeat (fromIntegral n :: Word))


takeFilterIterate :: [Int]
takeFilterIterate = I.take 100 $ I.filter odd $ I.iterate (+ 1) 0


sumTakeFilterIterate :: Int
sumTakeFilterIterate = sum $ I.take 100 $ I.filter odd $ I.iterate (+ 1) 0

takeFilterCycle :: [Int]
takeFilterCycle = I.take 100 $ I.filter odd $ I.cycle $ 0 :| [1..]

takeFilterEllipsis3 :: [Int]
takeFilterEllipsis3 = I.take 100 $ I.filter odd (0 I....)

takeFilterEllipsis4 :: [Int]
takeFilterEllipsis4 = I.take 100 $ I.filter odd ((0, 3) I.....)

sumTakeFilterEllipsis3 :: Int
sumTakeFilterEllipsis3 = sum $ I.take 100 $ I.filter odd (0 I....)

sumTakeFilterEllipsis4 :: Int
sumTakeFilterEllipsis4 = sum $ I.take 100 $ I.filter odd ((0, 3) I.....)


takeToListFilterIterate :: [Int]
takeToListFilterIterate = Prelude.take 100 $ I.toList $ I.filter odd $ I.iterate (+ 1) 0

sumTakeToListFilterIterate :: Int
sumTakeToListFilterIterate = sum $ Prelude.take 100 $ I.toList $ I.filter odd $ I.iterate (+ 1) 0

takeToListFilterCycle :: [Int]
takeToListFilterCycle = Prelude.take 100 $ I.toList $ I.filter odd $ I.cycle $ 0 :| [1..]

takeToListFilterEllipsis3 :: [Int]
takeToListFilterEllipsis3 = Prelude.take 100 $ I.toList $ I.filter odd (0 I....)

takeToListFilterEllipsis4 :: [Int]
takeToListFilterEllipsis4 = Prelude.take 100 $ I.toList $ I.filter odd ((0, 3) I.....)

sumTakeToListFilterEllipsis3 :: Int
sumTakeToListFilterEllipsis3 = sum $ Prelude.take 100 $ I.toList $ I.filter odd (0 I....)

sumTakeToListFilterEllipsis4 :: Int
sumTakeToListFilterEllipsis4 = sum $ Prelude.take 100 $ I.toList $ I.filter odd ((0, 3) I.....)


headFilterMapEllipsis3 :: Int
headFilterMapEllipsis3 = I.head $ I.filter odd $ I.map (+ 1) (0 I....)

headFilterMapEllipsis4 :: Int
headFilterMapEllipsis4 = I.head $ I.filter odd $ I.map (+ 1) ((0, 3) I.....)

toListConcatRepeat :: [Int]
toListConcatRepeat = I.toList $ I.concat $ I.repeat $ NE.singleton 1

toListConcatMapRepeat :: [Int]
toListConcatMapRepeat = I.toList $ I.concatMap NE.singleton $ I.repeat 1

toListIntersperseRepeat :: [Int]
toListIntersperseRepeat = I.toList $ I.intersperse 1 $ I.repeat 0

toListIntercalateRepeat :: [Int]
toListIntercalateRepeat = I.toList $ I.intercalate (NE.singleton 1) $ I.repeat [0]

headMapZipIterate :: Bool
headMapZipIterate = I.head $ I.map ((> 0) . snd) $ I.zip (I.repeat (1 :: Word)) $ I.iterate id (0 :: Int)

headMapFlipZipIterate :: Bool
headMapFlipZipIterate = I.head $ I.map ((> 0) . fst) $ flip I.zip (I.repeat (1 :: Word)) $ I.iterate id (0 :: Int)

zeros :: Infinite Word
zeros = I.repeat 0
{-# NOINLINE zeros #-}

zipWithRepeat1 :: Infinite Bool
zipWithRepeat1 = I.zipWith (\x y -> x == fromIntegral y) (I.repeat (1 :: Int)) zeros

zipWithRepeat2 :: Infinite Bool
zipWithRepeat2 = I.zipWith (\x y -> y == fromIntegral x) zeros (I.repeat (1 :: Int))

zipWith3Repeat1 :: Infinite Bool
zipWith3Repeat1 = I.zipWith3 (\x y z -> x == fromIntegral (y + z)) (I.repeat (1 :: Int)) zeros zeros

zipWith3Repeat2 :: Infinite Bool
zipWith3Repeat2 = I.zipWith3 (\x y z -> y == fromIntegral (x + z)) zeros (I.repeat (1 :: Int)) zeros

zipWith3Repeat3 :: Infinite Bool
zipWith3Repeat3 = I.zipWith3 (\x y z -> z == fromIntegral (x + y)) zeros zeros (I.repeat (1 :: Int))

zipWith4Repeat1 :: Infinite Bool
zipWith4Repeat1 = I.zipWith4 (\x y z t -> x == fromIntegral (y + z + t)) (I.repeat (1 :: Int)) zeros zeros zeros

zipWith4Repeat2 :: Infinite Bool
zipWith4Repeat2 = I.zipWith4 (\x y z t -> y == fromIntegral (x + z + t)) zeros (I.repeat (1 :: Int)) zeros zeros

zipWith4Repeat3 :: Infinite Bool
zipWith4Repeat3 = I.zipWith4 (\x y z t -> z == fromIntegral (x + y + t)) zeros zeros (I.repeat (1 :: Int)) zeros

zipWith4Repeat4 :: Infinite Bool
zipWith4Repeat4 = I.zipWith4 (\x y z t -> t == fromIntegral (x + y + z)) zeros zeros zeros (I.repeat (1 :: Int))

zipWith5Repeat1 :: Infinite Bool
zipWith5Repeat1 = I.zipWith5 (\x y z t u -> x == fromIntegral (y + z + t + u)) (I.repeat (1 :: Int)) zeros zeros zeros zeros

zipWith5Repeat2 :: Infinite Bool
zipWith5Repeat2 = I.zipWith5 (\x y z t u -> y == fromIntegral (x + z + t + u)) zeros (I.repeat (1 :: Int)) zeros zeros zeros

zipWith5Repeat3 :: Infinite Bool
zipWith5Repeat3 = I.zipWith5 (\x y z t u -> z == fromIntegral (x + y + t + u)) zeros zeros (I.repeat (1 :: Int)) zeros zeros

zipWith5Repeat4 :: Infinite Bool
zipWith5Repeat4 = I.zipWith5 (\x y z t u -> t == fromIntegral (x + y + z + u)) zeros zeros zeros (I.repeat (1 :: Int)) zeros

zipWith5Repeat5 :: Infinite Bool
zipWith5Repeat5 = I.zipWith5 (\x y z t u -> u == fromIntegral (x + y + z + t)) zeros zeros zeros zeros (I.repeat (1 :: Int))

zipWith6Repeat1 :: Infinite Bool
zipWith6Repeat1 = I.zipWith6 (\x y z t u v -> x == fromIntegral (y + z + t + u + v)) (I.repeat (1 :: Int)) zeros zeros zeros zeros zeros

zipWith6Repeat2 :: Infinite Bool
zipWith6Repeat2 = I.zipWith6 (\x y z t u v -> y == fromIntegral (x + z + t + u + v)) zeros (I.repeat (1 :: Int)) zeros zeros zeros zeros

zipWith6Repeat3 :: Infinite Bool
zipWith6Repeat3 = I.zipWith6 (\x y z t u v -> z == fromIntegral (x + y + t + u + v)) zeros zeros (I.repeat (1 :: Int)) zeros zeros zeros

zipWith6Repeat4 :: Infinite Bool
zipWith6Repeat4 = I.zipWith6 (\x y z t u v -> t == fromIntegral (x + y + z + u + v)) zeros zeros zeros (I.repeat (1 :: Int)) zeros zeros

zipWith6Repeat5 :: Infinite Bool
zipWith6Repeat5 = I.zipWith6 (\x y z t u v -> u == fromIntegral (x + y + z + t + v)) zeros zeros zeros zeros (I.repeat (1 :: Int)) zeros

zipWith6Repeat6 :: Infinite Bool
zipWith6Repeat6 = I.zipWith6 (\x y z t u v -> v == fromIntegral (x + y + z + t + u)) zeros zeros zeros zeros zeros (I.repeat (1 :: Int))

zipWith7Repeat1 :: Infinite Bool
zipWith7Repeat1 = I.zipWith7 (\x y z t u v w -> x == fromIntegral (y + z + t + u + v + w)) (I.repeat (1 :: Int)) zeros zeros zeros zeros zeros zeros

zipWith7Repeat2 :: Infinite Bool
zipWith7Repeat2 = I.zipWith7 (\x y z t u v w -> y == fromIntegral (x + z + t + u + v + w)) zeros (I.repeat (1 :: Int)) zeros zeros zeros zeros zeros

zipWith7Repeat3 :: Infinite Bool
zipWith7Repeat3 = I.zipWith7 (\x y z t u v w -> z == fromIntegral (x + y + t + u + v + w)) zeros zeros (I.repeat (1 :: Int)) zeros zeros zeros zeros

zipWith7Repeat4 :: Infinite Bool
zipWith7Repeat4 = I.zipWith7 (\x y z t u v w -> t == fromIntegral (x + y + z + u + v + w)) zeros zeros zeros (I.repeat (1 :: Int)) zeros zeros zeros

zipWith7Repeat5 :: Infinite Bool
zipWith7Repeat5 = I.zipWith7 (\x y z t u v w -> u == fromIntegral (x + y + z + t + v + w)) zeros zeros zeros zeros (I.repeat (1 :: Int)) zeros zeros

zipWith7Repeat6 :: Infinite Bool
zipWith7Repeat6 = I.zipWith7 (\x y z t u v w -> v == fromIntegral (x + y + z + t + u + w)) zeros zeros zeros zeros zeros (I.repeat (1 :: Int)) zeros

zipWith7Repeat7 :: Infinite Bool
zipWith7Repeat7 = I.zipWith7 (\x y z t u v w -> w == fromIntegral (x + y + z + t + u + v)) zeros zeros zeros zeros zeros zeros (I.repeat (1 :: Int))

main :: IO ()
main = defaultMain $ testGroup "All"
  [ $(inspectTest $ 'foldrMap `hasNoType` ''Word)
  , $(inspectTest $ 'foldrConsMap `hasNoType` ''Word)
  , $(inspectTest $ 'mapMap `hasNoType` ''Word)
  , $(inspectTest $ 'mapId `hasNoType` ''Word)
  , $(inspectTest $ 'mapCoerce ==- 'mapId)
  , $(inspectTest $ 'headIterate `hasNoType` ''Infinite)
  , $(inspectTest $ 'foldrIterate `hasNoType` ''Infinite)
  , $(inspectTest $ 'foldrIterate' `hasNoType` ''Infinite)
  , $(inspectTest $ 'foldrRepeat `hasNoType` ''Infinite)
  , $(inspectTest $ 'headFilterIterate `hasNoType` ''Infinite)
  , $(inspectTest $ 'filterFilter ==- 'filterFilter')
  , $(inspectTest $ 'foldrScanl `hasNoType` ''Word)
  , $(inspectTest $ 'foldrScanl' `hasNoType` ''Word)
  , $(inspectTest $ 'takeRepeat `hasNoType` ''Infinite)
  , $(inspectTest $ 'takeWhileIterate `hasNoType` ''Infinite)
  , $(inspectTest $ 'foldrCycle `hasNoType` ''Infinite)
  , $(inspectTest $ 'foldrWordsCycle `hasNoType` ''NonEmpty)
  , $(inspectTest $ 'mapAccumLRepeat `hasNoType` ''Word)

  , $(inspectTest $ 'takeFilterIterate `hasNoType` ''Infinite)
  , $(inspectTest $ 'sumTakeFilterIterate `hasNoTypes` [''Infinite, ''[]])
  , $(inspectTest $ 'takeFilterCycle `hasNoType` ''Infinite)
  , $(inspectTest $ 'takeFilterEllipsis3 `hasNoType` ''Infinite)
  , $(inspectTest $ 'takeFilterEllipsis4 `hasNoType` ''Infinite)
  , $(inspectTest $ 'sumTakeFilterEllipsis3 `hasNoTypes` [''Infinite, ''[]])
  , $(inspectTest $ 'sumTakeFilterEllipsis4 `hasNoTypes` [''Infinite, ''[]])

  , $(inspectTest $ 'takeToListFilterIterate `hasNoType` ''Infinite)
  , $(inspectTest $ 'sumTakeToListFilterIterate `hasNoTypes` [''Infinite, ''[]])
  , $(inspectTest $ 'takeToListFilterCycle `hasNoType` ''Infinite)
  , $(inspectTest $ 'takeToListFilterEllipsis3 `hasNoType` ''Infinite)
  , $(inspectTest $ 'takeToListFilterEllipsis4 `hasNoType` ''Infinite)
  , $(inspectTest $ 'sumTakeToListFilterEllipsis3 `hasNoTypes` [''Infinite, ''[]])
  , $(inspectTest $ 'sumTakeToListFilterEllipsis4 `hasNoTypes` [''Infinite, ''[]])

  , $(inspectTest $ 'headFilterMapEllipsis3 `hasNoTypes` [''Infinite, ''[]])
  , $(inspectTest $ 'headFilterMapEllipsis4 `hasNoTypes` [''Infinite, ''[]])
  , $(inspectTest $ 'toListConcatRepeat `hasNoType` ''Infinite)
  , $(inspectTest $ 'toListConcatMapRepeat `hasNoType` ''Infinite)
  , $(inspectTest $ 'toListIntersperseRepeat `hasNoType` ''Infinite)
  , $(inspectTest $ 'toListIntercalateRepeat `hasNoType` ''Infinite)
  , $(inspectTest $ 'headMapZipIterate `hasNoType` ''Word)
  , $(inspectTest $ 'headMapFlipZipIterate `hasNoType` ''Int)

  , $(inspectTest $ 'zipWithRepeat1  `hasNoType` ''Int)
  , $(inspectTest $ 'zipWithRepeat2  `hasNoType` ''Int)
  , $(inspectTest $ 'zipWith3Repeat1 `hasNoType` ''Int)
  , $(inspectTest $ 'zipWith3Repeat2 `hasNoType` ''Int)
  , $(inspectTest $ 'zipWith3Repeat3 `hasNoType` ''Int)
  , $(inspectTest $ 'zipWith4Repeat1 `hasNoType` ''Int)
  , $(inspectTest $ 'zipWith4Repeat2 `hasNoType` ''Int)
  , $(inspectTest $ 'zipWith4Repeat3 `hasNoType` ''Int)
  , $(inspectTest $ 'zipWith4Repeat4 `hasNoType` ''Int)
  , $(inspectTest $ 'zipWith5Repeat1 `hasNoType` ''Int)
  , $(inspectTest $ 'zipWith5Repeat2 `hasNoType` ''Int)
  , $(inspectTest $ 'zipWith5Repeat3 `hasNoType` ''Int)
  , $(inspectTest $ 'zipWith5Repeat4 `hasNoType` ''Int)
  , $(inspectTest $ 'zipWith5Repeat5 `hasNoType` ''Int)
  , $(inspectTest $ 'zipWith6Repeat1 `hasNoType` ''Int)
  , $(inspectTest $ 'zipWith6Repeat2 `hasNoType` ''Int)
  , $(inspectTest $ 'zipWith6Repeat3 `hasNoType` ''Int)
  , $(inspectTest $ 'zipWith6Repeat4 `hasNoType` ''Int)
  , $(inspectTest $ 'zipWith6Repeat5 `hasNoType` ''Int)
  , $(inspectTest $ 'zipWith6Repeat6 `hasNoType` ''Int)
  , $(inspectTest $ 'zipWith7Repeat1 `hasNoType` ''Int)
  , $(inspectTest $ 'zipWith7Repeat2 `hasNoType` ''Int)
  , $(inspectTest $ 'zipWith7Repeat3 `hasNoType` ''Int)
  , $(inspectTest $ 'zipWith7Repeat4 `hasNoType` ''Int)
  , $(inspectTest $ 'zipWith7Repeat5 `hasNoType` ''Int)
  , $(inspectTest $ 'zipWith7Repeat6 `hasNoType` ''Int)
  , $(inspectTest $ 'zipWith7Repeat7 `hasNoType` ''Int)
  ]

invertResult :: TestTree -> TestTree
invertResult = wrapTest (fmap change)
  where
    change r
      | resultSuccessful r
      = r { resultOutcome = Failure TestFailed, resultShortDescription = "FAIL" }
      | otherwise
      = r { resultOutcome = Success, resultShortDescription = "OK", resultDescription = "" }