@@ -0,0 +1,100 @@
1+module Data.Index
2+ ( ZeroBased
3+ , first
4+ , second
5+ , third
6+ , toOneBased
7+ , indexedMap
8+ , indexedTraverse
9+ , VerifiedList(..)
10+ , indexedZipWith
11+ , indexedZipWithA
12+ )
13+ where
14+
15+
16+
17+
18+-- ZERO BASED
19+
20+
21+newtype ZeroBased =
22+ ZeroBased Int
23+
24+
25+first :: ZeroBased
26+first =
27+ ZeroBased 0
28+
29+
30+second :: ZeroBased
31+second =
32+ ZeroBased 1
33+
34+
35+third :: ZeroBased
36+third =
37+ ZeroBased 2
38+
39+
40+
41+-- ONE BASED
42+
43+
44+toOneBased :: ZeroBased -> Int
45+toOneBased (ZeroBased index) =
46+ index + 1
47+
48+
49+
50+-- INDEXED MAP
51+
52+
53+{-# INLINE indexedMap #-}
54+indexedMap :: (ZeroBased -> a -> b) -> [a] -> [b]
55+indexedMap func list =
56+ zipWith func (map ZeroBased [0 .. length list]) list
57+
58+
59+{-# INLINE indexedTraverse #-}
60+indexedTraverse :: (Applicative f) => (ZeroBased -> a -> f b) -> [a] -> f [b]
61+indexedTraverse func list =
62+ sequenceA (indexedMap func list)
63+
64+
65+
66+-- VERIFIED/INDEXED ZIP
67+
68+
69+data VerifiedList a
70+ = LengthMatch [a]
71+ | LengthMismatch Int Int
72+
73+
74+indexedZipWith :: (ZeroBased -> a -> b -> c) -> [a] -> [b] -> VerifiedList c
75+indexedZipWith func listX listY =
76+ indexedZipWithHelp func 0 listX listY []
77+
78+
79+indexedZipWithHelp :: (ZeroBased -> a -> b -> c) -> Int -> [a] -> [b] -> [c] -> VerifiedList c
80+indexedZipWithHelp func index listX listY revListZ =
81+ case (listX, listY) of
82+ ([], []) ->
83+ LengthMatch (reverse revListZ)
84+
85+ (x:xs, y:ys) ->
86+ indexedZipWithHelp func (index + 1) xs ys $
87+ func (ZeroBased index) x y : revListZ
88+
89+ (_, _) ->
90+ LengthMismatch (index + length listX) (index + length listY)
91+
92+
93+indexedZipWithA :: (Applicative f) => (ZeroBased -> a -> b -> f c) -> [a] -> [b] -> f (VerifiedList c)
94+indexedZipWithA func listX listY =
95+ case indexedZipWith func listX listY of
96+ LengthMatch list ->
97+ LengthMatch <$> sequenceA list
98+
99+ LengthMismatch x y ->
100+ pure (LengthMismatch x y)