git.iko.soy/elk
on ca2be8a help sign in
elk/src/Data/Index.hs
132 lines 2.3 kB history raw
1module Data.Index
2 ( ZeroBased
3 , first
4 , second
5 , third
6 , next
7 , toMachine
8 , toHuman
9 , indexedMap
10 , indexedTraverse
11 , indexedForA
12 , VerifiedList(..)
13 , indexedZipWith
14 , indexedZipWithA
15 )
16 where
19import Control.Monad (liftM)
20import Data.Binary
24-- ZERO BASED
27newtype ZeroBased = ZeroBased Int
28 deriving (Eq, Ord)
31first :: ZeroBased
32first =
33 ZeroBased 0
36second :: ZeroBased
37second =
38 ZeroBased 1
41third :: ZeroBased
42third =
43 ZeroBased 2
46{-# INLINE next #-}
47next :: ZeroBased -> ZeroBased
48next (ZeroBased i) =
49 ZeroBased (i + 1)
53-- DESTRUCT
56toMachine :: ZeroBased -> Int
57toMachine (ZeroBased index) =
58 index
61toHuman :: ZeroBased -> Int
62toHuman (ZeroBased index) =
63 index + 1
67-- INDEXED MAP
70{-# INLINE indexedMap #-}
71indexedMap :: (ZeroBased -> a -> b) -> [a] -> [b]
72indexedMap func xs =
73 zipWith func (map ZeroBased [0 .. length xs]) xs
76{-# INLINE indexedTraverse #-}
77indexedTraverse :: (Applicative f) => (ZeroBased -> a -> f b) -> [a] -> f [b]
78indexedTraverse func xs =
79 sequenceA (indexedMap func xs)
82{-# INLINE indexedForA #-}
83indexedForA :: (Applicative f) => [a] -> (ZeroBased -> a -> f b) -> f [b]
84indexedForA xs func =
85 sequenceA (indexedMap func xs)
89-- VERIFIED/INDEXED ZIP
92data VerifiedList a
93 = LengthMatch [a]
94 | LengthMismatch Int Int
97indexedZipWith :: (ZeroBased -> a -> b -> c) -> [a] -> [b] -> VerifiedList c
98indexedZipWith func listX listY =
99 indexedZipWithHelp func 0 listX listY []
102indexedZipWithHelp :: (ZeroBased -> a -> b -> c) -> Int -> [a] -> [b] -> [c] -> VerifiedList c
103indexedZipWithHelp func index listX listY revListZ =
104 case (listX, listY) of
105 ([], []) ->
106 LengthMatch (reverse revListZ)
108 (x:xs, y:ys) ->
109 indexedZipWithHelp func (index + 1) xs ys $
110 func (ZeroBased index) x y : revListZ
112 (_, _) ->
113 LengthMismatch (index + length listX) (index + length listY)
116indexedZipWithA :: (Applicative f) => (ZeroBased -> a -> b -> f c) -> [a] -> [b] -> f (VerifiedList c)
117indexedZipWithA func listX listY =
118 case indexedZipWith func listX listY of
119 LengthMatch xs ->
120 LengthMatch <$> sequenceA xs
122 LengthMismatch x y ->
123 pure (LengthMismatch x y)
127-- BINARY
130instance Binary ZeroBased where
131 get = liftM ZeroBased get
132 put (ZeroBased n) = put n