on 2deedfb help sign in
elk/src/Data/Index.hs
130 lines 2.4 kB history raw
1module Data.Index
2 ( ZeroBased
3 , first
4 , unsafe
5 , next
6 , toZeroBased
7 , toOneBased
8 , indexedMap
9 , indexedTraverse
10 , indexedForA
11 , VerifiedList(..)
12 , indexedZipWith
13 , indexedZipWithA
14 )
15 where
18import Control.Monad (liftM)
19import Data.Binary
23-- ZERO BASED
26newtype ZeroBased = ZeroBased Int
27 deriving (Eq, Ord)
30first :: ZeroBased
31first =
32 ZeroBased 0
35unsafe :: Int -> ZeroBased
36unsafe n =
37 if n < 0 then
38 ZeroBased n
39 else
40 error "Compiler error, unacceptable call of Index.unsafe"
43{-# INLINE next #-}
44next :: ZeroBased -> ZeroBased
45next (ZeroBased i) =
46 ZeroBased (i + 1)
50-- DESTRUCT
53toZeroBased :: ZeroBased -> Int
54toZeroBased (ZeroBased index) =
55 index
58toOneBased :: ZeroBased -> Int
59toOneBased (ZeroBased index) =
60 index + 1
64-- INDEXED MAP
67{-# INLINE indexedMap #-}
68indexedMap :: (ZeroBased -> a -> b) -> [a] -> [b]
69indexedMap func list =
70 zipWith func (map ZeroBased [0 .. length list]) list
73{-# INLINE indexedTraverse #-}
74indexedTraverse :: (Applicative f) => (ZeroBased -> a -> f b) -> [a] -> f [b]
75indexedTraverse func list =
76 sequenceA (indexedMap func list)
79{-# INLINE indexedForA #-}
80indexedForA :: (Applicative f) => [a] -> (ZeroBased -> a -> f b) -> f [b]
81indexedForA list func =
82 sequenceA (indexedMap func list)
86-- VERIFIED/INDEXED ZIP
89data VerifiedList a
90 = LengthMatch [a]
91 | LengthMismatch Int Int
94indexedZipWith :: (ZeroBased -> a -> b -> c) -> [a] -> [b] -> VerifiedList c
95indexedZipWith func listX listY =
96 indexedZipWithHelp func 0 listX listY []
99indexedZipWithHelp :: (ZeroBased -> a -> b -> c) -> Int -> [a] -> [b] -> [c] -> VerifiedList c
100indexedZipWithHelp func index listX listY revListZ =
101 case (listX, listY) of
102 ([], []) ->
103 LengthMatch (reverse revListZ)
105 (x:xs, y:ys) ->
106 indexedZipWithHelp func (index + 1) xs ys $
107 func (ZeroBased index) x y : revListZ
109 (_, _) ->
110 LengthMismatch (index + length listX) (index + length listY)
113indexedZipWithA :: (Applicative f) => (ZeroBased -> a -> b -> f c) -> [a] -> [b] -> f (VerifiedList c)
114indexedZipWithA func listX listY =
115 case indexedZipWith func listX listY of
116 LengthMatch list ->
117 LengthMatch <$> sequenceA list
119 LengthMismatch x y ->
120 pure (LengthMismatch x y)
124-- BINARY
127instance Binary ZeroBased where
128 get = liftM ZeroBased get
129 put (ZeroBased n) = put n