mini 1.5.5.2 → 1.6.0.0

raw patch · 16 files changed

+807/−1017 lines, 16 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• .editorconfig +0/−3
• CHANGELOG.md +14/−0
• Mini/Data/Array.hs +1/−1
• Mini/Data/Graph.hs +61/−92
• Mini/Data/Map.hs +301/−349
• Mini/Data/Recursion.hs +5/−25
• Mini/Data/Set.hs +250/−234
• Mini/Optics/Lens.hs +7/−97
• Mini/Transformers/Class.hs +1/−3
• Mini/Transformers/EitherT.hs +8/−14
• Mini/Transformers/MaybeT.hs +10/−15
• Mini/Transformers/ParserT.hs +138/−143
• Mini/Transformers/ReaderT.hs +2/−8
• Mini/Transformers/StateT.hs +2/−8
• Mini/Transformers/WriterT.hs +2/−8
• mini.cabal +5/−17

@@ -9,6 +9,3 @@ insert_final_newline = true max_line_length = 80 trim_trailing_whitespace = true--[Makefile]-indent_style = tab

@@ -1,3 +1,17 @@+1.6.0.0 [2025-04-27]+--------------------+* Mini.Data.Recursion:+  * Prune re-exports+* Mini.Transformers.EitherT:+  * Relax constraints of 'left'+* Mini.Transformers.MaybeT:+  * Relax constraints of 'nothing'+* Mini.Transformers.ParserT:+  * Simplify Either to Maybe+  * Add combinators 'atLeast', 'atMost', 'range'+  * Add parser 'look'+* Prune documentation+ 1.5.5.2 [2025-01-27] -------------------- * Reorder pattern matching for performance

@@ -14,9 +14,9 @@   ),    -- * Construction+  accumArray,   array,   listArray,-  accumArray,    -- * Conversion   assocs,

@@ -1,12 +1,7 @@ -- | A structure representing unique vertices and their interrelations module Mini.Data.Graph (-  -- * A Note on Performance-  -- $note-   -- * Type   Graph,--  -- * Primitive Recursion   graph,    -- * Algorithms@@ -23,19 +18,16 @@    -- * Modification   add,-  remove,   connect,   disconnect,+  remove,   transpose,    -- * Query   assocs,   edges,-  vertices,   indegree,   indegrees,-  outdegree,-  outdegrees,   lookup,   lookupGE,   lookupGT,@@ -44,20 +36,20 @@   lookupMax,   lookupMin,   member,-  sourceMax,-  sourceMin,-  sources,+  outdegree,+  outdegrees,   sinkMax,   sinkMin,   sinks,+  sourceMax,+  sourceMin,+  sources,+  vertices, ) where  import Data.Bifunctor (   second,  )-import Data.Bool (-  bool,- ) import Data.List (   unfoldr,  )@@ -82,6 +74,11 @@   toAscList,   unionWith,  )+import Mini.Data.Recursion (+  bool,+  maybe,+  uncurry,+ ) import Mini.Data.Set (   Set,  )@@ -117,10 +114,8 @@   foldMap,   foldr,   fst,-  maybe,   mempty,   show,-  uncurry,   ($),   (+),   (.),@@ -129,19 +124,7 @@   (==),  ) -{-- - A Note on Performance- -}--{- $note-In order to provide a friendly user interface, some performance has been-sacrificed. The internal adjacency lists are implemented via maps rather than-arrays, meaning accesses are done in logarithmic time rather than constant time.--}--{-- - Type- -}+-- Type  -- | A graph with directed edges between vertices of type /a/ data Graph a@@ -170,10 +153,6 @@ instance (Ord a) => Monoid (Graph a) where   mempty = empty -{-- - Primitive Recursion- -}- -- | Primitive recursion on graphs (internally represented by adjacency lists) graph   :: (Map a (Set a) -> Map a (Set a) -> b)@@ -184,9 +163,7 @@   -> b graph f (Graph ies oes) = f ies oes -{-- - Algorithms- -}+-- Algorithms  -- | Get the shortest distance in a graph between a vertex and another distance :: (Ord a) => Graph a -> a -> a -> Maybe Int@@ -212,9 +189,7 @@ sort :: (Ord a) => Graph a -> [a] sort = unfoldr $ \g -> (\u -> (u, remove u g)) <$> sourceMin g -{-- - Construction- -}+-- Construction  -- | The empty graph empty :: Graph a@@ -228,21 +203,12 @@ singleton :: a -> Graph a singleton u = Graph (Map.singleton u Set.empty) (Map.singleton u Set.empty) -{-- - Modification- -}+-- Modification  -- | Add an isolated vertex to a graph unless already present add :: (Ord a) => a -> Graph a -> Graph a add u = connect u [] --- | Remove a vertex and its associations from a graph-remove :: (Ord a) => a -> Graph a -> Graph a-remove u (Graph ies oes) =-  Graph-    (Set.delete u <$> Map.delete u ies)-    (Set.delete u <$> Map.delete u oes)- -- | Add edges from a vertex to a list of vertices in a graph connect :: (Ord a) => a -> [a] -> Graph a -> Graph a connect u vs (Graph ies oes) =@@ -269,13 +235,18 @@     )     (Map.insertWith (flip Set.difference) u (Set.fromList vs) oes) +-- | Remove a vertex and its associations from a graph+remove :: (Ord a) => a -> Graph a -> Graph a+remove u (Graph ies oes) =+  Graph+    (Set.delete u <$> Map.delete u ies)+    (Set.delete u <$> Map.delete u oes)+ -- | Reverse the edges of a graph transpose :: Graph a -> Graph a transpose (Graph ies oes) = Graph oes ies -{-- - Query- -}+-- Query  -- | Get the vertex associations of a graph assocs :: Graph a -> [(a, [a])]@@ -289,10 +260,6 @@     []     oes --- | Get the vertices of a graph-vertices :: Graph a -> [a]-vertices (Graph _ oes) = fst <$> Map.toAscList oes- -- | Get the number of incoming edges to a vertex in a graph indegree :: (Ord a) => a -> Graph a -> Maybe Int indegree v (Graph ies _) = Set.size <$> Map.lookup v ies@@ -301,14 +268,6 @@ indegrees :: Graph a -> [(a, Int)] indegrees (Graph ies _) = Map.toAscList $ Set.size <$> ies --- | Get the number of outgoing edges from a vertex in a graph-outdegree :: (Ord a) => a -> Graph a -> Maybe Int-outdegree u (Graph _ oes) = Set.size <$> Map.lookup u oes---- | Get the number of outgoing edges of each vertex in a graph-outdegrees :: Graph a -> [(a, Int)]-outdegrees (Graph _ oes) = Map.toAscList $ Set.size <$> oes- -- | Get the associations of a vertex from a graph lookup :: (Ord a) => a -> Graph a -> Maybe [a] lookup u (Graph _ oes) = Set.toAscList <$> Map.lookup u oes@@ -341,9 +300,17 @@ member :: (Ord a) => a -> Graph a -> Bool member u (Graph _ oes) = u `Map.member` oes --- | Get the maximum vertex with no incoming edges from a graph-sourceMax :: Graph a -> Maybe a-sourceMax (Graph ies _) =+-- | Get the number of outgoing edges from a vertex in a graph+outdegree :: (Ord a) => a -> Graph a -> Maybe Int+outdegree u (Graph _ oes) = Set.size <$> Map.lookup u oes++-- | Get the number of outgoing edges of each vertex in a graph+outdegrees :: Graph a -> [(a, Int)]+outdegrees (Graph _ oes) = Map.toAscList $ Set.size <$> oes++-- | Get the maximum vertex with no outgoing edges from a graph+sinkMax :: Graph a -> Maybe a+sinkMax (Graph _ oes) =   Map.foldlWithKey     ( \b k ->         bool@@ -352,11 +319,11 @@           . Set.null     )     Nothing-    ies+    oes --- | Get the minimum vertex with no incoming edges from a graph-sourceMin :: Graph a -> Maybe a-sourceMin (Graph ies _) =+-- | Get the minimum vertex with no outgoing edges from a graph+sinkMin :: Graph a -> Maybe a+sinkMin (Graph _ oes) =   Map.foldrWithKey     ( \k a b ->         bool@@ -365,11 +332,11 @@           $ Set.null a     )     Nothing-    ies+    oes --- | Get the vertices with no incoming edges from a graph-sources :: Graph a -> [a]-sources (Graph ies _) =+-- | Get the vertices with no outgoing edges from a graph+sinks :: Graph a -> [a]+sinks (Graph _ oes) =   Map.foldrWithKey     ( \k a b ->         bool@@ -378,11 +345,11 @@           $ Set.null a     )     []-    ies+    oes --- | Get the maximum vertex with no outgoing edges from a graph-sinkMax :: Graph a -> Maybe a-sinkMax (Graph _ oes) =+-- | Get the maximum vertex with no incoming edges from a graph+sourceMax :: Graph a -> Maybe a+sourceMax (Graph ies _) =   Map.foldlWithKey     ( \b k ->         bool@@ -391,11 +358,11 @@           . Set.null     )     Nothing-    oes+    ies --- | Get the minimum vertex with no outgoing edges from a graph-sinkMin :: Graph a -> Maybe a-sinkMin (Graph _ oes) =+-- | Get the minimum vertex with no incoming edges from a graph+sourceMin :: Graph a -> Maybe a+sourceMin (Graph ies _) =   Map.foldrWithKey     ( \k a b ->         bool@@ -404,11 +371,11 @@           $ Set.null a     )     Nothing-    oes+    ies --- | Get the vertices with no outgoing edges from a graph-sinks :: Graph a -> [a]-sinks (Graph _ oes) =+-- | Get the vertices with no incoming edges from a graph+sources :: Graph a -> [a]+sources (Graph ies _) =   Map.foldrWithKey     ( \k a b ->         bool@@ -417,11 +384,13 @@           $ Set.null a     )     []-    oes+    ies -{-- - Helpers- -}+-- | Get the vertices of a graph+vertices :: Graph a -> [a]+vertices (Graph _ oes) = fst <$> Map.toAscList oes++-- Helpers  -- | Breadth-first search for the hierarchy in a graph from a starting vertex bfs :: (Ord a) => Graph a -> a -> [Set a]

@@ -6,16 +6,10 @@ module Mini.Data.Map (   -- * Type   Map,--  -- * Primitive Recursion   map,    -- * Construction   empty,-  singleton,-  fromList,-  fromListWith,-  fromListWithKey,   fromAscList,   fromAscListWith,   fromAscListWithKey,@@ -24,6 +18,10 @@   fromDescListWithKey,   fromDistinctAscList,   fromDistinctDescList,+  fromList,+  fromListWith,+  fromListWithKey,+  singleton,    -- * Combination   compose,@@ -50,11 +48,11 @@    -- * Modification   adjust,-  adjustWithKey,   adjustMax,   adjustMaxWithKey,   adjustMin,   adjustMinWithKey,+  adjustWithKey,   delete,   deleteMax,   deleteMin,@@ -64,11 +62,11 @@   insertWith,   insertWithKey,   update,-  updateWithKey,   updateMax,   updateMaxWithKey,   updateMin,   updateMinWithKey,+  updateWithKey,    -- * Partition   partition,@@ -98,9 +96,6 @@    -- * Validation   valid,--  -- * Examples-  -- $examples ) where  import Control.Applicative (@@ -118,6 +113,10 @@ import Data.Function (   on,  )+import Mini.Data.Recursion (+  list,+  ordering,+ ) import Prelude (   Applicative,   Bool (@@ -134,11 +133,6 @@   ),   Monoid,   Ord,-  Ordering (-    EQ,-    GT,-    LT-  ),   Semigroup,   Show,   Traversable,@@ -177,9 +171,7 @@   (||),  ) -{-- - Type- -}+-- Type  -- | A map from keys /k/ to values /a/, internally structured as an AVL tree data Map k a@@ -216,10 +208,6 @@ instance (Ord k) => Monoid (Map k a) where   mempty = empty -{-- - Primitive recursion- -}- -- | Primitive recursion on maps (internally structured as trees) map   :: b@@ -258,30 +246,12 @@   B l k a r -> g l k a r (map' e f g h l) (map' e f g h r)   E -> e -{-- - Construction- -}+-- Construction  -- | /O(1)/ The empty map empty :: Map k a empty = E --- | /O(1)/ Make a map with a single bin-singleton :: k -> a -> Map k a-singleton k a = B E k a E---- | /O(n log n)/ Make a map from a tail-biased list of @(key, value)@ pairs-fromList :: (Ord k) => [(k, a)] -> Map k a-fromList = fromListWithKey $ const const---- | /O(n log n)/ Make a map from a list of pairs, combining matching keys-fromListWith :: (Ord k) => (a -> a -> a) -> [(k, a)] -> Map k a-fromListWith = fromListWithKey . const---- | /O(n log n)/ Make a map from a list of pairs, combining matching keys-fromListWithKey :: (Ord k) => (k -> a -> a -> a) -> [(k, a)] -> Map k a-fromListWithKey f = foldl (flip . uncurry $ insertWithKey f) empty- -- | /O(n)/ Make a map from a tail-biased list of key-sorted pairs fromAscList :: (Eq k) => [(k, a)] -> Map k a fromAscList = fromDistinctAscList . essence@@ -292,7 +262,7 @@  -- | /O(n)/ Make a map from a list of key-sorted pairs, combining matching keys fromAscListWithKey :: (Ord k) => (k -> a -> a -> a) -> [(k, a)] -> Map k a-fromAscListWithKey f = fromDistinctAscList . essenceWith f+fromAscListWithKey f = fromDistinctAscList . essenceWithKey f  -- | /O(n)/ Make a map from a tail-biased list of key-sorted pairs fromDescList :: (Eq k) => [(k, a)] -> Map k a@@ -304,38 +274,56 @@  -- | /O(n)/ Make a map from a list of key-sorted pairs, combining matching keys fromDescListWithKey :: (Ord k) => (k -> a -> a -> a) -> [(k, a)] -> Map k a-fromDescListWithKey f = fromDistinctDescList . essenceWith f+fromDescListWithKey f = fromDistinctDescList . essenceWithKey f  -- | /O(n)/ Make a map from a sorted list of key-distinct pairs fromDistinctAscList :: [(k, a)] -> Map k a fromDistinctAscList = go <*> power  where-  go [] _ = E-  go [(k, a)] _ = B E k a E-  go kas n =-    let len = length kas-        n' = n `div` 2-        c = bool B L $ len == n-        (l, (k, a) : r) = splitAt (len `div` 2) kas-     in c (go l n') k a (go r n')+  go ps n = list E go' ps+   where+    go' (k, a) = const . list (B E k a E) go''+     where+      go'' _ _ _ =+        let len = length ps+            n' = n `div` 2+            c = bool B L $ len == n+            (l, (k', a') : r) = splitAt (len `div` 2) ps+         in c (go l n') k' a' (go r n')  -- | /O(n)/ Make a map from a sorted list of key-distinct pairs fromDistinctDescList :: [(k, a)] -> Map k a fromDistinctDescList = go <*> power  where-  go [] _ = E-  go [(k, a)] _ = B E k a E-  go kas n =-    let len = length kas-        n' = n `div` 2-        c = bool B R $ len == n-        (l, (k, a) : r) = splitAt (len `div` 2) kas-     in c (go r n') k a (go l n')+  go ps n = list E go' ps+   where+    go' (k, a) = const . list (B E k a E) go''+     where+      go'' _ _ _ =+        let len = length ps+            n' = n `div` 2+            c = bool B R $ len == n+            (l, (k', a') : r) = splitAt (len `div` 2) ps+         in c (go r n') k' a' (go l n') -{-- - Combination- -}+-- | /O(n log n)/ Make a map from a tail-biased list of @(key, value)@ pairs+fromList :: (Ord k) => [(k, a)] -> Map k a+fromList = fromListWithKey $ const const +-- | /O(n log n)/ Make a map from a list of pairs, combining matching keys+fromListWith :: (Ord k) => (a -> a -> a) -> [(k, a)] -> Map k a+fromListWith = fromListWithKey . const++-- | /O(n log n)/ Make a map from a list of pairs, combining matching keys+fromListWithKey :: (Ord k) => (k -> a -> a -> a) -> [(k, a)] -> Map k a+fromListWithKey f = foldl (flip . uncurry $ insertWithKey f) empty++-- | /O(1)/ Make a map with a single bin+singleton :: k -> a -> Map k a+singleton k a = B E k a E++-- Combination+ -- | /O(n log m)/ Compose the keys of one set with the values of another compose :: (Ord b) => Map b c -> Map a b -> Map a c compose t1 t2 = map' empty go go go t1@@ -425,9 +413,7 @@ unionsWithKey :: (Foldable t, Ord k) => (k -> a -> a -> a) -> t (Map k a) -> Map k a unionsWithKey f = foldr (unionWithKey f) empty -{-- - Conversion- -}+-- Conversion  -- | /O(n)/ Turn a map into a list of @(key, value)@ pairs in ascending order toAscList :: Map k a -> [(k, a)]@@ -437,9 +423,7 @@ toDescList :: Map k a -> [(k, a)] toDescList = foldlWithKey (\b k a -> (k, a) : b) [] -{-- - Fold- -}+-- Fold  -- | /O(n)/ Reduce a map with a left-associative operation and an accumulator foldlWithKey :: (b -> k -> a -> b) -> b -> Map k a -> b@@ -453,23 +437,12 @@  where   go l k a _ _ recr = foldrWithKey f (f k a recr) l -{-- - Modification- -}+-- Modification  -- | /O(log n)/ Adjust with an operation the value of a key in a map adjust :: (Ord k) => (a -> a) -> k -> Map k a -> Map k a adjust = adjustWithKey . const --- | /O(log n)/ Adjust with an operation the value of a key in a map-adjustWithKey :: (Ord k) => (k -> a -> a) -> k -> Map k a -> Map k a-adjustWithKey f k0 = map' E (go L) (go B) (go R)- where-  go c l k a r recl recr = case compare k0 k of-    LT -> c recl k a r-    GT -> c l k a recr-    EQ -> c l k (f k a) r- -- | /O(log n)/ Adjust with an operation the value of the maximum key in a map adjustMax :: (a -> a) -> Map k a -> Map k a adjustMax = adjustMaxWithKey . const@@ -494,6 +467,17 @@    where     go' _ _ _ _ _ _ = c recl k a r +-- | /O(log n)/ Adjust with an operation the value of a key in a map+adjustWithKey :: (Ord k) => (k -> a -> a) -> k -> Map k a -> Map k a+adjustWithKey f k0 = map' E (go L) (go B) (go R)+ where+  go c l k a r recl recr =+    ordering+      (c recl k a r)+      (c l k (f k a) r)+      (c l k a recr)+      $ compare k0 k+ -- | /O(log n)/ Delete a key from a map delete :: (Ord k) => k -> Map k a -> Map k a delete k t = bool t (delete' k t) $ k `member` t@@ -528,18 +512,6 @@ update :: (Ord k) => (a -> Maybe a) -> k -> Map k a -> Map k a update = updateWithKey . const --- | /O(log n)/ Modify the value of a key or delete its bin with an operation-updateWithKey :: (Ord k) => (k -> a -> Maybe a) -> k -> Map k a -> Map k a-updateWithKey f k t =-  maybe-    t-    ( maybe-        (delete' k t)-        (\a' -> insert k a' t)-        . f k-    )-    $ lookup k t- -- | /O(log n)/ Modify the value of the maximum key or delete its bin updateMax :: (Ord k) => (a -> Maybe a) -> Map k a -> Map k a updateMax = updateMaxWithKey . const@@ -574,10 +546,20 @@     )     $ lookupMin t -{-- - Partition- -}+-- | /O(log n)/ Modify the value of a key or delete its bin with an operation+updateWithKey :: (Ord k) => (k -> a -> Maybe a) -> k -> Map k a -> Map k a+updateWithKey f k t =+  maybe+    t+    ( maybe+        (delete' k t)+        (\a' -> insert k a' t)+        . f k+    )+    $ lookup k t +-- Partition+ -- | /O(n)/ Partition a map with a predicate into @(true, false)@ submaps partition :: (a -> Bool) -> Map k a -> (Map k a, Map k a) partition = partitionWithKey . const@@ -595,10 +577,12 @@ split k0 =   (\(lt, a, gt) -> (fromDistinctAscList lt, a, fromDistinctAscList gt))     . foldrWithKey-      ( \k a (lt, a', gt) -> case compare k k0 of-          LT -> ((k, a) : lt, a', gt)-          GT -> (lt, a', (k, a) : gt)-          EQ -> (lt, Just a, gt)+      ( \k a (lt, a', gt) ->+          ordering+            ((k, a) : lt, a', gt)+            (lt, Just a, gt)+            (lt, a', (k, a) : gt)+            $ compare k k0       )       ([], Nothing, []) @@ -610,9 +594,7 @@ splitMin :: (Ord k) => Map k a -> Maybe ((k, a), Map k a) splitMin t = ((,) <*> flip delete' t . fst) <$> lookupMin t -{-- - Query- -}+-- Query  -- | /O(m log n)/ Check whether two maps have no keys in common disjoint :: (Ord k) => Map k a -> Map k a -> Bool@@ -634,52 +616,62 @@       True       t1 --- | /O(log n)/ Fetch the value of a key in a map, or 'Nothing' if absent+-- | /O(log n)/ Fetch the value of a key in a map lookup :: (Ord k) => k -> Map k a -> Maybe a lookup k = map' Nothing go go go  where-  go _ k' a _ recl recr = case compare k k' of-    LT -> recl-    GT -> recr-    EQ -> Just a+  go _ k' a _ recl recr =+    ordering+      recl+      (Just a)+      recr+      $ compare k k'  -- | /O(log n)/ Fetch the least bin greater than or equal to a key lookupGE :: (Ord k) => k -> Map k a -> Maybe (k, a) lookupGE k0 = map' Nothing go go go  where-  go _ k a _ recl recr = case compare k k0 of-    LT -> recr-    GT -> recl <|> Just (k, a)-    EQ -> Just (k, a)+  go _ k a _ recl recr =+    ordering+      recr+      (Just (k, a))+      (recl <|> Just (k, a))+      $ compare k k0  -- | /O(log n)/ Fetch the least bin strictly greater than a key lookupGT :: (Ord k) => k -> Map k a -> Maybe (k, a) lookupGT k0 = map' Nothing go go go  where-  go _ k a _ recl recr = case compare k k0 of-    LT -> recr-    GT -> recl <|> Just (k, a)-    EQ -> recr+  go _ k a _ recl recr =+    ordering+      recr+      recr+      (recl <|> Just (k, a))+      $ compare k k0  -- | /O(log n)/ Fetch the greatest bin less than or equal to a key lookupLE :: (Ord k) => k -> Map k a -> Maybe (k, a) lookupLE k0 = map' Nothing go go go  where-  go _ k a _ recl recr = case compare k k0 of-    LT -> recr <|> Just (k, a)-    GT -> recl-    EQ -> Just (k, a)+  go _ k a _ recl recr =+    ordering+      (recr <|> Just (k, a))+      (Just (k, a))+      recl+      $ compare k k0  -- | /O(log n)/ Fetch the greatest bin strictly less than a key lookupLT :: (Ord k) => k -> Map k a -> Maybe (k, a) lookupLT k0 = map' Nothing go go go  where-  go _ k a _ recl recr = case compare k k0 of-    LT -> recr <|> Just (k, a)-    GT -> recl-    EQ -> recl+  go _ k a _ recl recr =+    ordering+      (recr <|> Just (k, a))+      recl+      recl+      $ compare k k0 --- | /O(log n)/ Fetch the bin with the maximum key, or 'Nothing' if empty+-- | /O(log n)/ Fetch the bin with the maximum key lookupMax :: Map k a -> Maybe (k, a) lookupMax = map' Nothing go go go  where@@ -687,7 +679,7 @@    where     go' _ _ _ _ _ _ = recr --- | /O(log n)/ Fetch the bin with the minimum key, or 'Nothing' if empty+-- | /O(log n)/ Fetch the bin with the minimum key lookupMin :: Map k a -> Maybe (k, a) lookupMin = map' Nothing go go go  where@@ -699,10 +691,12 @@ member :: (Ord k) => k -> Map k a -> Bool member k0 = map' False go go go  where-  go _ k _ _ recl recr = case compare k0 k of-    LT -> recl-    GT -> recr-    EQ -> True+  go _ k _ _ recl recr =+    ordering+      recl+      True+      recr+      $ compare k0 k  -- | /O(1)/ Check whether a map is empty null :: Map k a -> Bool@@ -712,9 +706,7 @@ size :: Map k a -> Int size = map' 0 go go go where go _ _ _ _ recl recr = 1 + recl + recr -{-- - Traversal- -}+-- Traversal  -- | /O(n)/ Apply an operation across a map, transforming its values fmapWithKey :: (k -> a -> b) -> Map k a -> Map k b@@ -728,9 +720,7 @@  where   go c _ k a _ recl recr = c <$> recl <*> pure k <*> f k a <*> recr -{-- - Validation- -}+-- Validation  -- | /O(n^2)/ Check whether a map is internally height-balanced and ordered valid :: (Ord k) => Map k a -> Bool@@ -754,33 +744,29 @@       lt _ lk _ _ _ _ = lk < k && recl && recr       gt _ rk _ _ _ _ = rk > k && recl && recr -{-- - Helpers- -}+-- Helpers  -- O(n) 'nub' on keys for sorted lists of pairs essence :: (Eq k) => [(k, a)] -> [(k, a)]-essence [] = []-essence (x : xs) = essence' x xs+essence = list [] go  where-  essence' ka1 [] = [ka1]-  essence' ka1@(k1, _) (ka2@(k2, _) : kas) =-    let rest = essence' ka2 kas-     in bool (ka1 : rest) rest $ k1 == k2+  go p1@(k1, _) ps rec = list [p1] go' ps+   where+    go' (k2, _) _ _ = bool (p1 : rec) rec $ k1 == k2  -- O(n) 'nub' with a combining function for sorted lists of pairs-essenceWith :: (Eq k) => (k -> a -> a -> a) -> [(k, a)] -> [(k, a)]-essenceWith _ [] = []-essenceWith f (x : xs) = essenceWith' x xs+essenceWithKey :: (Eq k) => (k -> a -> a -> a) -> [(k, a)] -> [(k, a)]+essenceWithKey f = list [] (\p -> const . go p)  where-  essenceWith' ka1 [] = [ka1]-  essenceWith' ka1@(k1, a1) (ka2@(k2, a2) : kas) =-    bool-      (ka1 : essenceWith' ka2 kas)-      (essenceWith' (k1, f k1 a2 a1) kas)-      $ k1 == k2+  go p1@(k1, a1) = list [p1] go'+   where+    go' p2@(k2, a2) ps _ =+      bool+        (p1 : go p2 ps)+        (go (k1, f k1 a2 a1) ps)+        $ k1 == k2 --- The greatest power of 2 <= the length of a non-empty collection+-- O(log n) The greatest power of 2 <= the length of a non-empty collection power :: (Foldable t) => t a -> Int power as = until (> length as) (* 2) 2 `div` 2 @@ -795,152 +781,173 @@   map'     (error "Map.delete: L0")     ( \l k a r _ _ ->-        case compare k0 k of-          LT -> deleteLl l k a r-          GT -> deleteLr l k a r-          EQ -> substituteL l r+        ordering+          (deleteLl l k a r)+          (substituteL l r)+          (deleteLr l k a r)+          $ compare k0 k     )     ( \l k a r _ _ ->-        case compare k0 k of-          LT -> deleteBl l k a r-          GT -> deleteBr l k a r-          EQ -> substituteBr l r+        ordering+          (deleteBl l k a r)+          (substituteBr l r)+          (deleteBr l k a r)+          $ compare k0 k     )     ( \l k a r _ _ ->-        case compare k0 k of-          LT -> deleteRl l k a r-          GT -> deleteRr l k a r-          EQ -> substituteR l r+        ordering+          (deleteRl l k a r)+          (substituteR l r)+          (deleteRr l k a r)+          $ compare k0 k     )  where   deleteRl l k a r =     map'       (error "Map.delete: L1")       ( \ll lk la lr _ _ ->-          case compare k0 lk of-            LT -> checkLeftR (deleteLl ll lk la lr) k a r-            GT -> checkLeftR (deleteLr ll lk la lr) k a r-            EQ -> checkLeftR (substituteL ll lr) k a r+          ordering+            (checkLeftR (deleteLl ll lk la lr) k a r)+            (checkLeftR (substituteL ll lr) k a r)+            (checkLeftR (deleteLr ll lk la lr) k a r)+            $ compare k0 lk       )       ( \ll lk la lr _ _ ->-          case compare k0 lk of-            LT -> R (deleteBl ll lk la lr) k a r-            GT -> R (deleteBr ll lk la lr) k a r-            EQ -> checkLeftR' (substituteBr ll lr) k a r+          ordering+            (R (deleteBl ll lk la lr) k a r)+            (checkLeftR' (substituteBr ll lr) k a r)+            (R (deleteBr ll lk la lr) k a r)+            $ compare k0 lk       )       ( \ll lk la lr _ _ ->-          case compare k0 lk of-            LT -> checkLeftR (deleteRl ll lk la lr) k a r-            GT -> checkLeftR (deleteRr ll lk la lr) k a r-            EQ -> checkLeftR (substituteR ll lr) k a r+          ordering+            (checkLeftR (deleteRl ll lk la lr) k a r)+            (checkLeftR (substituteR ll lr) k a r)+            (checkLeftR (deleteRr ll lk la lr) k a r)+            $ compare k0 lk       )       l   deleteRr l k a =     map'       (error "Map.delete: L2")       ( \rl rk ra rr _ _ ->-          case compare k0 rk of-            LT -> checkRightR l k a (deleteLl rl rk ra rr)-            GT -> checkRightR l k a (deleteLr rl rk ra rr)-            EQ -> checkRightR l k a (substituteL rl rr)+          ordering+            (checkRightR l k a $ deleteLl rl rk ra rr)+            (checkRightR l k a $ substituteL rl rr)+            (checkRightR l k a $ deleteLr rl rk ra rr)+            $ compare k0 rk       )       ( \rl rk ra rr _ _ ->-          case compare k0 rk of-            LT -> R l k a (deleteBl rl rk ra rr)-            GT -> R l k a (deleteBr rl rk ra rr)-            EQ -> checkRightR' l k a (substituteBl rl rr)+          ordering+            (R l k a $ deleteBl rl rk ra rr)+            (checkRightR' l k a $ substituteBl rl rr)+            (R l k a $ deleteBr rl rk ra rr)+            $ compare k0 rk       )       ( \rl rk ra rr _ _ ->-          case compare k0 rk of-            LT -> checkRightR l k a (deleteRl rl rk ra rr)-            GT -> checkRightR l k a (deleteRr rl rk ra rr)-            EQ -> checkRightR l k a (substituteR rl rr)+          ordering+            (checkRightR l k a $ deleteRl rl rk ra rr)+            (checkRightR l k a $ substituteR rl rr)+            (checkRightR l k a $ deleteRr rl rk ra rr)+            $ compare k0 rk       )   deleteBl l k a r =     map'       (error "Map.delete: L3")       ( \ll lk la lr _ _ ->-          case compare k0 lk of-            LT -> checkLeftB (deleteLl ll lk la lr) k a r-            GT -> checkLeftB (deleteLr ll lk la lr) k a r-            EQ -> checkLeftB (substituteL ll lr) k a r+          ordering+            (checkLeftB (deleteLl ll lk la lr) k a r)+            (checkLeftB (substituteL ll lr) k a r)+            (checkLeftB (deleteLr ll lk la lr) k a r)+            $ compare k0 lk       )       ( \ll lk la lr _ _ ->-          case compare k0 lk of-            LT -> B (deleteBl ll lk la lr) k a r-            GT -> B (deleteBr ll lk la lr) k a r-            EQ -> checkLeftB' (substituteBr ll lr) k a r+          ordering+            (B (deleteBl ll lk la lr) k a r)+            (checkLeftB' (substituteBr ll lr) k a r)+            (B (deleteBr ll lk la lr) k a r)+            $ compare k0 lk       )       ( \ll lk la lr _ _ ->-          case compare k0 lk of-            LT -> checkLeftB (deleteRl ll lk la lr) k a r-            GT -> checkLeftB (deleteRr ll lk la lr) k a r-            EQ -> checkLeftB (substituteR ll lr) k a r+          ordering+            (checkLeftB (deleteRl ll lk la lr) k a r)+            (checkLeftB (substituteR ll lr) k a r)+            (checkLeftB (deleteRr ll lk la lr) k a r)+            $ compare k0 lk       )       l   deleteBr l k a =     map'       (error "Map.delete: L4")       ( \rl rk ra rr _ _ ->-          case compare k0 rk of-            LT -> checkRightB l k a (deleteLl rl rk ra rr)-            GT -> checkRightB l k a (deleteLr rl rk ra rr)-            EQ -> checkRightB l k a (substituteL rl rr)+          ordering+            (checkRightB l k a $ deleteLl rl rk ra rr)+            (checkRightB l k a $ substituteL rl rr)+            (checkRightB l k a $ deleteLr rl rk ra rr)+            $ compare k0 rk       )       ( \rl rk ra rr _ _ ->-          case compare k0 rk of-            LT -> B l k a (deleteBl rl rk ra rr)-            GT -> B l k a (deleteBr rl rk ra rr)-            EQ -> checkRightB' l k a (substituteBl rl rr)+          ordering+            (B l k a $ deleteBl rl rk ra rr)+            (checkRightB' l k a $ substituteBl rl rr)+            (B l k a $ deleteBr rl rk ra rr)+            $ compare k0 rk       )       ( \rl rk ra rr _ _ ->-          case compare k0 rk of-            LT -> checkRightB l k a (deleteRl rl rk ra rr)-            GT -> checkRightB l k a (deleteRr rl rk ra rr)-            EQ -> checkRightB l k a (substituteR rl rr)+          ordering+            (checkRightB l k a $ deleteRl rl rk ra rr)+            (checkRightB l k a $ substituteR rl rr)+            (checkRightB l k a $ deleteRr rl rk ra rr)+            $ compare k0 rk       )   deleteLl l k a r =     map'       (error "Map.delete: L5")       ( \ll lk la lr _ _ ->-          case compare k0 lk of-            LT -> checkLeftL (deleteLl ll lk la lr) k a r-            GT -> checkLeftL (deleteLr ll lk la lr) k a r-            EQ -> checkLeftL (substituteL ll lr) k a r+          ordering+            (checkLeftL (deleteLl ll lk la lr) k a r)+            (checkLeftL (substituteL ll lr) k a r)+            (checkLeftL (deleteLr ll lk la lr) k a r)+            $ compare k0 lk       )       ( \ll lk la lr _ _ ->-          case compare k0 lk of-            LT -> L (deleteBl ll lk la lr) k a r-            GT -> L (deleteBr ll lk la lr) k a r-            EQ -> checkLeftL' (substituteBr ll lr) k a r+          ordering+            (L (deleteBl ll lk la lr) k a r)+            (checkLeftL' (substituteBr ll lr) k a r)+            (L (deleteBr ll lk la lr) k a r)+            $ compare k0 lk       )       ( \ll lk la lr _ _ ->-          case compare k0 lk of-            LT -> checkLeftL (deleteRl ll lk la lr) k a r-            GT -> checkLeftL (deleteRr ll lk la lr) k a r-            EQ -> checkLeftL (substituteR ll lr) k a r+          ordering+            (checkLeftL (deleteRl ll lk la lr) k a r)+            (checkLeftL (substituteR ll lr) k a r)+            (checkLeftL (deleteRr ll lk la lr) k a r)+            $ compare k0 lk       )       l   deleteLr l k a =     map'       (error "Map.delete: L6")       ( \rl rk ra rr _ _ ->-          case compare k0 rk of-            LT -> checkRightL l k a (deleteLl rl rk ra rr)-            GT -> checkRightL l k a (deleteLr rl rk ra rr)-            EQ -> checkRightL l k a (substituteL rl rr)+          ordering+            (checkRightL l k a $ deleteLl rl rk ra rr)+            (checkRightL l k a $ substituteL rl rr)+            (checkRightL l k a $ deleteLr rl rk ra rr)+            $ compare k0 rk       )       ( \rl rk ra rr _ _ ->-          case compare k0 rk of-            LT -> L l k a (deleteBl rl rk ra rr)-            GT -> L l k a (deleteBr rl rk ra rr)-            EQ -> checkRightL' l k a (substituteBl rl rr)+          ordering+            (L l k a $ deleteBl rl rk ra rr)+            (checkRightL' l k a $ substituteBl rl rr)+            (L l k a $ deleteBr rl rk ra rr)+            $ compare k0 rk       )       ( \rl rk ra rr _ _ ->-          case compare k0 rk of-            LT -> checkRightL l k a (deleteRl rl rk ra rr)-            GT -> checkRightL l k a (deleteRr rl rk ra rr)-            EQ -> checkRightL l k a (substituteR rl rr)+          ordering+            (checkRightL l k a $ deleteRl rl rk ra rr)+            (checkRightL l k a $ substituteR rl rr)+            (checkRightL l k a $ deleteRr rl rk ra rr)+            $ compare k0 rk       )   rebalanceR l k a =     map'@@ -948,9 +955,9 @@       ( \rl rk ra rr _ _ ->           map'             (error "Map.delete: L8")-            (\rll rlk rla rlr _ _ -> B (B l k a rll) rlk rla (R rlr rk ra rr))-            (\rll rlk rla rlr _ _ -> B (B l k a rll) rlk rla (B rlr rk ra rr))-            (\rll rlk rla rlr _ _ -> B (L l k a rll) rlk rla (B rlr rk ra rr))+            (\rll rlk rla rlr _ _ -> B (B l k a rll) rlk rla $ R rlr rk ra rr)+            (\rll rlk rla rlr _ _ -> B (B l k a rll) rlk rla $ B rlr rk ra rr)+            (\rll rlk rla rlr _ _ -> B (L l k a rll) rlk rla $ B rlr rk ra rr)             rl       )       (\rl rk ra rr _ _ -> L (R l k a rl) rk ra rr)@@ -958,14 +965,14 @@   rebalanceL l k a r =     map'       (error "Map.delete: L9")-      (\ll lk la lr _ _ -> B ll lk la (B lr k a r))-      (\ll lk la lr _ _ -> R ll lk la (L lr k a r))+      (\ll lk la lr _ _ -> B ll lk la $ B lr k a r)+      (\ll lk la lr _ _ -> R ll lk la $ L lr k a r)       ( \ll lk la lr _ _ ->           map'             (error "Map.delete: L10")-            (\lrl lrk lra lrr _ _ -> B (B ll lk la lrl) lrk lra (R lrr k a r))-            (\lrl lrk lra lrr _ _ -> B (B ll lk la lrl) lrk lra (B lrr k a r))-            (\lrl lrk lra lrr _ _ -> B (L ll lk la lrl) lrk lra (B lrr k a r))+            (\lrl lrk lra lrr _ _ -> B (B ll lk la lrl) lrk lra $ R lrr k a r)+            (\lrl lrk lra lrr _ _ -> B (B ll lk la lrl) lrk lra $ B lrr k a r)+            (\lrl lrk lra lrr _ _ -> B (L ll lk la lrl) lrk lra $ B lrr k a r)             lr       )       l@@ -1294,20 +1301,23 @@     (\l k a r _ _ -> insertR l k a r)  where   insertR l k a r =-    case compare k0 k of-      LT -> insertRl l k a r-      GT -> insertRr l k a r-      EQ -> R l k (f k a0 a) r+    ordering+      (insertRl l k a r)+      (R l k (f k a0 a) r)+      (insertRr l k a r)+      $ compare k0 k   insertB l k a r =-    case compare k0 k of-      LT -> insertBl l k a r-      GT -> insertBr l k a r-      EQ -> B l k (f k a0 a) r+    ordering+      (insertBl l k a r)+      (B l k (f k a0 a) r)+      (insertBr l k a r)+      $ compare k0 k   insertL l k a r =-    case compare k0 k of-      LT -> insertLl l k a r-      GT -> insertLr l k a r-      EQ -> L l k (f k a0 a) r+    ordering+      (insertLl l k a r)+      (L l k (f k a0 a) r)+      (insertLr l k a r)+      $ compare k0 k   insertRl l k a r =     map'       (B (B E k0 a0 E) k a r)@@ -1340,8 +1350,8 @@       l   insertBr l k a =     map'-      (R l k a (B E k0 a0 E))-      (\rl rk ra rr _ _ -> B l k a (insertL rl rk ra rr))+      (R l k a $ B E k0 a0 E)+      (\rl rk ra rr _ _ -> B l k a $ insertL rl rk ra rr)       ( \rl rk ra rr _ _ ->           let r = insertB rl rk ra rr            in map'@@ -1351,11 +1361,11 @@                 (\_ _ _ _ _ _ -> R l k a r)                 r       )-      (\rl rk ra rr _ _ -> B l k a (insertR rl rk ra rr))+      (\rl rk ra rr _ _ -> B l k a $ insertR rl rk ra rr)   insertLr l k a =     map'-      (B l k a (B E k0 a0 E))-      (\rl rk ra rr _ _ -> L l k a (insertL rl rk ra rr))+      (B l k a $ B E k0 a0 E)+      (\rl rk ra rr _ _ -> L l k a $ insertL rl rk ra rr)       ( \rl rk ra rr _ _ ->           let r = insertB rl rk ra rr            in map'@@ -1365,63 +1375,65 @@                 (\_ _ _ _ _ _ -> B l k a r)                 r       )-      (\rl rk ra rr _ _ -> L l k a (insertR rl rk ra rr))+      (\rl rk ra rr _ _ -> L l k a $ insertR rl rk ra rr)   insertRr l k a =     map'       (error "Map.insert: L4")-      (\rl rk ra rr _ _ -> R l k a (insertL rl rk ra rr))+      (\rl rk ra rr _ _ -> R l k a $ insertL rl rk ra rr)       ( \rl rk ra rr _ _ ->-          case compare k0 rk of-            LT -> insertRrl l k a rl rk ra rr-            GT -> insertRrr l k a rl rk ra rr-            EQ -> R l k a (B rl rk (f rk a0 ra) rr)+          ordering+            (insertRrl l k a rl rk ra rr)+            (R l k a $ B rl rk (f rk a0 ra) rr)+            (insertRrr l k a rl rk ra rr)+            $ compare k0 rk       )-      (\rl rk ra rr _ _ -> R l k a (insertR rl rk ra rr))+      (\rl rk ra rr _ _ -> R l k a $ insertR rl rk ra rr)   insertLl l k a r =     map'       (error "Map.insert: L5")       (\ll lk la lr _ _ -> L (insertL ll lk la lr) k a r)       ( \ll lk la lr _ _ ->-          case compare k0 lk of-            LT -> insertLll ll lk la lr k a r-            GT -> insertLlr ll lk la lr k a r-            EQ -> L (B ll lk (f lk a0 la) lr) k a r+          ordering+            (insertLll ll lk la lr k a r)+            (L (B ll lk (f lk a0 la) lr) k a r)+            (insertLlr ll lk la lr k a r)+            $ compare k0 lk       )       (\ll lk la lr _ _ -> L (insertR ll lk la lr) k a r)       l   insertRrr l k a rl rk ra =     map'-      (B (B l k a rl) rk ra (B E k0 a0 E))-      (\rrl rrk rra rrr _ _ -> R l k a (B rl rk ra (insertL rrl rrk rra rrr)))+      (B (B l k a rl) rk ra $ B E k0 a0 E)+      (\rrl rrk rra rrr _ _ -> R l k a . B rl rk ra $ insertL rrl rrk rra rrr)       ( \rrl rrk rra rrr _ _ ->           let rr = insertB rrl rrk rra rrr            in map'                 (error "Map.insert: L6")                 (\_ _ _ _ _ _ -> B (B l k a rl) rk ra rr)-                (\_ _ _ _ _ _ -> R l k a (B rl rk ra rr))+                (\_ _ _ _ _ _ -> R l k a $ B rl rk ra rr)                 (\_ _ _ _ _ _ -> B (B l k a rl) rk ra rr)                 rr       )-      (\rrl rrk rra rrr _ _ -> R l k a (B rl rk ra (insertR rrl rrk rra rrr)))+      (\rrl rrk rra rrr _ _ -> R l k a . B rl rk ra $ insertR rrl rrk rra rrr)   insertLll ll lk la lr k a r =     map'-      (B (B E k0 a0 E) lk la (B lr k a r))+      (B (B E k0 a0 E) lk la $ B lr k a r)       (\lll llk lla llr _ _ -> L (B (insertL lll llk lla llr) lk la lr) k a r)       ( \lll llk lla llr _ _ ->           let ll' = insertB lll llk lla llr            in map'                 (error "Map.insert: L7")-                (\_ _ _ _ _ _ -> B ll' lk la (B lr k a r))+                (\_ _ _ _ _ _ -> B ll' lk la $ B lr k a r)                 (\_ _ _ _ _ _ -> L (B ll' lk la lr) k a r)-                (\_ _ _ _ _ _ -> B ll' lk la (B lr k a r))+                (\_ _ _ _ _ _ -> B ll' lk la $ B lr k a r)                 ll'       )       (\lll llk lla llr _ _ -> L (B (insertR lll llk lla llr) lk la lr) k a r)       ll   insertRrl l k a rl rk ra rr =     map'-      (B (B l k a E) k0 a0 (B E rk ra rr))-      (\rll rlk rla rlr _ _ -> R l k a (B (insertL rll rlk rla rlr) rk ra rr))+      (B (B l k a E) k0 a0 $ B E rk ra rr)+      (\rll rlk rla rlr _ _ -> R l k a $ B (insertL rll rlk rla rlr) rk ra rr)       ( \rll rlk rla rlr _ _ ->           let rl' = insertB rll rlk rla rlr            in map'@@ -1433,7 +1445,7 @@                       rla'                       (R rlr' rk ra rr)                 )-                (\_ _ _ _ _ _ -> R l k a (B rl' rk ra rr))+                (\_ _ _ _ _ _ -> R l k a $ B rl' rk ra rr)                 ( \rll' rlk' rla' rlr' _ _ ->                     B                       (L l k a rll')@@ -1443,12 +1455,12 @@                 )                 rl'       )-      (\rll rlk rla rlr _ _ -> R l k a (B (insertR rll rlk rla rlr) rk ra rr))+      (\rll rlk rla rlr _ _ -> R l k a $ B (insertR rll rlk rla rlr) rk ra rr)       rl   insertLlr ll lk la lr k a r =     map'-      (B (B ll lk la E) k0 a0 (B E k a r))-      (\lrl lrk lra lrr _ _ -> L (B ll lk la (insertL lrl lrk lra lrr)) k a r)+      (B (B ll lk la E) k0 a0 $ B E k a r)+      (\lrl lrk lra lrr _ _ -> L (B ll lk la $ insertL lrl lrk lra lrr) k a r)       ( \lrl lrk lra lrr _ _ ->           let lr' = insertB lrl lrk lra lrr            in map'@@ -1470,65 +1482,5 @@                 )                 lr'       )-      (\lrl lrk lra lrr _ _ -> L (B ll lk la (insertR lrl lrk lra lrr)) k a r)+      (\lrl lrk lra lrr _ _ -> L (B ll lk la $ insertR lrl lrk lra lrr) k a r)       lr--{-- - Examples- -}--{- $examples-'fromList': /tail-biased/ means that if a list of @(key, value)@ pairs contains-pairs with identical keys, the rightmost one is kept.-->>> fromList [('a',1),('b',2),('c',3),('b',4),('a',5)]-[('a',5),('b',4),('c',3)]--'fromListWith', 'fromListWithKey': If a list of @(key, value)@ pairs contains-pairs with identical keys, the leftmost one is inserted as is and the subsequent-ones adjust the value with the combining function left-associatively. The-combining function takes the new value as the left operand, and the existing-value as the right operand.-->>> fromListWith (<>) [(1,"a"),(2,"b"),(1,"c"),(1,"d")]-[(1,"dca"),(2,"b")]->>> let f k new old = old <> ", " <> show k <> new->>> fromListWithKey f [(1,"a"),(2,"b"),(1,"c"),(1,"d")]-[(1,"a, 1c, 1d"),(2,"b")]--'intersection', 'union', 'unions': /left-biased/ means that if the operands-contain bins with identical keys, the bins from the /left/ operand is kept.-->>> fromList [('a',1),('b',2)] `intersection` fromList [('c',3),('b',4),('a',5)]-[('a',1),('b',2)]->>> fromList [('a',1),('b',2)] `union` fromList [('c',3),('b',4),('a',5)]-[('a',1),('b',2),('c',3)]--'insertWith', 'insertWithKey': If the key does not exist in the map, it is-inserted with the given value as is. Otherwise, the existing value is adjusted-with the combining function, which takes the given value as the left operand and-the existing value as the right operand.-->>> insertWith (<>) 1 "foo" $ fromList [(2,"bar"),(3,"baz")]-[(1,"foo"),(2,"bar"),(3,"baz")]->>> insertWith (<>) 2 "foo" $ fromList [(2,"bar"),(3,"baz")]-[(2,"foobar"),(3,"baz")]->>> let f k new old = k + new - old->>> insertWithKey f 1 2 $ fromList [(2,3),(3,5)]-[(1,2),(2,3),(3,5)]->>> insertWithKey f 2 7 $ fromList [(2,3),(3,5)]-[(2,6),(3,5)]--'update': If the key does not exist, the map is unchanged. If the key exists and-the result of the operation is @Just x@, the value of the corresponding bin is-updated to @x@. If the key exists and the result of the operation is @Nothing@,-the corresponding bin is removed.-->>> f a = if a == 2 then Just 9 else Nothing->>> update f 'c' $ fromList [('a',1),('b',2)]-[('a',1),('b',2)]->>> update f 'b' $ fromList [('a',1),('b',2)]-[('a',1),('b',9)]->>> update f 'a' $ fromList [('a',1),('b',2)]-[('b',2)]--}

@@ -1,15 +1,12 @@ {-# LANGUAGE LambdaCase #-} --- | Primitive recursive functions on various data structures+-- | Primitive recursive functions on basic data structures module Mini.Data.Recursion (   -- * Re-exports   bool,   either,   maybe,   uncurry,-  graph,-  map,-  set,    -- * Lists   list,@@ -116,19 +113,8 @@ import qualified Data.Tuple as Tuple (   uncurry,  )-import Mini.Data.Graph (-  graph,- )-import Mini.Data.Map (-  map,- )-import Mini.Data.Set (-  set,- ) -{-- - Re-exports- -}+-- Re-exports  -- | Primitive recursion on bools bool@@ -172,9 +158,7 @@   -> t3 uncurry = Tuple.uncurry -{-- - Lists- -}+-- Lists  -- | Primitive recursion on lists list@@ -198,9 +182,7 @@   -> b nonEmpty f (a :| as) = f a as -{-- - Orderings- -}+-- Orderings  -- | Primitive recursion on orderings ordering@@ -218,9 +200,7 @@   GT -> gt   EQ -> eq -{-- - n-Tuples (3 to 64)- -}+-- n-Tuples (3 to 64)  -- | Primitive recursion on 3-tuples uncurry3

@@ -6,18 +6,16 @@ module Mini.Data.Set (   -- * Type   Set,--  -- * Primitive Recursion   set,    -- * Construction   empty,-  singleton,-  fromList,   fromAscList,   fromDescList,   fromDistinctAscList,   fromDistinctDescList,+  fromList,+  singleton,    -- * Combination   difference,@@ -74,6 +72,10 @@ import Data.Function (   on,  )+import Mini.Data.Recursion (+  list,+  ordering,+ ) import Prelude (   Bool (     False,@@ -88,16 +90,12 @@   ),   Monoid,   Ord,-  Ordering (-    EQ,-    GT,-    LT-  ),   Semigroup,   Show,   all,   any,   compare,+  const,   div,   error,   flip,@@ -126,9 +124,7 @@   (>),  ) -{-- - Type- -}+-- Type  -- | A set containing elements of type /a/, internally structured as an AVL tree data Set a@@ -161,10 +157,6 @@ instance (Ord a) => Monoid (Set a) where   mempty = empty -{-- - Primitive recursion- -}- -- | Primitive recursion on sets (internally structured as trees) set   :: b@@ -203,22 +195,12 @@   B l a r -> g l a r (set' e f g h l) (set' e f g h r)   E -> e -{-- - Construction- -}+-- Construction  -- | /O(1)/ The empty set empty :: Set a empty = E --- | /O(1)/ Make a set with a single element-singleton :: a -> Set a-singleton a = B E a E---- | /O(n log n)/ Make a set from a list of elements-fromList :: (Ord a) => [a] -> Set a-fromList = foldl (flip insert) empty- -- | /O(n)/ Make a set from a sorted list of elements fromAscList :: (Eq a) => [a] -> Set a fromAscList = fromDistinctAscList . essence@@ -231,32 +213,42 @@ fromDistinctAscList :: [a] -> Set a fromDistinctAscList = go <*> power  where-  go [] _ = E-  go [a] _ = B E a E-  go as n =-    let len = length as-        n' = n `div` 2-        c = bool B L $ len == n-        (l, a : r) = splitAt (len `div` 2) as-     in c (go l n') a (go r n')+  go as n = list E go' as+   where+    go' a = const . list (B E a E) go''+     where+      go'' _ _ _ =+        let len = length as+            n' = n `div` 2+            c = bool B L $ len == n+            (l, a' : r) = splitAt (len `div` 2) as+         in c (go l n') a' (go r n')  -- | /O(n)/ Make a set from a sorted list of distinct elements fromDistinctDescList :: [a] -> Set a fromDistinctDescList = go <*> power  where-  go [] _ = E-  go [a] _ = B E a E-  go as n =-    let len = length as-        n' = n `div` 2-        c = bool B R $ len == n-        (l, a : r) = splitAt (len `div` 2) as-     in c (go r n') a (go l n')+  go as n = list E go' as+   where+    go' a = const . list (B E a E) go''+     where+      go'' _ _ _ =+        let len = length as+            n' = n `div` 2+            c = bool B R $ len == n+            (l, a' : r) = splitAt (len `div` 2) as+         in c (go r n') a' (go l n') -{-- - Combination- -}+-- | /O(n log n)/ Make a set from a list of elements+fromList :: (Ord a) => [a] -> Set a+fromList = foldl (flip insert) empty +-- | /O(1)/ Make a set with a single element+singleton :: a -> Set a+singleton a = B E a E++-- Combination+ -- | /O(m log n)/ Subtract a set by another difference :: (Ord a) => Set a -> Set a -> Set a difference t1 t2 = set' empty go go go t1@@ -284,9 +276,7 @@ unions :: (Foldable t, Ord a) => t (Set a) -> Set a unions = foldr union empty -{-- - Conversion- -}+-- Conversion  -- | /O(n)/ Turn a set into a list of elements in ascending order toAscList :: Set a -> [a]@@ -296,9 +286,7 @@ toDescList :: Set a -> [a] toDescList = foldl (flip (:)) [] -{-- - Modification- -}+-- Modification  -- | /O(log n)/ Delete an element from a set delete :: (Ord a) => a -> Set a -> Set a@@ -320,9 +308,7 @@ insert :: (Ord a) => a -> Set a -> Set a insert a t = bool (insert' a t) t $ a `member` t -{-- - Partition- -}+-- Partition  -- | /O(n)/ Partition a set with a predicate into @(true, false)@ subsets partition :: (a -> Bool) -> Set a -> (Set a, Set a)@@ -337,10 +323,12 @@ split a0 =   (\(lt, a, gt) -> (fromDistinctAscList lt, a, fromDistinctAscList gt))     . foldr-      ( \a (lt, a', gt) -> case compare a a0 of-          LT -> (a : lt, a', gt)-          GT -> (lt, a', a : gt)-          EQ -> (lt, True, gt)+      ( \a (lt, a', gt) ->+          ordering+            (a : lt, a', gt)+            (lt, True, gt)+            (lt, a', a : gt)+            $ compare a a0       )       ([], False, []) @@ -352,9 +340,7 @@ splitMin :: (Ord a) => Set a -> Maybe (a, Set a) splitMin t = ((,) <*> flip delete' t) <$> lookupMin t -{-- - Query- -}+-- Query  -- | /O(m log n)/ Check whether two sets have no elements in common disjoint :: (Ord a) => Set a -> Set a -> Bool@@ -372,39 +358,47 @@ lookupGE :: (Ord a) => a -> Set a -> Maybe a lookupGE a0 = set' Nothing go go go  where-  go _ a _ recl recr = case compare a a0 of-    LT -> recr-    GT -> recl <|> Just a-    EQ -> Just a+  go _ a _ recl recr =+    ordering+      recr+      (Just a)+      (recl <|> Just a)+      $ compare a a0  -- | /O(log n)/ Fetch the least element strictly greater than the given one lookupGT :: (Ord a) => a -> Set a -> Maybe a lookupGT a0 = set' Nothing go go go  where-  go _ a _ recl recr = case compare a a0 of-    LT -> recr-    GT -> recl <|> Just a-    EQ -> recr+  go _ a _ recl recr =+    ordering+      recr+      recr+      (recl <|> Just a)+      $ compare a a0  -- | /O(log n)/ Fetch the greatest element less than or equal to the given one lookupLE :: (Ord a) => a -> Set a -> Maybe a lookupLE a0 = set' Nothing go go go  where-  go _ a _ recl recr = case compare a a0 of-    LT -> recr <|> Just a-    GT -> recl-    EQ -> Just a+  go _ a _ recl recr =+    ordering+      (recr <|> Just a)+      (Just a)+      recl+      $ compare a a0  -- | /O(log n)/ Fetch the greatest element strictly less than the given one lookupLT :: (Ord a) => a -> Set a -> Maybe a lookupLT a0 = set' Nothing go go go  where-  go _ a _ recl recr = case compare a a0 of-    LT -> recr <|> Just a-    GT -> recl-    EQ -> recl+  go _ a _ recl recr =+    ordering+      (recr <|> Just a)+      recl+      recl+      $ compare a a0 --- | /O(log n)/ Fetch the maximum element, or 'Nothing' if the set is empty+-- | /O(log n)/ Fetch the maximum element lookupMax :: Set a -> Maybe a lookupMax = set' Nothing go go go  where@@ -412,7 +406,7 @@    where     go' _ _ _ _ _ = recr --- | /O(log n)/ Fetch the minimum element, or 'Nothing' if the set is empty+-- | /O(log n)/ Fetch the minimum element lookupMin :: Set a -> Maybe a lookupMin = set' Nothing go go go  where@@ -424,10 +418,12 @@ member :: (Ord a) => a -> Set a -> Bool member a0 = set' False go go go  where-  go _ a _ recl recr = case compare a0 a of-    LT -> recl-    GT -> recr-    EQ -> True+  go _ a _ recl recr =+    ordering+      recl+      True+      recr+      $ compare a0 a  -- | /O(1)/ Check whether a set is empty null :: Set a -> Bool@@ -437,9 +433,7 @@ size :: Set a -> Int size = set' 0 go go go where go _ _ _ recl recr = 1 + recl + recr -{-- - Validation- -}+-- Validation  -- | /O(n^2)/ Check whether a set is internally height-balanced and ordered valid :: (Ord a) => Set a -> Bool@@ -463,19 +457,15 @@       lt _ la _ _ _ = la < a && recl && recr       gt _ ra _ _ _ = ra > a && recl && recr -{-- - Helpers- -}+-- Helpers  -- O(n) 'nub' for sorted lists essence :: (Eq a) => [a] -> [a]-essence [] = []-essence (a : as) = essence' a as+essence = list [] go  where-  essence' x1 [] = [x1]-  essence' x1 (x2 : xs) =-    let rest = essence' x2 xs-     in bool (x1 : rest) rest $ x1 == x2+  go a1 as rec = list [a1] go' as+   where+    go' a2 _ _ = bool (a1 : rec) rec $ a1 == a2  -- The greatest power of 2 <= the length of a non-empty collection power :: (Foldable t) => t a -> Int@@ -492,152 +482,173 @@   set'     (error "Set.delete: L0")     ( \l a r _ _ ->-        case compare a0 a of-          LT -> deleteLl l a r-          GT -> deleteLr l a r-          EQ -> substituteL l r+        ordering+          (deleteLl l a r)+          (substituteL l r)+          (deleteLr l a r)+          $ compare a0 a     )     ( \l a r _ _ ->-        case compare a0 a of-          LT -> deleteBl l a r-          GT -> deleteBr l a r-          EQ -> substituteBr l r+        ordering+          (deleteBl l a r)+          (substituteBr l r)+          (deleteBr l a r)+          $ compare a0 a     )     ( \l a r _ _ ->-        case compare a0 a of-          LT -> deleteRl l a r-          GT -> deleteRr l a r-          EQ -> substituteR l r+        ordering+          (deleteRl l a r)+          (substituteR l r)+          (deleteRr l a r)+          $ compare a0 a     )  where   deleteRl l a r =     set'       (error "Set.delete: L1")       ( \ll la lr _ _ ->-          case compare a0 la of-            LT -> checkLeftR (deleteLl ll la lr) a r-            GT -> checkLeftR (deleteLr ll la lr) a r-            EQ -> checkLeftR (substituteL ll lr) a r+          ordering+            (checkLeftR (deleteLl ll la lr) a r)+            (checkLeftR (substituteL ll lr) a r)+            (checkLeftR (deleteLr ll la lr) a r)+            $ compare a0 la       )       ( \ll la lr _ _ ->-          case compare a0 la of-            LT -> R (deleteBl ll la lr) a r-            GT -> R (deleteBr ll la lr) a r-            EQ -> checkLeftR' (substituteBr ll lr) a r+          ordering+            (R (deleteBl ll la lr) a r)+            (checkLeftR' (substituteBr ll lr) a r)+            (R (deleteBr ll la lr) a r)+            $ compare a0 la       )       ( \ll la lr _ _ ->-          case compare a0 la of-            LT -> checkLeftR (deleteRl ll la lr) a r-            GT -> checkLeftR (deleteRr ll la lr) a r-            EQ -> checkLeftR (substituteR ll lr) a r+          ordering+            (checkLeftR (deleteRl ll la lr) a r)+            (checkLeftR (substituteR ll lr) a r)+            (checkLeftR (deleteRr ll la lr) a r)+            $ compare a0 la       )       l   deleteRr l a =     set'       (error "Set.delete: L2")       ( \rl ra rr _ _ ->-          case compare a0 ra of-            LT -> checkRightR l a (deleteLl rl ra rr)-            GT -> checkRightR l a (deleteLr rl ra rr)-            EQ -> checkRightR l a (substituteL rl rr)+          ordering+            (checkRightR l a $ deleteLl rl ra rr)+            (checkRightR l a $ substituteL rl rr)+            (checkRightR l a $ deleteLr rl ra rr)+            $ compare a0 ra       )       ( \rl ra rr _ _ ->-          case compare a0 ra of-            LT -> R l a (deleteBl rl ra rr)-            GT -> R l a (deleteBr rl ra rr)-            EQ -> checkRightR' l a (substituteBl rl rr)+          ordering+            (R l a $ deleteBl rl ra rr)+            (checkRightR' l a $ substituteBl rl rr)+            (R l a $ deleteBr rl ra rr)+            $ compare a0 ra       )       ( \rl ra rr _ _ ->-          case compare a0 ra of-            LT -> checkRightR l a (deleteRl rl ra rr)-            GT -> checkRightR l a (deleteRr rl ra rr)-            EQ -> checkRightR l a (substituteR rl rr)+          ordering+            (checkRightR l a $ deleteRl rl ra rr)+            (checkRightR l a $ substituteR rl rr)+            (checkRightR l a $ deleteRr rl ra rr)+            $ compare a0 ra       )   deleteBl l a r =     set'       (error "Set.delete: L3")       ( \ll la lr _ _ ->-          case compare a0 la of-            LT -> checkLeftB (deleteLl ll la lr) a r-            GT -> checkLeftB (deleteLr ll la lr) a r-            EQ -> checkLeftB (substituteL ll lr) a r+          ordering+            (checkLeftB (deleteLl ll la lr) a r)+            (checkLeftB (substituteL ll lr) a r)+            (checkLeftB (deleteLr ll la lr) a r)+            $ compare a0 la       )       ( \ll la lr _ _ ->-          case compare a0 la of-            LT -> B (deleteBl ll la lr) a r-            GT -> B (deleteBr ll la lr) a r-            EQ -> checkLeftB' (substituteBr ll lr) a r+          ordering+            (B (deleteBl ll la lr) a r)+            (checkLeftB' (substituteBr ll lr) a r)+            (B (deleteBr ll la lr) a r)+            $ compare a0 la       )       ( \ll la lr _ _ ->-          case compare a0 la of-            LT -> checkLeftB (deleteRl ll la lr) a r-            GT -> checkLeftB (deleteRr ll la lr) a r-            EQ -> checkLeftB (substituteR ll lr) a r+          ordering+            (checkLeftB (deleteRl ll la lr) a r)+            (checkLeftB (substituteR ll lr) a r)+            (checkLeftB (deleteRr ll la lr) a r)+            $ compare a0 la       )       l   deleteBr l a =     set'       (error "Set.delete: L4")       ( \rl ra rr _ _ ->-          case compare a0 ra of-            LT -> checkRightB l a (deleteLl rl ra rr)-            GT -> checkRightB l a (deleteLr rl ra rr)-            EQ -> checkRightB l a (substituteL rl rr)+          ordering+            (checkRightB l a $ deleteLl rl ra rr)+            (checkRightB l a $ substituteL rl rr)+            (checkRightB l a $ deleteLr rl ra rr)+            $ compare a0 ra       )       ( \rl ra rr _ _ ->-          case compare a0 ra of-            LT -> B l a (deleteBl rl ra rr)-            GT -> B l a (deleteBr rl ra rr)-            EQ -> checkRightB' l a (substituteBl rl rr)+          ordering+            (B l a $ deleteBl rl ra rr)+            (checkRightB' l a $ substituteBl rl rr)+            (B l a $ deleteBr rl ra rr)+            $ compare a0 ra       )       ( \rl ra rr _ _ ->-          case compare a0 ra of-            LT -> checkRightB l a (deleteRl rl ra rr)-            GT -> checkRightB l a (deleteRr rl ra rr)-            EQ -> checkRightB l a (substituteR rl rr)+          ordering+            (checkRightB l a $ deleteRl rl ra rr)+            (checkRightB l a $ substituteR rl rr)+            (checkRightB l a $ deleteRr rl ra rr)+            $ compare a0 ra       )   deleteLl l a r =     set'       (error "Set.delete: L5")       ( \ll la lr _ _ ->-          case compare a0 la of-            LT -> checkLeftL (deleteLl ll la lr) a r-            GT -> checkLeftL (deleteLr ll la lr) a r-            EQ -> checkLeftL (substituteL ll lr) a r+          ordering+            (checkLeftL (deleteLl ll la lr) a r)+            (checkLeftL (substituteL ll lr) a r)+            (checkLeftL (deleteLr ll la lr) a r)+            $ compare a0 la       )       ( \ll la lr _ _ ->-          case compare a0 la of-            LT -> L (deleteBl ll la lr) a r-            GT -> L (deleteBr ll la lr) a r-            EQ -> checkLeftL' (substituteBr ll lr) a r+          ordering+            (L (deleteBl ll la lr) a r)+            (checkLeftL' (substituteBr ll lr) a r)+            (L (deleteBr ll la lr) a r)+            $ compare a0 la       )       ( \ll la lr _ _ ->-          case compare a0 la of-            LT -> checkLeftL (deleteRl ll la lr) a r-            GT -> checkLeftL (deleteRr ll la lr) a r-            EQ -> checkLeftL (substituteR ll lr) a r+          ordering+            (checkLeftL (deleteRl ll la lr) a r)+            (checkLeftL (substituteR ll lr) a r)+            (checkLeftL (deleteRr ll la lr) a r)+            $ compare a0 la       )       l   deleteLr l a =     set'       (error "Set.delete: L6")       ( \rl ra rr _ _ ->-          case compare a0 ra of-            LT -> checkRightL l a (deleteLl rl ra rr)-            GT -> checkRightL l a (deleteLr rl ra rr)-            EQ -> checkRightL l a (substituteL rl rr)+          ordering+            (checkRightL l a $ deleteLl rl ra rr)+            (checkRightL l a $ substituteL rl rr)+            (checkRightL l a $ deleteLr rl ra rr)+            $ compare a0 ra       )       ( \rl ra rr _ _ ->-          case compare a0 ra of-            LT -> L l a (deleteBl rl ra rr)-            GT -> L l a (deleteBr rl ra rr)-            EQ -> checkRightL' l a (substituteBl rl rr)+          ordering+            (L l a $ deleteBl rl ra rr)+            (checkRightL' l a $ substituteBl rl rr)+            (L l a $ deleteBr rl ra rr)+            $ compare a0 ra       )       ( \rl ra rr _ _ ->-          case compare a0 ra of-            LT -> checkRightL l a (deleteRl rl ra rr)-            GT -> checkRightL l a (deleteRr rl ra rr)-            EQ -> checkRightL l a (substituteR rl rr)+          ordering+            (checkRightL l a $ deleteRl rl ra rr)+            (checkRightL l a $ substituteR rl rr)+            (checkRightL l a $ deleteRr rl ra rr)+            $ compare a0 ra       )   rebalanceR l a =     set'@@ -645,9 +656,9 @@       ( \rl ra rr _ _ ->           set'             (error "Set.delete: L8")-            (\rll rla rlr _ _ -> B (B l a rll) rla (R rlr ra rr))-            (\rll rla rlr _ _ -> B (B l a rll) rla (B rlr ra rr))-            (\rll rla rlr _ _ -> B (L l a rll) rla (B rlr ra rr))+            (\rll rla rlr _ _ -> B (B l a rll) rla $ R rlr ra rr)+            (\rll rla rlr _ _ -> B (B l a rll) rla $ B rlr ra rr)+            (\rll rla rlr _ _ -> B (L l a rll) rla $ B rlr ra rr)             rl       )       (\rl ra rr _ _ -> L (R l a rl) ra rr)@@ -655,14 +666,14 @@   rebalanceL l a r =     set'       (error "Set.delete: L9")-      (\ll la lr _ _ -> B ll la (B lr a r))-      (\ll la lr _ _ -> R ll la (L lr a r))+      (\ll la lr _ _ -> B ll la $ B lr a r)+      (\ll la lr _ _ -> R ll la $ L lr a r)       ( \ll la lr _ _ ->           set'             (error "Set.delete: L10")-            (\lrl lra lrr _ _ -> B (B ll la lrl) lra (R lrr a r))-            (\lrl lra lrr _ _ -> B (B ll la lrl) lra (B lrr a r))-            (\lrl lra lrr _ _ -> B (L ll la lrl) lra (B lrr a r))+            (\lrl lra lrr _ _ -> B (B ll la lrl) lra $ R lrr a r)+            (\lrl lra lrr _ _ -> B (B ll la lrl) lra $ B lrr a r)+            (\lrl lra lrr _ _ -> B (L ll la lrl) lra $ B lrr a r)             lr       )       l@@ -912,20 +923,23 @@     (\l a r _ _ -> insertR l a r)  where   insertR l a r =-    case compare a0 a of-      LT -> insertRl l a r-      GT -> insertRr l a r-      EQ -> R l a0 r+    ordering+      (insertRl l a r)+      (R l a0 r)+      (insertRr l a r)+      $ compare a0 a   insertB l a r =-    case compare a0 a of-      LT -> insertBl l a r-      GT -> insertBr l a r-      EQ -> B l a0 r+    ordering+      (insertBl l a r)+      (B l a0 r)+      (insertBr l a r)+      $ compare a0 a   insertL l a r =-    case compare a0 a of-      LT -> insertLl l a r-      GT -> insertLr l a r-      EQ -> L l a0 r+    ordering+      (insertLl l a r)+      (L l a0 r)+      (insertLr l a r)+      $ compare a0 a   insertRl l a r =     set'       (B (B E a0 E) a r)@@ -958,8 +972,8 @@       l   insertBr l a =     set'-      (R l a (B E a0 E))-      (\rl ra rr _ _ -> B l a (insertL rl ra rr))+      (R l a $ B E a0 E)+      (\rl ra rr _ _ -> B l a $ insertL rl ra rr)       ( \rl ra rr _ _ ->           let r = insertB rl ra rr            in set'@@ -969,11 +983,11 @@                 (\_ _ _ _ _ -> R l a r)                 r       )-      (\rl ra rr _ _ -> B l a (insertR rl ra rr))+      (\rl ra rr _ _ -> B l a $ insertR rl ra rr)   insertLr l a =     set'-      (B l a (B E a0 E))-      (\rl ra rr _ _ -> L l a (insertL rl ra rr))+      (B l a $ B E a0 E)+      (\rl ra rr _ _ -> L l a $ insertL rl ra rr)       ( \rl ra rr _ _ ->           let r = insertB rl ra rr            in set'@@ -983,86 +997,88 @@                 (\_ _ _ _ _ -> B l a r)                 r       )-      (\rl ra rr _ _ -> L l a (insertR rl ra rr))+      (\rl ra rr _ _ -> L l a $ insertR rl ra rr)   insertRr l a =     set'       (error "Set.insert: L4")-      (\rl ra rr _ _ -> R l a (insertL rl ra rr))+      (\rl ra rr _ _ -> R l a $ insertL rl ra rr)       ( \rl ra rr _ _ ->-          case compare a0 ra of-            LT -> insertRrl l a rl ra rr-            GT -> insertRrr l a rl ra rr-            EQ -> R l a (B rl a0 rr)+          ordering+            (insertRrl l a rl ra rr)+            (R l a $ B rl a0 rr)+            (insertRrr l a rl ra rr)+            $ compare a0 ra       )-      (\rl ra rr _ _ -> R l a (insertR rl ra rr))+      (\rl ra rr _ _ -> R l a $ insertR rl ra rr)   insertLl l a r =     set'       (error "Set.insert: L5")       (\ll la lr _ _ -> L (insertL ll la lr) a r)       ( \ll la lr _ _ ->-          case compare a0 la of-            LT -> insertLll ll la lr a r-            GT -> insertLlr ll la lr a r-            EQ -> L (B ll a0 lr) a r+          ordering+            (insertLll ll la lr a r)+            (L (B ll a0 lr) a r)+            (insertLlr ll la lr a r)+            $ compare a0 la       )       (\ll la lr _ _ -> L (insertR ll la lr) a r)       l   insertRrr l a rl ra =     set'-      (B (B l a rl) ra (B E a0 E))-      (\rrl rra rrr _ _ -> R l a (B rl ra (insertL rrl rra rrr)))+      (B (B l a rl) ra $ B E a0 E)+      (\rrl rra rrr _ _ -> R l a . B rl ra $ insertL rrl rra rrr)       ( \rrl rra rrr _ _ ->           let rr = insertB rrl rra rrr            in set'                 (error "Set.insert: L6")                 (\_ _ _ _ _ -> B (B l a rl) ra rr)-                (\_ _ _ _ _ -> R l a (B rl ra rr))+                (\_ _ _ _ _ -> R l a $ B rl ra rr)                 (\_ _ _ _ _ -> B (B l a rl) ra rr)                 rr       )-      (\rrl rra rrr _ _ -> R l a (B rl ra (insertR rrl rra rrr)))+      (\rrl rra rrr _ _ -> R l a . B rl ra $ insertR rrl rra rrr)   insertLll ll la lr a r =     set'-      (B (B E a0 E) la (B lr a r))+      (B (B E a0 E) la $ B lr a r)       (\lll lla llr _ _ -> L (B (insertL lll lla llr) la lr) a r)       ( \lll lla llr _ _ ->           let ll' = insertB lll lla llr            in set'                 (error "Set.insert: L7")-                (\_ _ _ _ _ -> B ll' la (B lr a r))+                (\_ _ _ _ _ -> B ll' la $ B lr a r)                 (\_ _ _ _ _ -> L (B ll' la lr) a r)-                (\_ _ _ _ _ -> B ll' la (B lr a r))+                (\_ _ _ _ _ -> B ll' la $ B lr a r)                 ll'       )       (\lll lla llr _ _ -> L (B (insertR lll lla llr) la lr) a r)       ll   insertRrl l a rl ra rr =     set'-      (B (B l a E) a0 (B E ra rr))-      (\rll rla rlr _ _ -> R l a (B (insertL rll rla rlr) ra rr))+      (B (B l a E) a0 $ B E ra rr)+      (\rll rla rlr _ _ -> R l a $ B (insertL rll rla rlr) ra rr)       ( \rll rla rlr _ _ ->           let rl' = insertB rll rla rlr            in set'                 (error "Set.insert: L8")-                (\rll' rla' rlr' _ _ -> B (B l a rll') rla' (R rlr' ra rr))-                (\_ _ _ _ _ -> R l a (B rl' ra rr))-                (\rll' rla' rlr' _ _ -> B (L l a rll') rla' (B rlr' ra rr))+                (\rll' rla' rlr' _ _ -> B (B l a rll') rla' $ R rlr' ra rr)+                (\_ _ _ _ _ -> R l a $ B rl' ra rr)+                (\rll' rla' rlr' _ _ -> B (L l a rll') rla' $ B rlr' ra rr)                 rl'       )-      (\rll rla rlr _ _ -> R l a (B (insertR rll rla rlr) ra rr))+      (\rll rla rlr _ _ -> R l a $ B (insertR rll rla rlr) ra rr)       rl   insertLlr ll la lr a r =     set'-      (B (B ll la E) a0 (B E a r))-      (\lrl lra lrr _ _ -> L (B ll la (insertL lrl lra lrr)) a r)+      (B (B ll la E) a0 $ B E a r)+      (\lrl lra lrr _ _ -> L (B ll la $ insertL lrl lra lrr) a r)       ( \lrl lra lrr _ _ ->           let lr' = insertB lrl lra lrr            in set'                 (error "Set.insert: L9")-                (\lrl' lra' lrr' _ _ -> B (B ll la lrl') lra' (R lrr' a r))+                (\lrl' lra' lrr' _ _ -> B (B ll la lrl') lra' $ R lrr' a r)                 (\_ _ _ _ _ -> L (B ll la lr') a r)-                (\lrl' lra' lrr' _ _ -> B (L ll la lrl') lra' (B lrr' a r))+                (\lrl' lra' lrr' _ _ -> B (L ll la lrl') lra' $ B lrr' a r)                 lr'       )-      (\lrl lra lrr _ _ -> L (B ll la (insertR lrl lra lrr)) a r)+      (\lrl lra lrr _ _ -> L (B ll la $ insertR lrl lra lrr) a r)       lr

@@ -9,12 +9,9 @@   lens,    -- * Operations-  view,   over,   set,--  -- * Tutorial-  -- $tutorial+  view, ) where  import Control.Applicative (@@ -37,28 +34,18 @@   (<$>),  ) -{-- - Type- -}+-- Type  -- | A reference updating structures from /s/ to /t/ and fields from /a/ to /b/ type Lens s t a b = forall f. (Functor f) => (a -> f b) -> (s -> f t) -{-- - Construction- -}+-- Construction  -- | Make a lens from a getter and a setter lens :: (s -> a) -> (s -> b -> t) -> Lens s t a b lens sa sbt ab s = sbt s <$> ab (sa s) -{-- - Operations- -}---- | Fetch the field referenced by a lens from a structure-view :: Lens s t a b -> s -> a-view o = getConst . o Const+-- Operations  -- | Update the field referenced by a lens with an operation on a structure over :: Lens s t a b -> (a -> b) -> s -> t@@ -68,83 +55,6 @@ set :: Lens s t a b -> b -> s -> t set o b = runIdentity . o (const $ Identity b) -{-- - Tutorial- -}--{- $tutorial-Record syntax is excellent for modeling data. But modifying records can be-cumbersome, especially when nested. Below we define some data and compare common-ways of modifying it, illustrating the need for something better. Then we-satisfy that need with lenses, showing how to use them.--Lenses essentially take the place of accessor functions. The accessor names of-the records below start with an underscore; this is to avoid name clashing when-creating the corresponding lenses.--> data Parcel = Parcel->   { _weight :: Int->   , _size :: Size->   }->-> data Size = Size->   { _length :: Int->   , _width :: Int->   , _height :: Int->   }--Let's create a function that doubles the width of a parcel and sets its weight-to 500. First using record syntax, then pattern matching.--> foo :: Parcel -> Parcel-> foo p =->   let s = _size p->       w = _width s->    in p->         { _weight = 500->         , _size = s{_width = w * 2}->         }->-> foo' :: Parcel -> Parcel-> foo' (Parcel _ (Size l w h)) =->   Parcel->     500->     (Size l (w * 2) h)--Record syntax lets us specify only the fields we wish to modify but we have to-use the accessors repeatedly. Pattern matching looks cleaner but we have to-unpack and repack all the data. It's not hard to imagine how unwieldy it would-be with heavily nested records no matter which way we choose.--Lenses provide a concise, declarative, composable way to inspect and modify-records. The downside is that some initial boilerplate code is required to-create the lenses.--> weight :: Lens Parcel Parcel Int Int-> weight = lens _weight $ \s b -> s{_weight = b}->-> size :: Lens Parcel Parcel Size Size-> size = lens _size $ \s b -> s{_size = b}->-> width :: Lens Size Size Int Int-> width = lens _width $ \s b -> s{_width = b}--Each lens can be used with 'view', 'over', and 'set' to inspect or modify a-field, letting us complete our task with ease.--> foo'' :: Parcel -> Parcel-> foo'' =->   over (size . width) (* 2)->     . set weight 500--Note the reversed ordering of the composed lenses. Inspecting is similar to-using regular accessors, but again, composed in reverse.--> bar :: Parcel -> Int-> bar = view (size . width)--This covers the most typical use case, where the lenses preserve the structure-of the records (e.g. @weight@ is a @Lens@ from @Parcel@ to @Parcel@, from @Int@-to @Int@). Creating lenses that change the structure is left as an exercise to-the reader.--}+-- | Fetch the field referenced by a lens from a structure+view :: Lens s t a b -> s -> a+view o = getConst . o Const

@@ -10,9 +10,7 @@   Monad,  ) -{-- - Class- -}+-- Class  {- | Instances should satisfy the following laws: 

@@ -4,13 +4,11 @@   EitherT (     EitherT   ),--  -- * Runner   runEitherT,    -- * Operations-  left,   anticipate,+  left, ) where  import Control.Applicative (@@ -54,9 +52,7 @@   (>>=),  ) -{-- - Type- -}+-- Type  -- | A terminable transformer with termination /e/, inner monad /m/, return /a/ newtype EitherT e m a = EitherT@@ -72,7 +68,7 @@   (<*>) = ap  instance (Monad m, Monoid e) => Alternative (EitherT e m) where-  empty = EitherT . pure $ Left mempty+  empty = left mempty   m <|> n =     EitherT $       runEitherT m@@ -97,14 +93,12 @@ instance (MonadIO m) => MonadIO (EitherT e m) where   liftIO = lift . liftIO -{-- - Operations- -}---- | Terminate the computation with a value-left :: (Monad m) => e -> EitherT e m a-left = EitherT . pure . Left+-- Operations  -- | Run a computation and get its result anticipate :: (Monad m) => EitherT e m a -> EitherT e m (Either e a) anticipate = lift . runEitherT . (Right <$>) >=> either (pure . Left) pure++-- | Terminate the computation with a value+left :: (Applicative m) => e -> EitherT e m a+left = EitherT . pure . Left

@@ -4,13 +4,11 @@   MaybeT (     MaybeT   ),--  -- * Runner   runMaybeT,    -- * Operations-  nothing,   anticipate,+  nothing, ) where  import Control.Applicative (@@ -40,6 +38,7 @@   ),   Monad,   MonadFail,+  const,   fail,   fmap,   maybe,@@ -51,9 +50,7 @@   (>>=),  ) -{-- - Type- -}+-- Type  -- | A terminable transformer with inner monad /m/, return /a/ newtype MaybeT m a = MaybeT@@ -69,7 +66,7 @@   (<*>) = ap  instance (Monad m) => Alternative (MaybeT m) where-  empty = MaybeT $ pure Nothing+  empty = nothing   m <|> n =     MaybeT $       runMaybeT m@@ -89,19 +86,17 @@   lift = MaybeT . fmap Just  instance (Monad m) => MonadFail (MaybeT m) where-  fail _ = empty+  fail = const nothing  instance (MonadIO m) => MonadIO (MaybeT m) where   liftIO = lift . liftIO -{-- - Operations- -}---- | Terminate the computation without a value-nothing :: (Monad m) => MaybeT m a-nothing = empty+-- Operations  -- | Run a computation and get its result anticipate :: (Monad m) => MaybeT m a -> MaybeT m (Maybe a) anticipate = lift . runMaybeT . (Just <$>) >=> maybe (pure Nothing) pure++-- | Terminate the computation without a value+nothing :: (Applicative m) => MaybeT m a+nothing = MaybeT $ pure Nothing

@@ -1,46 +1,42 @@-{-# LANGUAGE LambdaCase #-} {-# LANGUAGE TupleSections #-}  -- | Extend a monad with the ability to parse symbol sequences module Mini.Transformers.ParserT (-  -- * Types+  -- * Type   ParserT (     ParserT   ),-  ParseError (-    ParseError,-    unexpected-  ),--  -- * Runner   runParserT,    -- * Parsers-  sat,+  eof,   item,-  symbol,-  string,-  oneOf,+  look,   noneOf,-  eof,+  oneOf,   peek,+  sat,+  string,+  symbol,    -- * Combinators-  sepBy,-  sepBy1,-  till,-  till1,+  accept,+  atLeast,+  atMost,+  between,   chainl1,   chainr1,-  between,-  option,-  reject,-  accept,-  findFirst,-  findLast,   findAll,   findAll1,-  annotate,+  findFirst,+  findLast,+  option,+  range,+  reject,+  sepBy,+  sepBy1,+  till,+  till1, ) where  import Control.Applicative (@@ -53,6 +49,7 @@ import Control.Monad (   ap,   liftM,+  replicateM,   (>=>),  ) import Control.Monad.IO.Class (@@ -62,6 +59,9 @@ import Data.Bool (   bool,  )+import Mini.Data.Recursion (+  list,+ ) import Mini.Transformers.Class (   MonadTrans,   lift,@@ -71,34 +71,33 @@   Bool (     True   ),-  Either (-    Left,-    Right-  ),   Eq,   Foldable,   Functor,+  Int,+  Maybe (+    Just,+    Nothing+  ),   Monad,   MonadFail,   Monoid,   Semigroup,-  Show,-  String,   Traversable,   const,-  either,   elem,   fail,   flip,   fmap,   fst,+  maybe,   mempty,   notElem,   pure,-  show,   traverse,   ($),   (*>),+  (-),   (.),   (<$),   (<$>),@@ -106,16 +105,15 @@   (<*>),   (<>),   (==),+  (>),   (>>=),  ) -{-- - Types- -}+-- Type  -- | A transformer parsing symbols /s/, inner monad /m/, return /a/ newtype ParserT s m a = ParserT-  { runParserT :: [s] -> m (Either ParseError (a, [s]))+  { runParserT :: [s] -> m (Maybe (a, [s]))   -- ^ Unwrap a 'ParserT' computation with a sequence of symbols to parse   } @@ -123,30 +121,24 @@   fmap = liftM  instance (Monad m) => Applicative (ParserT s m) where-  pure a = ParserT $ pure . Right . (a,)+  pure a = ParserT $ pure . Just . (a,)   (<*>) = ap --- | Parse @p@ or, if @p@ fails, backtrack and parse @q@ via @p \<|\> q@-instance (Monad m, Eq s) => Alternative (ParserT s m) where-  empty = fail empty-  m <|> n = ParserT $ \ss ->-    runParserT m ss-      >>= either-        (const $ runParserT n ss)-        (pure . Right)+instance (Monad m) => Alternative (ParserT s m) where+  empty = ParserT . const $ pure Nothing+  m <|> n = ParserT $ \ss -> (<|>) <$> runParserT m ss <*> runParserT n ss  instance (Monad m) => Monad (ParserT s m) where   m >>= k =     ParserT $       runParserT m-        >=> either-          (pure . Left)+        >=> maybe+          (pure Nothing)           (\(a, ss') -> runParserT (k a) ss')  instance MonadTrans (ParserT s) where-  lift m = ParserT $ \ss -> Right . (,ss) <$> m+  lift m = ParserT $ \ss -> Just . (,ss) <$> m --- | Combine the results of @p@ and @q@ via @p <> q@ instance (Monad m, Semigroup a) => Semigroup (ParserT s m a) where   m <> n = (<>) <$> m <*> n @@ -154,80 +146,89 @@   mempty = pure mempty  instance (Monad m) => MonadFail (ParserT s m) where-  fail = ParserT . const . pure . Left . ParseError+  fail = const empty  instance (MonadIO m) => MonadIO (ParserT s m) where   liftIO = lift . liftIO --- | A parse error-newtype ParseError = ParseError {unexpected :: String}-  deriving (Show)--{-- - Parsers- -}+-- Parsers --- | Parse symbols satisfying a predicate-sat :: (Applicative m, Show s) => (s -> Bool) -> ParserT s m s-sat p = ParserT $ \case-  [] -> pure . Left $ ParseError []-  (s : ss) ->-    bool-      (pure . Left . ParseError $ show s)-      (pure $ Right (s, ss))-      $ p s+-- | Parse successfully only at end of input+eof :: (Monad m) => ParserT s m ()+eof = reject item  -- | Parse any symbol-item :: (Applicative m, Show s) => ParserT s m s+item :: (Applicative m) => ParserT s m s item = sat $ const True --- | Parse a symbol-symbol :: (Applicative m, Show s, Eq s) => s -> ParserT s m s-symbol = sat . (==)---- | Parse a sequence of symbols-string :: (Monad m, Traversable t, Show s, Eq s) => t s -> ParserT s m (t s)-string = traverse symbol---- | Parse symbols included in a collection-oneOf :: (Applicative m, Foldable t, Show s, Eq s) => t s -> ParserT s m s-oneOf = sat . flip elem+-- | Parse the rest of the input without consuming it+look :: (Applicative m) => ParserT s m [s]+look = ParserT $ \ss -> pure $ Just (ss, ss) --- | Parse symbols excluded from a collection-noneOf :: (Applicative m, Foldable t, Show s, Eq s) => t s -> ParserT s m s+-- | Parse the next symbol if excluded from a collection+noneOf :: (Applicative m, Foldable t, Eq s) => t s -> ParserT s m s noneOf = sat . flip notElem --- | Parse successfully only at end of input-eof :: (Monad m, Show s) => ParserT s m ()-eof = reject item+-- | Parse the next symbol if included in a collection+oneOf :: (Applicative m, Foldable t, Eq s) => t s -> ParserT s m s+oneOf = sat . flip elem  -- | Parse the next symbol without consuming it-peek :: (Monad m, Show s) => ParserT s m s+peek :: (Monad m) => ParserT s m s peek = accept item -{-- - Combinators- -}+-- | Parse the next symbol if it satisfies a predicate+sat :: (Applicative m) => (s -> Bool) -> ParserT s m s+sat p =+  ParserT $+    pure+      . list+        Nothing+        ( \s ss _ ->+            bool+              Nothing+              (Just (s, ss))+              $ p s+        ) --- | Parse zero or more @p@ separated by @q@ via @p \`sepBy\` q@-sepBy :: (Monad m, Eq s) => ParserT s m a -> ParserT s m b -> ParserT s m [a]-sepBy p = option [] . sepBy1 p+-- | Parse a sequence of symbols+string :: (Monad m, Traversable t, Eq s) => t s -> ParserT s m (t s)+string = traverse symbol --- | Parse one or more @p@ separated by @q@ via @p \`sepBy1\` q@-sepBy1 :: (Monad m, Eq s) => ParserT s m a -> ParserT s m b -> ParserT s m [a]-sepBy1 p sep = (:) <$> p <*> many (sep *> p)+-- | Parse a specific symbol+symbol :: (Applicative m, Eq s) => s -> ParserT s m s+symbol = sat . (==) --- | Parse zero or more @p@ until @q@ succeeds via @p \`till\` q@-till :: (Monad m, Eq s) => ParserT s m a -> ParserT s m b -> ParserT s m [a]-till p end = ([] <$ end) <|> till1 p end+-- Combinators --- | Parse one or more @p@ until @q@ succeeds via @p \`till1\` q@-till1 :: (Monad m, Eq s) => ParserT s m a -> ParserT s m b -> ParserT s m [a]-till1 p end = (:) <$> p <*> till p end+-- | Parse @p@, without consuming input, iff @p@ succeeds via @accept p@+accept :: (Monad m) => ParserT s m a -> ParserT s m a+accept p = ParserT $ \ss -> fmap ((,ss) . fst) <$> runParserT p ss +-- | Parse @n@ or more occurrences of @p@ via @atLeast n p@+atLeast :: (Monad m) => Int -> ParserT s m a -> ParserT s m [a]+atLeast n p = replicateM n p <> many p++-- | Parse up to @n@ occurrences of @p@ via @atMost n p@+atMost :: (Monad m) => Int -> ParserT s m a -> ParserT s m [a]+atMost n p =+  bool+    (pure [])+    (option [] $ (:) <$> p <*> atMost (n - 1) p)+    $ n > 0++-- | Parse @p@ enclosed by @a@ and @b@ via @between a b p@+between+  :: (Monad m)+  => ParserT s m open+  -> ParserT s m close+  -> ParserT s m a+  -> ParserT s m a+between open close p = open *> p <* close+ -- | Parse one or more @p@ left-associatively chained by @f@ via @chainl1 p f@ chainl1-  :: (Monad m, Eq s)+  :: (Monad m)   => ParserT s m a   -> ParserT s m (a -> a -> a)   -> ParserT s m a@@ -237,7 +238,7 @@  -- | Parse one or more @p@ right-associatively chained by @f@ via @chainr1 p f@ chainr1-  :: (Monad m, Eq s)+  :: (Monad m)   => ParserT s m a   -> ParserT s m (a -> a -> a)   -> ParserT s m a@@ -246,56 +247,50 @@   go = p >>= rest   rest a = option a $ f <*> pure a <*> go >>= rest --- | Parse @p@ enclosed by @a@ and @b@ via @between a b p@-between-  :: (Monad m)-  => ParserT s m open-  -> ParserT s m close-  -> ParserT s m a-  -> ParserT s m a-between open close p = open *> p <* close+-- | Find and parse zero or more occurrences of @p@ via @findAll p@+findAll :: (Monad m) => ParserT s m a -> ParserT s m [a]+findAll = many . findFirst +-- | Find and parse one or more occurrences of @p@ via @findAll1 p@+findAll1 :: (Monad m) => ParserT s m a -> ParserT s m [a]+findAll1 = some . findFirst++-- | Find and parse the first occurrence of @p@ via @findFirst p@+findFirst :: (Monad m) => ParserT s m a -> ParserT s m a+findFirst p = p <|> (item *> findFirst p)++-- | Find and parse the last occurrence of @p@ via @findLast p@+findLast :: (Monad m) => ParserT s m a -> ParserT s m a+findLast p = findFirst p >>= flip option (findLast p)+ -- | Parse @p@ returning @a@ in case of failure via @option a p@-option :: (Monad m, Eq s) => a -> ParserT s m a -> ParserT s m a+option :: (Monad m) => a -> ParserT s m a -> ParserT s m a option a p = p <|> pure a +-- | Parse between @lo@ and @hi@ occurrences of @p@ via @range lo hi p@+range :: (Monad m) => Int -> Int -> ParserT s m a -> ParserT s m [a]+range lo hi p = replicateM lo p <> atMost (hi - lo) p+ -- | Parse @p@, without consuming input, iff @p@ fails via @reject p@-reject :: (Monad m, Show a) => ParserT s m a -> ParserT s m ()+reject :: (Monad m) => ParserT s m a -> ParserT s m () reject p = ParserT $ \ss ->   runParserT p ss-    >>= either-      (const . pure $ Right ((), ss))-      (pure . Left . ParseError . show . fst)---- | Parse @p@, without consuming input, iff @p@ succeeds via @accept p@-accept :: (Monad m) => ParserT s m a -> ParserT s m a-accept p = ParserT $ \ss ->-  runParserT p ss-    >>= either-      (pure . Left)-      (pure . Right . (,ss) . fst)---- | Find and parse the first instance of @p@ via @findFirst p@-findFirst :: (Monad m, Eq s, Show s) => ParserT s m a -> ParserT s m a-findFirst p = p <|> (item *> findFirst p)+    >>= maybe+      (pure $ Just ((), ss))+      (const $ pure Nothing) --- | Find and parse the last instance of @p@ via @findLast p@-findLast :: (Monad m, Eq s, Show s) => ParserT s m a -> ParserT s m a-findLast p = findFirst p >>= flip option (findLast p)+-- | Parse zero or more @p@ separated by @q@ via @p \`sepBy\` q@+sepBy :: (Monad m) => ParserT s m a -> ParserT s m b -> ParserT s m [a]+sepBy p = option [] . sepBy1 p --- | Find and parse zero or more instances of @p@ via @findAll p@-findAll :: (Monad m, Eq s, Show s) => ParserT s m a -> ParserT s m [a]-findAll = many . findFirst+-- | Parse one or more @p@ separated by @q@ via @p \`sepBy1\` q@+sepBy1 :: (Monad m) => ParserT s m a -> ParserT s m b -> ParserT s m [a]+sepBy1 p sep = (:) <$> p <*> many (sep *> p) --- | Find and parse one or more instances of @p@ via @findAll1 p@-findAll1 :: (Monad m, Eq s, Show s) => ParserT s m a -> ParserT s m [a]-findAll1 = some . findFirst+-- | Parse zero or more @p@ until @q@ succeeds via @p \`till\` q@+till :: (Monad m) => ParserT s m a -> ParserT s m b -> ParserT s m [a]+till p end = ([] <$ end) <|> till1 p end --- | Prepend an error message to that of a parser-annotate :: (Monad m) => String -> ParserT s m a -> ParserT s m a-annotate s p =-  ParserT $-    runParserT p-      >=> either-        (pure . Left . ParseError . (s <>) . unexpected)-        (pure . Right)+-- | Parse one or more @p@ until @q@ succeeds via @p \`till1\` q@+till1 :: (Monad m) => ParserT s m a -> ParserT s m b -> ParserT s m [a]+till1 p end = (:) <$> p <*> till p end

@@ -4,8 +4,6 @@   ReaderT (     ReaderT   ),--  -- * Runner   runReaderT,    -- * Operations@@ -45,9 +43,7 @@   (>>=),  ) -{-- - Type- -}+-- Type  -- | A transformer with read-only /r/, inner monad /m/, return /a/ newtype ReaderT r m a = ReaderT@@ -78,9 +74,7 @@ instance (MonadIO m) => MonadIO (ReaderT r m) where   liftIO = lift . liftIO -{-- - Operations- -}+-- Operations  -- | Fetch the read-only environment ask :: (Monad m) => ReaderT r m r

@@ -6,8 +6,6 @@   StateT (     StateT   ),--  -- * Runner   runStateT,    -- * Operations@@ -50,9 +48,7 @@   (>>=),  ) -{-- - Type- -}+-- Type  -- | A transformer with state /s/, inner monad /m/, return /a/ newtype StateT s m a = StateT@@ -83,9 +79,7 @@ instance (MonadIO m) => MonadIO (StateT s m) where   liftIO = lift . liftIO -{-- - Operations- -}+-- Operations  -- | Fetch the current state get :: (Monad m) => StateT s m s

@@ -6,8 +6,6 @@   WriterT (     WriterT   ),--  -- * Runner   runWriterT,    -- * Operations@@ -48,9 +46,7 @@   (>>=),  ) -{-- - Type- -}+-- Type  -- | A transformer with monoidal write-only /w/, inner monad /m/, return /a/ newtype WriterT w m a = WriterT@@ -84,9 +80,7 @@ instance (MonadIO m, Monoid w) => MonadIO (WriterT w m) where   liftIO = lift . liftIO -{-- - Operations- -}+-- Operations  -- | Append a value to the write-only environment tell :: (Monad m) => w -> WriterT w m ()

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               mini-version:            1.5.5.2+version:            1.6.0.0 license:            MIT license-file:       LICENSE author:             Victor Wallsten <victor.wallsten@protonmail.com>@@ -16,19 +16,7 @@    Easily navigable code base, keeping indirection and clutter to a minimum. category:           library-tested-with:-  , GHC == 9.12.1-  , GHC == 9.10.1-  , GHC == 9.8.4-  , GHC == 9.8.2-  , GHC == 9.8.1-  , GHC == 9.6.6-  , GHC == 9.6.5-  , GHC == 9.6.1-  , GHC == 9.4.8-  , GHC == 9.4.1-  , GHC == 9.2.8-  , GHC == 9.2.1+tested-with:        GHC == 9.6.7 extra-doc-files:    CHANGELOG.md extra-source-files: .editorconfig                     .hlint.yaml@@ -48,11 +36,11 @@     Mini.Optics.Lens     Mini.Transformers.Class     Mini.Transformers.EitherT+    Mini.Transformers.MaybeT+    Mini.Transformers.ParserT     Mini.Transformers.ReaderT-    Mini.Transformers.WriterT     Mini.Transformers.StateT-    Mini.Transformers.ParserT-    Mini.Transformers.MaybeT+    Mini.Transformers.WriterT   build-depends:     base >= 4.16 && < 4.22   default-language: