never executed always true always false
1 {-# LANGUAGE DeriveTraversable #-}
2 module HelVM.HelIO.Collections.SList where
3
4 import HelVM.HelIO.Containers.LLInsertDef as LL
5 import HelVM.HelIO.Containers.MTInsertDef as MT
6
7 import Prelude hiding (reverse, uncons)
8
9 import Control.Type.Operator
10 import Data.Default
11
12 import qualified Data.Foldable as F
13 import qualified Data.ListLike as LL
14 import qualified Data.MonoTraversable as MT
15 import qualified Data.Sequences as S
16 import qualified GHC.Exts as I (IsList (..))
17 import qualified Slist as L
18 import qualified Text.Show
19
20 -- | Public functions
21 chunksOf :: Int -> SList a -> SList $ SList a
22 chunksOf i sl = SList $ SList <$> L.chunksOf i (unSList sl)
23
24 -- | Construction
25 sListEmpty :: SList a
26 sListEmpty = SList mempty
27
28 sListFromList :: [a] -> SList a
29 sListFromList = SList <$> fromList
30
31 -- | DeConstruction
32 sListToList :: SList a -> [a]
33 sListToList = toList <$> unSList
34
35 -- | Types
36 type SString = SList Char
37
38 newtype SList a = SList { unSList :: L.Slist a}
39 deriving stock (Eq , Ord, Read)
40 deriving stock (Foldable , Functor , Traversable)
41 deriving newtype (Semigroup , Monoid , Applicative , Monad)
42
43 -- | Standard instances
44 instance Show a => Show (SList a) where
45 show = show <$> toList
46
47 instance IsString SString where
48 fromString = SList <$> L.slist
49
50 instance IsList (SList a) where
51 type (Item (SList a)) = a
52 toList = sListToList
53 fromList = sListFromList
54 fromListN n = SList <$> fromListN n
55
56 -- | MonoFoldable instances
57 type instance MT.Element (SList a) = a
58
59 instance MT.MonoFoldable (SList a) where
60 headEx = sListHead
61 lastEx = sListLast
62
63 -- | SemiSequence instances
64 instance MT.GrowingAppend (SList a) where
65
66 instance S.SemiSequence (SList a) where
67 type Index (SList a) = Int
68 cons = sListCons
69 snoc = sListSnoc
70 reverse = sListReverse
71 sortBy = sListSortBy
72 intersperse = sListIntersperse
73 find = sListFind
74
75 -- | IsSequence instances
76 instance MT.MonoPointed (SList a) where
77
78 instance MT.MonoFunctor (SList a) where
79
80 instance MT.MonoTraversable (SList a) where
81
82 instance S.IsSequence (SList a) where
83 tailEx = sListTail
84 initEx = sListTail
85 replicate = sListReplicate
86 uncons = sListUncons
87
88 -- | ListLike instances
89 instance LL.FoldableLL (SList a) a where
90 -- foldl = F.foldl
91 foldl f z t = appEndo (getDual (foldMap (Dual <$> Endo <$> flip f) t)) z
92 foldr = F.foldr
93 foldl1 = F.foldl1
94 foldr1 = F.foldr1
95 foldl' = F.foldl'
96 foldr' = F.foldr'
97
98 instance LL.ListLike (SList a) a where
99 empty = mempty
100 singleton = pure
101 cons = sListCons
102 snoc = sListSnoc
103 append = (<>)
104 head = sListHead
105 uncons = sListUncons
106 last = sListLast
107 tail = sListTail
108 init = sListInit
109 null = L.isEmpty <$> unSList
110 -- length = genericLength
111 -- map = fmap
112 rigidMap = fmap
113 reverse = sListReverse
114 intersperse = sListIntersperse
115 -- concat = fold
116 -- concatMap = foldMap
117 -- rigidConcatMap = concatMap
118 -- any p = getAny <$> foldMap (Any <$> p)
119 -- all p = getAll <$> foldMap (All <$> p)
120 -- maximum = foldr1 max
121 -- minimum = foldr1 min
122 replicate = sListReplicate
123 -- take = genericTake
124 -- drop = genericDrop
125 -- splitAt = genericSplitAt
126 -- takeWhile
127 -- dropWhile
128 -- dropWhileEnd func = foldr (\x xs -> if func x && null xs then empty else cons x xs) empty
129 -- span
130 -- break p = span (not <$> p)
131 -- group = groupBy (==)
132 -- inits
133 -- tails
134 -- isPrefixOf
135 -- isSuffixOf needle haystack = isPrefixOf (reverse needle) (reverse haystack)
136 -- isInfixOf
137 -- stripPrefix
138 -- stripSuffix
139 -- elem i = any (== i)
140 -- notElem i = all (/= i)
141 find = sListFind
142 -- filter
143 -- partition p xs = (filter p xs, filter (not <$> p) xs)
144 index = sListIndex
145 -- elemIndex e l = findIndex (== e) l
146 -- elemIndices i l = findIndices (== i) l
147 -- findIndex f = listToMaybe <$> findIndices f
148 -- findIndices
149 -- sequence
150 -- mapM
151 -- rigidMapM = mapM
152 -- nub = nubBy (==)
153 -- delete = deleteBy (==)
154 -- deleteFirsts = foldl (flip delete)
155 -- union = unionBy (==)
156 -- intersect = intersectBy (==)
157 -- sort = sortBy compare
158 -- insert = insertBy compare
159 -- toList' = sListToList
160 -- fromList' = sListFromList
161 -- fromListLike = map id
162 -- nubBy
163 -- deleteBy
164 -- deleteFirstsBy func = foldl (flip (deleteBy func))
165 -- unionBy func x y = append x $ foldl (flip (deleteBy func)) (nubBy func y) x
166 -- intersectBy func xs ys = filter (\x -> any (func x) ys) xs
167 -- groupBy
168 sortBy = sListSortBy
169 -- insertBy
170 genericLength = L.genericLength <$> unSList
171 -- genericTake
172 -- genericDrop
173 -- genericSplitAt n l = (genericTake n l, genericDrop n l)
174 -- genericReplicate
175
176 -- | My instances
177 instance Default a => MT.InsertDef (SList a) where
178 insertDef i e = sListFromList. MT.insertDef i e <$> sListToList
179
180 instance Default a => LL.InsertDef (SList a) a where
181 insertDef i e = sListFromList. LL.insertDef i e <$> sListToList
182
183 -- | Internals sList
184 sListCons :: a -> SList a -> SList a
185 sListCons e = SList <$> L.cons e <$> unSList
186
187 sListSnoc :: LL.ListLike a (I.Item a) => a -> I.Item a -> a
188 sListSnoc l e = l <> LL.singleton e
189
190 sListHead :: SList a -> a
191 sListHead = L.head <$> unSList
192
193 sListUncons :: SList a -> Maybe (a, SList a)
194 sListUncons l = wrap <$> (L.uncons <$> unSList) l where
195 wrap :: (a , L.Slist a) -> (a , SList a)
196 wrap (a , l') = (a , SList l')
197
198 sListLast :: SList a -> a
199 sListLast = L.last <$> unSList
200
201 sListTail :: SList a -> SList a
202 sListTail = SList <$> L.tail <$> unSList
203
204 sListInit :: SList a -> SList a
205 sListInit = SList <$> L.init <$> unSList
206
207 sListReverse :: SList a -> SList a
208 sListReverse = SList <$> L.reverse <$> unSList
209
210 sListIntersperse :: a -> SList a -> SList a
211 sListIntersperse e = SList <$> L.intersperse e <$> unSList
212
213 sListReplicate :: Int -> a -> SList a
214 sListReplicate e = SList <$> L.replicate e
215
216 sListFind :: (a -> Bool) -> SList a -> Maybe a
217 sListFind e = find e <$> sListToList
218
219 sListIndex :: SList a -> Int -> a
220 sListIndex = flip sListUnsafeAt
221
222 sListUnsafeAt :: Int -> SList a -> a
223 sListUnsafeAt i = L.unsafeAt i <$> unSList
224
225 sListSortBy :: (a -> a -> Ordering) -> SList a -> SList a
226 sListSortBy f = SList <$> L.sortBy f <$> unSList