mini 1.7.0.0 → 2.0.0.0

raw patch · 26 files changed

+1508/−1859 lines, 26 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +202/−185
• fourmolu.yaml +1/−1
• mini.cabal +7/−7
• src/Mini/Data/Array.hs +10/−12
• src/Mini/Data/Graph.hs +147/−166
• src/Mini/Data/Map.hs +171/−437
• src/Mini/Data/Set.hs +99/−238
• src/Mini/Hash/Class.hs +7/−0
• src/Mini/Hash/Murmur32.hs +5/−7
• src/Mini/Linear/Matrix.hs +2/−2
• src/Mini/Linear/Quaternion.hs +8/−0
• src/Mini/Random/Class.hs +0/−15
• src/Mini/Random/SplitMix.hs +23/−28
• src/Mini/Transformers/Class.hs +5/−6
• src/Mini/Transformers/Either.hs +115/−0
• src/Mini/Transformers/EitherT.hs +0/−102
• src/Mini/Transformers/Maybe.hs +113/−0
• src/Mini/Transformers/MaybeT.hs +0/−100
• src/Mini/Transformers/Parser.hs +302/−0
• src/Mini/Transformers/ParserT.hs +0/−292
• src/Mini/Transformers/Reader.hs +95/−0
• src/Mini/Transformers/ReaderT.hs +0/−85
• src/Mini/Transformers/State.hs +101/−0
• src/Mini/Transformers/StateT.hs +0/−91
• src/Mini/Transformers/Writer.hs +95/−0
• src/Mini/Transformers/WriterT.hs +0/−85

@@ -1,275 +1,292 @@+Commit log filtered for feature changes and bug fixes++```+(!) Breaking change+```++2.0.0.0 [2026-08-01]+--------------------+```+    data: Add 'Hashable' instances+    transformers: Add 'Random' instances+(!) transformers: Rename modules sans ending 'T'+(!) linear(quaternion): Add fixity to operators+(!) linear(matrix): Change fixity of '(^*#)'+(!) linear(matrix): Change fixity of '(#*^)'+(!) data(graph): Change return type of 'outdegrees'+(!) data(graph): Change return type of 'indegrees'+(!) data(graph): Remove all 'lookup' variants+    data(graph): Add 'outgoing'+    data(graph): Add 'incoming'+    data(graph): Add 'split'+    data(graph): Add 'partition'+(!) data(graph): Remove 'assocs'+(!) data(graph): Change 'Show' implementation+    data(graph): Add 'filter'+(!) data(graph): Change parameter type of 'disconnect'+(!) data(graph): Change parameter type of 'connect'+(!) data(graph): Change parameter type of 'fromList'+(!) data(graph): Change return type of 'reachable'+(!) data(graph): Replace 'layers' with 'bfs'+(!) data(graph): Remove 'empty'+(!) data(map): Rename 'isSubmapOf{,By}' 'submap{,By}'+(!) data(map): Rename 'partitionWith' sans With+(!) data(map): Rename 'filterWith' sans With+(!) data(map): Rename 'update{,Max,Min}With' sans With+(!) data(map): Rename 'adjust{,Max,Min}With' sans With+(!) data(map): Rename '*WithKey' to '*With'+    data(map): Disable membership check in 'delete'+(!) data(map): Remove 'unions{,With,WithKey}'+(!) data(map): Require 'Ord' keys for construction+(!) data(map): Remove 'empty'+(!) data(map): Remove 'null'+(!) data(map): Remove 'size'+(!) data(map): Remove 'valid'+(!) data(map): Remove unsafe constructors+(!) data(set): Rename 'isSubsetOf' to 'subset'+    data(set): Disable membership check in 'insert'+    data(set): Disable membership check in 'delete'+(!) data(set): Remove 'unions'+(!) data(set): Require 'Ord' elements for construction+(!) data(set): Remove 'empty'+(!) data(set): Remove 'null'+(!) data(set): Remove 'size'+(!) data(set): Remove 'valid'+(!) data(set): Remove unsafe constructors+(!) data(array): Remove 'numElements'+(!) random(splitmix): Prune operations+```+ 1.7.0.0 [2026-07-21] ---------------------* Mini.Transformers.MaybeT: Replace 'anticipate' with 'maybeT'-* Mini.Transformers.EitherT: Replace 'anticipate' with 'eitherT'-* Hash.Class: Add class 'Hash'-  * Rework Murmur32 for the new Hash class+```+(!) Rework Murmur32 for the new Hash class+    hash(class): Add class 'Hash'+(!) transformers(either): Replace 'anticipate' with 'eitherT'+(!) transformers(maybe): Replace 'anticipate' with 'maybeT'+``` -1.6.5.0 [2026-07-20]+1.6.5.0 [2026-07-21] ---------------------* Mini.Transformers.MaybeT: Add 'just'-* Mini.Transformers.EitherT: Add 'right'+```+    transformers(either): Add 'right'+    transformers(maybe): Add 'just'+```  1.6.4.0 [2026-07-08] ---------------------* Create Mini.Linear: Linear algebra-  * .Approx: Checking for approximate equality-  * .Matrix: Matrix operations-  * .Quaternion: Quaternion transforms-  * .Space: Vector spaces-  * .Transform2D: Two-dimensional affine transforms-  * .Transform3D: Three-dimensional affine transforms-  * .Vector: Vector operations+```+    Create Mini.Linear.Quaternion+    Create Mini.Linear.Transform3D+    Create Mini.Linear.Transform2D+    Create Mini.Linear.Matrix+    Create Mini.Linear.Vector+    Create Mini.Linear.Space+    Create Mini.Linear.Approx+```  1.6.3.0 [2026-05-02] ---------------------* Create Mini.Random.SplitMix: An implementation of SplitMix, based on-  <https://doi.org/10.1145/2660193.2660195>-* Mini.Random.Class:-  * Add class Splittable: The class of splittable generators-  * Add instance Generator SplitMix-  * Add instance Splittable SplitMix+```+    random(class): Add instance Splittable SplitMix+    random(class): Add class Splittable+    random(class): Add instance Generator SplitMix+    Create Mini.Random.SplitMix+```  1.6.2.0 [2026-05-01] ---------------------* Create Mini.Random.Class: A pure interface for pseudorandom value generation+```+    Create Mini.Random.Class+```  1.6.1.0 [2026-02-10] ---------------------* Create Mini.Hash.Class: The class of hashable types-* Create Mini.Hash.Murmur32: An implementation of MurmurHash3_x86_32 supporting-  incremental addition+```+    Create Mini.Hash.Murmur32+    Create Mini.Hash.Class+```  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+```+(!) data(recursion): Prune re-exports+    transformers(parser): Add parser 'look'+    transformers(parser): Add combinator 'range'+    transformers(parser): Add combinator 'atMost'+    transformers(parser): Add combinator 'atLeast'+(!) transformers(either): Relax constraints+(!) transformers(maybe): Relax constraints+(!) transformers(parser): Simplify Either to Maybe+```  1.5.5.2 [2025-01-27] ---------------------* Reorder pattern matching for performance  1.5.5.1 [2025-01-20] ---------------------* Fix lower bound 'base' version+```+(!) package: Fix lower bound 'base' version+```  1.5.5.0 [2025-01-20] ---------------------* Create Mini.Data.Recursion: Primitive recursive-  functions on various data structures+```+    Create Mini.Data.Recursion+```  1.5.4.0 [2025-01-18] ---------------------* Mini.Data.Map:-  * Add:-    * 'fromDistinct{Asc,Desc}List'-    * 'from{Asc,Desc}List{,With,WithKey}'-  * Major improvements to:-    * 'filter{,WithKey}'-    * 'partition{,WithKey}'-    * 'split'-  * Minor improvements to:-    * 'compose'-    * 'difference'-    * 'differenceWithKey'-    * 'intersectionWithKey'-    * 'unionWithKey'-    * 'delete{Max,Min}'-    * 'update{,Max,Min}WithKey'-    * 'split{Max,Min}'-    * 'disjoint'-    * 'isSubmapOfBy'-* Mini.Data.Set:-  * Add:-    * 'from{Distinct,}{Asc,Desc}List'-  * Major improvements to:-    * 'filter'-    * 'partition'-    * 'split'-  * Minor improvements to:-    * 'difference'-    * 'intersection'-    * 'union'-    * 'delete{Max,Min}'-    * 'split{Max,Min}'-    * 'disjoint'-    * 'isSubsetOf'+```+    data(set): Add 'from{Distinct,}{Asc,Desc}List'+    data(map): Add 'from{Asc,Desc}List{,With,WithKey}'+    data(map): Add 'fromDistinct{Asc,Desc}List'+```  1.5.3.0 [2025-01-09] ---------------------* Mini.Transformers.ParserT:-  * Add combinator 'till1'-  * Add combinator 'findAll'-  * Add combinator 'findAll1'+```+    transformers(parser): Add combinator 'findAll1'+    transformers(parser): Add combinator 'findAll'+    transformers(parser): Add combinator 'till1'+```  1.5.2.0 [2025-01-08] ---------------------* Mini.Data.Map:-  * Improve 'insertWith', 'insertWithKey'-* Create Mini.Data.Array-  * a curated re-export of "GHC.Arr"-* Create Mini.Data.Graph-  * directed edges-  * user-friendly interface (sacrificing some performance):-    * similar to Mini.Data.Map with simple construction, composable-      modification, and plenty of query functions (with more to come)-  * algorithms (more to come):-    * 'distance': Shortest distance between vertices-    * 'layers': Breadth-first search from a starting vertex-    * 'path': Check whether a path exists between vertices-    * 'reachable': Reachable vertices from a starting vertex-    * 'sort': Topological sort+```+    Create Mini.Data.Graph+    Create Mini.Data.Array+```  1.5.1.0 [2024-12-26] ---------------------* Add to Mini.Data.Set:-  * 'unions'-  * 'deleteMax', 'deleteMin'-  * 'partition'-  * 'split', 'splitMax', 'splitMin'-  * 'disjoint'-* Add to Mini.Data.Map:-  * 'compose'-  * 'differenceWith', 'differenceWithKey'-  * 'intersectionWith', 'intersectionWithKey'-  * 'unionWith', 'unionWithKey'-  * 'unions', 'unionsWith', 'unionsWithKey'-  * 'adjustWithKey'-  * 'adjustMax', 'adjustMaxWithKey'-  * 'adjustMin', 'adjustMinWithKey'-  * 'deleteMax', 'deleteMin'-  * 'updateWithKey'-  * 'updateMax', 'updateMaxWithKey'-  * 'updateMin', 'updateMinWithKey'-  * 'disjoint'-  * 'isSubmapOfBy'-  * 'fmapWithKey'-  * 'partition', 'partitionWithKey'-  * 'split', 'splitMax', 'splitMin'-* Update Mini.Data.Map examples+```+    data(map): Add 'split', 'splitMax', 'splitMin'+    data(map): Add 'partition', 'partitionWithKey'+    data(map): Add 'update{Max,Min}{,WithKey}'+    data(map): Add 'fmapWithKey'+    data(map): Add 'isSubmapOfBy'+    data(map): Add 'disjoint'+    data(map): Add 'updateWithKey'+    data(map): Add 'deleteMax', 'deleteMin'+    data(map): Add 'adjust{Max,Min}{,WithKey}'+    data(map): Add 'adjustWithKey'+    data(map): Add 'unions{,With,Key}'+    data(map): Add 'unionWith', 'unionWithKey'+    data(map): Add 'intersection{With,WithKey}'+    data(map): Add 'difference{With,WithKey}'+    data(map): Add 'compose'+    data(set): Add 'disjoint'+    data(set): Add 'split', 'splitMax', 'splitMin'+    data(set): Add 'partition'+    data(set): Add 'deleteMax', 'deleteMin'+    data(set): Add 'unions'+``` -1.5.0.0 [2024-12-23]+1.5.0.0 [2024-12-25] ---------------------* Mini.Data.{Map,Set}:-  * Simplify 'show'-  * Fix element processing order of folds-* Mini.Transformers.ParserT:-  * Add combinator 'annotate'+```+    transformers(parser): Add combinator 'annotate'+(!) data: Simplify 'show'+(!) data: Fix element processing order of folds+```  1.4.3.0 [2024-12-08] ---------------------* All transformers now instantiate:-  * MonadFail-  * MonadIO+```+    transformers: Add MonadIO instances+    transformers: Add MonadFail instances+```  1.4.2.0 [2024-12-07] ---------------------* Mini.Data.Set:-  * Add 'lookup{GE,GT,LE,LT}' functions-* Mini.Data.Map:-  * Add 'lookup{GE,GT,LE,LT}' functions-  * Add 'insertWith', 'insertWithKey'-  * Add 'fromListWith', 'fromListWithKey'-* Mini.Transformers.ParserT:-  * Add combinators 'findFirst', 'findLast'-  * Fix '<|>' failure message propagation-* Documentation:-  * Fix time complexity-  * Add examples for 'insertWith', 'insertWithKey'-  * Add examples for 'fromListWith', 'fromListWithKey'-  * Update package description+```+(!) transformers(parser): Fix '<|>' errmsg propagation+    transformers(parser): Add 'findFirst', 'findLast'+    data(map): Add 'fromListWith', 'fromListWithKey'+    data(map): Add 'insertWith', 'insertWithKey'+    data: Add lookup{GE,GT,LE,LT} functions+(!) package: Fix lower bound 'base' version+```  1.4.1.0 [2024-11-01] ---------------------* Mini.Data.Set: Add Semigroup/Monoid instances+```+    data(set): Add Semigroup/Monoid instances+(!) data: Instantiate Eq/Ord manually+```  1.4.0.2 [2024-10-29] ---------------------* Mini.Data.Map:-  * Fix 'lookupMax' and 'lookupMin' (now fetch entire bin)-  * docs: Add examples section+```+(!) data(map): Fix 'lookupMin' to fetch entire bin+(!) data(map): Fix 'lookupMax' to fetch entire bin+```  1.4.0.1 [2024-10-27] ---------------------* docs: Add 'Mini.Optics.Lens' tutorial  1.4.0.0 [2024-07-01] ---------------------* Mini.Transformers.ParserT:-  * Prune parser combinators 'endBy', 'endBy1'-  * Add parser 'peek'-  * Add parser combinator 'till'-  * Clarify 'chainl1', 'chainr1' haddockumentation-* Add build flags for explicit imports-* Streamline imports+```+    transformers(parser): Add combinator 'till'+    transformers(parser): Add parser 'peek'+(!) transformers(parser): Prune+```  1.3.0.1 [2024-04-14] ---------------------* Streamline data documentation  1.3.0.0 [2024-03-28] ---------------------* Mini.Transformers.ParserT:-  * Simplify and expose ParseError:-    * Now a wrapper for {unexpected :: String}-  * Prune redundant combinator 'chainl'-  * Prune redundant combinator 'chainr'-* docs: Remove code-cluttering examples-  * Future work: separate 'examples' sections+```+(!) transformers(parser): Prune+(!) transformers(parser): Simplify parse errors+```  1.2.2.1 [2024-03-20] ---------------------* docs: Add parser examples  1.2.2.0 [2024-03-20] ---------------------* Mini.Transformers.ParserT:-  * Add combinator 'reject'-  * Add combinator 'accept'+```+    transformers(parser): Add combinator 'accept'+    transformers(parser): Add combinator 'reject'+```  1.2.1.0 [2024-03-16] ---------------------* Add Mini.Transformers.ReaderT.local+```+    transformers(reader): Add function 'local'+```  1.2.0.0 [2024-03-15] ---------------------* Mini.Transformers.ParserT:-  * Simplify parse errors+```+(!) transformers(parser): Simplify parse errors+```  1.1.1.0 [2024-03-14] ---------------------* Mini.Transformers.ParserT:-  * Add MonadFail instance-  * Add end-of-file parser-  * Add chain combinators+```+    transformers(parser): Add chain combinators+    transformers(parser): Add end-of-file parser+    transformers(parser): Add monadfail instance+```  1.1.0.0 [2024-03-11] ---------------------* Conventionalise module naming: package.section.title-  * Mini.Lens -> Mini.Optics.Lens-* Streamline optics documentation+```+(!) Harmonise module names to package.section.title+```  1.0.1.0 [2024-03-10] ---------------------* Export transformers newtype constructors-* Add Semigroup and Monoid instances to ParserT-* Streamline transformers documentation-* Create Mini.Transformers.MaybeT+```+    transformers: Create maybe transformer+    transformers(parser): Add semigroup, monoid+    transformers: Export newtype constructors+```  1.0.0.0 [2024-03-07] ---------------------* Fix Mini.Data.Map.insert-* Fix Mini.Data.Set.insert--0.1.0.0 [2024-03-07]----------------------* Initial upload to Hackage

@@ -6,7 +6,7 @@ indent-wheres: false record-brace-space: false newlines-between-decls: 1-haddock-style: multi-line+haddock-style: single-line haddock-style-module: null let-style: inline in-style: right-align

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               mini-version:            1.7.0.0+version:            2.0.0.0 license:            MIT license-file:       LICENSE author:             Victor Wallsten <victor.wallsten@protonmail.com>@@ -48,12 +48,12 @@     Mini.Random.Class     Mini.Random.SplitMix     Mini.Transformers.Class-    Mini.Transformers.EitherT-    Mini.Transformers.MaybeT-    Mini.Transformers.ParserT-    Mini.Transformers.ReaderT-    Mini.Transformers.StateT-    Mini.Transformers.WriterT+    Mini.Transformers.Either+    Mini.Transformers.Maybe+    Mini.Transformers.Parser+    Mini.Transformers.Reader+    Mini.Transformers.State+    Mini.Transformers.Writer   build-depends:     base >= 4.16 && < 4.22   default-language:

@@ -3,16 +3,6 @@   -- * Type   Array, -  -- * Class-  Ix (-    inRange,-    index,-    range,-    rangeSize,-    unsafeIndex,-    unsafeRangeSize-  ),-   -- * Construction   accumArray,   array,@@ -32,7 +22,16 @@   (!),   (!?),   bounds,-  numElements,++  -- * Class+  Ix (+    inRange,+    index,+    range,+    rangeSize,+    unsafeIndex,+    unsafeRangeSize+  ), ) where  import Data.Bool (@@ -57,7 +56,6 @@   indices,   ixmap,   listArray,-  numElements,   unsafeAt,   (!),   (//),

@@ -5,14 +5,13 @@   graph,    -- * Algorithms+  bfs,   distance,-  layers,   path,   reachable,   sort,    -- * Construction-  empty,   fromList,   singleton, @@ -20,24 +19,23 @@   add,   connect,   disconnect,+  filter,   remove,   transpose, +  -- * Partition+  partition,+  split,+   -- * Query-  assocs,   edges,+  incoming,   indegree,   indegrees,-  lookup,-  lookupGE,-  lookupGT,-  lookupLE,-  lookupLT,-  lookupMax,-  lookupMin,   member,   outdegree,   outdegrees,+  outgoing,   sinkMax,   sinkMin,   sinks,@@ -47,8 +45,8 @@   vertices, ) where -import Data.Bifunctor (-  second,+import Data.Foldable (+  fold,  ) import Data.List (   unfoldr,@@ -58,20 +56,15 @@  ) import qualified Mini.Data.Map as Map (   delete,-  empty,-  foldlWithKey,-  foldrWithKey,+  filter,+  foldlWith,+  foldrWith,   insertWith,   lookup,-  lookupGE,-  lookupGT,-  lookupLE,-  lookupLT,-  lookupMax,-  lookupMin,   member,+  partition,   singleton,-  toAscList,+  split,   unionWith,  ) import Mini.Data.Recursion (@@ -85,14 +78,14 @@ import qualified Mini.Data.Set as Set (   delete,   difference,-  empty,-  fromList,+  filter,   member,-  null,   singleton,-  size,-  toAscList,  )+import Mini.Hash.Class (+  Hashable,+  toBytes,+ ) import Prelude (   Bool,   Eq,@@ -108,13 +101,14 @@   Show,   any,   compare,-  concat,+  concatMap,+  const,   flip,-  fmap,   foldMap,   foldr,-  fst,+  length,   mempty,+  null,   show,   ($),   (+),@@ -139,7 +133,7 @@   compare (Graph _ oes1) (Graph _ oes2) = compare oes1 oes2  instance (Show a) => Show (Graph a) where-  show = show . assocs+  show = show . edges  instance Foldable Graph where   foldr f b = foldr f b . vertices@@ -147,16 +141,19 @@ instance (Ord a) => Semigroup (Graph a) where   (Graph ies1 oes1) <> (Graph ies2 oes2) =     Graph-      (Map.unionWith (<>) ies1 ies2)-      (Map.unionWith (<>) oes1 oes2)+      (Map.unionWith (const (<>)) ies1 ies2)+      (Map.unionWith (const (<>)) oes1 oes2)  instance (Ord a) => Monoid (Graph a) where-  mempty = empty+  mempty = Graph mempty mempty --- | Primitive recursion on graphs (internally represented by adjacency lists)+instance (Hashable a) => Hashable (Graph a) where+  toBytes = concatMap toBytes++-- | Primitive recursion on graphs (internally represented by adjacency maps) graph   :: (Map a (Set a) -> Map a (Set a) -> b)-  -- ^ Function applied to the adjacency lists of the graph:+  -- ^ Function applied to the adjacency maps of the graph:   -- incoming edges, outgoing edges   -> Graph a   -- ^ The graph@@ -165,6 +162,42 @@  -- Algorithms +-- | Breadth-first search for the hierarchy in a graph from a starting vertex+bfs :: (Ord a) => Graph a -> a -> [Set a]+bfs (Graph _ oes) s =+  foldMap+    ( \vs ->+        Set.singleton s+          : unfoldr+            ( \((us, es), ds) ->+                bool+                  ( Just+                      ( us+                      ,+                        ( foldr+                            ( \u b@(us', es') ->+                                maybe+                                  b+                                  ( \vs' ->+                                      ( (us' <> vs') `Set.difference` ds+                                      , Map.delete u es'+                                      )+                                  )+                                  $ Map.lookup u es+                            )+                            (mempty, es)+                            us+                        , ds <> us+                        )+                      )+                  )+                  Nothing+                  $ null us+            )+            ((vs, oes), Set.singleton s)+    )+    $ Map.lookup s oes+ -- | Get the shortest distance in a graph between a vertex and another distance :: (Ord a) => Graph a -> a -> a -> Maybe Int distance g s t =@@ -173,17 +206,13 @@     Nothing     $ bfs g s --- | Breadth-first search for the hierarchy in a graph from a starting vertex-layers :: (Ord a) => Graph a -> a -> [[a]]-layers g = fmap Set.toAscList . bfs g- -- | Check whether there is a path in a graph from a vertex to another path :: (Ord a) => Graph a -> a -> a -> Bool path g s t = any (t `Set.member`) $ bfs g s  -- | Get the reachable vertices in a graph from a starting vertex-reachable :: (Ord a) => Graph a -> a -> [a]-reachable g = concat . layers g+reachable :: (Ord a) => Graph a -> a -> Set a+reachable g = fold . bfs g  -- | Topologically sort a graph (assumes acyclicity) sort :: (Ord a) => Graph a -> [a]@@ -191,51 +220,49 @@  -- Construction --- | The empty graph-empty :: Graph a-empty = Graph Map.empty Map.empty---- | Make a graph from a list of vertex associations-fromList :: (Ord a) => [(a, [a])] -> Graph a-fromList = foldr (uncurry connect) empty+-- | Make a graph from a list of edges+fromList :: (Ord a) => [(a, a)] -> Graph a+fromList = foldr (uncurry connect) mempty  -- | Make a graph with an isolated vertex-singleton :: a -> Graph a-singleton u = Graph (Map.singleton u Set.empty) (Map.singleton u Set.empty)+singleton :: (Ord a) => a -> Graph a+singleton u = Graph (Map.singleton u mempty) (Map.singleton u mempty)  -- Modification  -- | Add an isolated vertex to a graph unless already present add :: (Ord a) => a -> Graph a -> Graph a-add u = connect u []---- | 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) =-  uncurry Graph $-    foldr-      ( \v (ies', oes') ->-          ( Map.insertWith (<>) v (Set.singleton u) ies'-          , Map.insertWith (<>) v Set.empty oes'-          )-      )-      ( Map.insertWith (<>) u Set.empty ies-      , Map.insertWith (<>) u (Set.fromList vs) oes-      )-      vs+add u (Graph ies oes) =+  Graph+    (Map.insertWith (const (<>)) u mempty ies)+    (Map.insertWith (const (<>)) u mempty oes) --- | Remove edges from a vertex to a list of vertices in a graph-disconnect :: (Ord a) => a -> [a] -> Graph a -> Graph a-disconnect u vs (Graph ies oes) =+-- | Add edges from a vertex to another vertex in a graph+connect :: (Ord a) => a -> a -> Graph a -> Graph a+connect u v (Graph ies oes) =   Graph-    ( foldr-        (\v -> Map.insertWith (flip Set.difference) v $ Set.singleton u)-        ies-        vs+    ( Map.insertWith (const (<>)) v (Set.singleton u) $+        Map.insertWith (const (<>)) u mempty ies     )-    (Map.insertWith (flip Set.difference) u (Set.fromList vs) oes)+    ( Map.insertWith (const (<>)) u (Set.singleton v) $+        Map.insertWith (const (<>)) v mempty oes+    ) --- | Remove a vertex and its associations from a graph+-- | Remove an edge from a vertex to another vertex in a graph+disconnect :: (Ord a) => a -> a -> Graph a -> Graph a+disconnect u v (Graph ies oes) =+  Graph+    (Map.insertWith (const $ flip Set.difference) v (Set.singleton u) ies)+    (Map.insertWith (const $ flip Set.difference) u (Set.singleton v) oes)++-- | Keep the vertices that satisfy a predicate in a graph+filter :: (Ord a) => (a -> Bool) -> Graph a -> Graph a+filter p (Graph ies oes) =+  Graph+    (Set.filter p <$> Map.filter (const . p) ies)+    (Set.filter p <$> Map.filter (const . p) oes)++-- | Remove a vertex and its edges from a graph remove :: (Ord a) => a -> Graph a -> Graph a remove u (Graph ies oes) =   Graph@@ -246,55 +273,43 @@ transpose :: Graph a -> Graph a transpose (Graph ies oes) = Graph oes ies --- Query+-- Partition --- | Get the vertex associations of a graph-assocs :: Graph a -> [(a, [a])]-assocs (Graph _ oes) = second Set.toAscList <$> Map.toAscList oes+-- | Partition a graph with a predicate into @(true, false)@ subgraphs+partition :: (Ord a) => (a -> Bool) -> Graph a -> (Graph a, Graph a)+partition p (Graph ies oes) =+  let (ies1, ies2) = Map.partition (const . p) ies+      (oes1, oes2) = Map.partition (const . p) oes+   in (Graph ies1 oes1, Graph ies2 oes2) +-- | Split a graph by a vertex into @(lt, eq, gt)@ subgraphs+split :: (Ord a) => a -> Graph a -> (Graph a, Maybe a, Graph a)+split v (Graph ies oes) =+  let (lti, _, gti) = Map.split v ies+      (lto, _, gto) = Map.split v oes+   in (Graph lti lto, bool Nothing (Just v) $ v `Map.member` oes, Graph gti gto)++-- Query+ -- | Get the edges of a graph edges :: Graph a -> [(a, a)] edges (Graph _ oes) =-  Map.foldrWithKey+  Map.foldrWith     (\u -> flip $ foldr (\v -> (:) (u, v)))     []     oes +-- | Get the incoming edges of each vertex in a graph+incoming :: Graph a -> Map a (Set a)+incoming (Graph ies _) = ies+ -- | 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+indegree v (Graph ies _) = length <$> Map.lookup v ies  -- | Get the number of incoming edges of each vertex in a graph-indegrees :: Graph a -> [(a, Int)]-indegrees (Graph ies _) = Map.toAscList $ Set.size <$> ies---- | 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---- | Get the associations of the least vertex greater than or equal to a vertex-lookupGE :: (Ord a) => a -> Graph a -> Maybe (a, [a])-lookupGE a (Graph _ oes) = second Set.toAscList <$> Map.lookupGE a oes---- | Get the associations of the least vertex strictly greater than a vertex-lookupGT :: (Ord a) => a -> Graph a -> Maybe (a, [a])-lookupGT a (Graph _ oes) = second Set.toAscList <$> Map.lookupGT a oes---- | Get the associations of the greatest vertex less than or equal to a vertex-lookupLE :: (Ord a) => a -> Graph a -> Maybe (a, [a])-lookupLE a (Graph _ oes) = second Set.toAscList <$> Map.lookupLE a oes---- | Get the associations of the greatest vertex strictly less than a vertex-lookupLT :: (Ord a) => a -> Graph a -> Maybe (a, [a])-lookupLT a (Graph _ oes) = second Set.toAscList <$> Map.lookupLT a oes---- | Get the associations of the maximum vertex from a graph-lookupMax :: Graph a -> Maybe (a, [a])-lookupMax (Graph _ oes) = second Set.toAscList <$> Map.lookupMax oes---- | Get the associations of the minimum vertex from a graph-lookupMin :: Graph a -> Maybe (a, [a])-lookupMin (Graph _ oes) = second Set.toAscList <$> Map.lookupMin oes+indegrees :: Graph a -> Map a Int+indegrees (Graph ies _) = length <$> ies  -- | Check whether a vertex is in a graph member :: (Ord a) => a -> Graph a -> Bool@@ -302,21 +317,25 @@  -- | 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+outdegree u (Graph _ oes) = length <$> 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+outdegrees :: Graph a -> Map a Int+outdegrees (Graph _ oes) = length <$> oes +-- | Get the outgoing edges of each vertex in a graph+outgoing :: Graph a -> Map a (Set a)+outgoing (Graph _ oes) = oes+ -- | Get the maximum vertex with no outgoing edges from a graph sinkMax :: Graph a -> Maybe a sinkMax (Graph _ oes) =-  Map.foldlWithKey+  Map.foldlWith     ( \b k ->         bool           b           (Just k)-          . Set.null+          . null     )     Nothing     oes@@ -324,12 +343,12 @@ -- | Get the minimum vertex with no outgoing edges from a graph sinkMin :: Graph a -> Maybe a sinkMin (Graph _ oes) =-  Map.foldrWithKey+  Map.foldrWith     ( \k a b ->         bool           b           (Just k)-          $ Set.null a+          $ null a     )     Nothing     oes@@ -337,12 +356,12 @@ -- | Get the vertices with no outgoing edges from a graph sinks :: Graph a -> [a] sinks (Graph _ oes) =-  Map.foldrWithKey+  Map.foldrWith     ( \k a b ->         bool           b           (k : b)-          $ Set.null a+          $ null a     )     []     oes@@ -350,12 +369,12 @@ -- | Get the maximum vertex with no incoming edges from a graph sourceMax :: Graph a -> Maybe a sourceMax (Graph ies _) =-  Map.foldlWithKey+  Map.foldlWith     ( \b k ->         bool           b           (Just k)-          . Set.null+          . null     )     Nothing     ies@@ -363,12 +382,12 @@ -- | Get the minimum vertex with no incoming edges from a graph sourceMin :: Graph a -> Maybe a sourceMin (Graph ies _) =-  Map.foldrWithKey+  Map.foldrWith     ( \k a b ->         bool           b           (Just k)-          $ Set.null a+          $ null a     )     Nothing     ies@@ -376,54 +395,16 @@ -- | Get the vertices with no incoming edges from a graph sources :: Graph a -> [a] sources (Graph ies _) =-  Map.foldrWithKey+  Map.foldrWith     ( \k a b ->         bool           b           (k : b)-          $ Set.null a+          $ null a     )     []     ies  -- | 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]-bfs (Graph _ oes) s =-  foldMap-    ( \vs ->-        Set.singleton s-          : unfoldr-            ( \((us, es), ds) ->-                bool-                  ( Just-                      ( us-                      ,-                        ( foldr-                            ( \u b@(us', es') ->-                                maybe-                                  b-                                  ( \vs' ->-                                      ( (us' <> vs') `Set.difference` ds-                                      , Map.delete u es'-                                      )-                                  )-                                  $ Map.lookup u es-                            )-                            (Set.empty, es)-                            us-                        , ds <> us-                        )-                      )-                  )-                  Nothing-                  $ Set.null us-            )-            ((vs, oes), Set.singleton s)-    )-    $ Map.lookup s oes+vertices (Graph _ oes) = Map.foldrWith (\k _ -> (:) k) [] oes

@@ -1,6 +1,3 @@--- incomplete patterns in 'fromDistinct{Asc,Desc}List'-{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}- -- | A structure mapping unique keys to values module Mini.Data.Map (   -- * Type@@ -8,101 +5,71 @@   map,    -- * Construction-  empty,-  fromAscList,-  fromAscListWith,-  fromAscListWithKey,-  fromDescList,-  fromDescListWith,-  fromDescListWithKey,-  fromDistinctAscList,-  fromDistinctDescList,   fromList,   fromListWith,-  fromListWithKey,   singleton,    -- * Combination   compose,   difference,   differenceWith,-  differenceWithKey,   intersection,   intersectionWith,-  intersectionWithKey,   union,   unionWith,-  unionWithKey,-  unions,-  unionsWith,-  unionsWithKey,    -- * Conversion   toAscList,   toDescList,    -- * Fold-  foldlWithKey,-  foldrWithKey,+  foldlWith,+  foldrWith, -  -- * Modification-  adjust,+  -- * Max/Min   adjustMax,-  adjustMaxWithKey,   adjustMin,-  adjustMinWithKey,-  adjustWithKey,-  delete,   deleteMax,   deleteMin,+  lookupMax,+  lookupMin,+  splitMax,+  splitMin,+  updateMax,+  updateMin,++  -- * Modification+  adjust,+  delete,   filter,-  filterWithKey,   insert,   insertWith,-  insertWithKey,   update,-  updateMax,-  updateMaxWithKey,-  updateMin,-  updateMinWithKey,-  updateWithKey,    -- * Partition   partition,-  partitionWithKey,   split,-  splitMax,-  splitMin,    -- * Query   disjoint,-  isSubmapOf,-  isSubmapOfBy,   lookup,   lookupGE,   lookupGT,   lookupLE,   lookupLT,-  lookupMax,-  lookupMin,   member,-  null,-  size,+  submap,+  submapBy,    -- * Traversal-  fmapWithKey,-  traverseWithKey,--  -- * Validation-  valid,+  fmapWith,+  traverseWith, ) where  import Control.Applicative (-  liftA2,   (<|>),  ) import Data.Bifunctor (-  bimap,   first,   second,  )@@ -113,9 +80,12 @@   on,  ) import Mini.Data.Recursion (-  list,   ordering,  )+import Mini.Hash.Class (+  Hashable,+  toBytes,+ ) import Prelude (   Applicative,   Bool (@@ -125,7 +95,6 @@   Eq,   Foldable,   Functor,-  Int,   Maybe (     Just,     Nothing@@ -136,37 +105,31 @@   Show,   Traversable,   compare,+  concatMap,   const,-  div,   error,   flip,   fmap,   foldl,   foldr,   fst,-  length,-  max,+  maximum,   maybe,   mempty,+  minimum,   not,+  null,   pure,   show,-  splitAt,   traverse,   uncurry,-  until,   ($),   (&&),-  (*),-  (+),-  (-),   (.),-  (<),   (<$>),   (<*>),   (<>),   (==),-  (>),   (||),  ) @@ -193,20 +156,34 @@   show = show . toAscList  instance Functor (Map k) where-  fmap = fmapWithKey . const+  fmap = fmapWith . const  instance Foldable (Map k) where-  foldr = foldrWithKey . const+  foldr = foldrWith . const+  null = map' True go go go where go _ _ _ _ _ _ = False+  maximum = map' (error "maximum: empty map") go go go+   where+    go _ _ a r _ recr = map' a go' go' go' r+     where+      go' _ _ _ _ _ _ = recr+  minimum = map' (error "minimum: empty map") go go go+   where+    go l _ a _ recl _ = map' a go' go' go' l+     where+      go' _ _ _ _ _ _ = recl  instance Traversable (Map k) where-  traverse = traverseWithKey . const+  traverse = traverseWith . const  instance (Ord k) => Semigroup (Map k a) where   (<>) = union  instance (Ord k) => Monoid (Map k a) where-  mempty = empty+  mempty = E +instance (Hashable a) => Hashable (Map k a) where+  toBytes = concatMap toBytes+ -- | Primitive recursion on maps (internally structured as trees) map   :: b@@ -247,120 +224,48 @@  -- Construction --- | /O(1)/ The empty map-empty :: Map k a-empty = E---- | /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---- | /O(n)/ Make a map from a list of key-sorted pairs, combining matching keys-fromAscListWith :: (Ord k) => (a -> a -> a) -> [(k, a)] -> Map k a-fromAscListWith = fromAscListWithKey . const---- | /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 . essenceWithKey f---- | /O(n)/ Make a map from a tail-biased list of key-sorted pairs-fromDescList :: (Eq k) => [(k, a)] -> Map k a-fromDescList = fromDistinctDescList . essence---- | /O(n)/ Make a map from a list of key-sorted pairs, combining matching keys-fromDescListWith :: (Ord k) => (a -> a -> a) -> [(k, a)] -> Map k a-fromDescListWith = fromDescListWithKey . const---- | /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 . 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 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 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')- -- | /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+fromList = fromListWith $ const 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+fromListWith :: (Ord k) => (k -> a -> a -> a) -> [(k, a)] -> Map k a+fromListWith f = foldl (flip . uncurry $ insertWith f) mempty  -- | /O(1)/ Make a map with a single bin-singleton :: k -> a -> Map k a-singleton k a = B E k a E+singleton :: (Ord k) => k -> a -> Map k a+singleton k a = B mempty k a mempty  -- 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+compose :: (Ord a, Ord b) => Map b c -> Map a b -> Map a c+compose t1 t2 = map' mempty go go go t1  where   go _ _ _ _ _ _ =-    fromDistinctAscList $-      foldrWithKey-        (\a b ac -> maybe ac (\c -> (a, c) : ac) $ lookup b t1)-        []-        t2+    foldrWith+      (\a b ac -> maybe ac (\c -> insert a c ac) $ lookup b t1)+      mempty+      t2  -- | /O(m log n)/ Subtract a map by another via key matching difference :: (Ord k) => Map k a -> Map k b -> Map k a-difference t1 t2 = map' empty go go go t1+difference t1 t2 = map' mempty go go go t1  where-  go _ _ _ _ _ _ = foldrWithKey (\k _ b -> delete k b) t1 t2+  go _ _ _ _ _ _ =+    foldrWith (\k _ b -> bool b (delete k b) $ k `member` b) t1 t2  -- | /O(m log n)/ Subtract a map by another, updating bins of matching keys differenceWith-  :: (Ord k) => (a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a-differenceWith = differenceWithKey . const---- | /O(m log n)/ Subtract a map by another, updating bins of matching keys-differenceWithKey   :: (Ord k) => (k -> a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a-differenceWithKey f t1 t2 = map' empty go go go t1+differenceWith f t1 t2 = map' mempty go go go t1  where   go _ _ _ _ _ _ =-    foldrWithKey+    foldrWith       ( \k b t' ->           maybe             t'-            ( \a ->-                maybe-                  (delete' k t')-                  (\a' -> insert k a' t')-                  $ f k a b-            )+            (\a -> maybe (delete k t') (\a' -> insert k a' t') $ f k a b)             $ lookup k t1       )       t1@@ -368,230 +273,160 @@  -- | /O(n log m)/ Intersect a map with another via left-biased key matching intersection :: (Ord k) => Map k a -> Map k b -> Map k a-intersection = intersectionWithKey $ const const---- | /O(n log m)/ Intersect a map with another by key matching, combining values-intersectionWith :: (Ord k) => (a -> b -> c) -> Map k a -> Map k b -> Map k c-intersectionWith = intersectionWithKey . const+intersection = intersectionWith $ const const  -- | /O(n log m)/ Intersect a map with another by key matching, combining values-intersectionWithKey+intersectionWith   :: (Ord k) => (k -> a -> b -> c) -> Map k a -> Map k b -> Map k c-intersectionWithKey f t1 t2 = map' empty go go go t2+intersectionWith f t1 t2 = map' mempty go go go t2  where   go _ _ _ _ _ _ =-    fromDistinctAscList $-      foldrWithKey-        (\k a c -> maybe c (\b -> (k, f k a b) : c) $ lookup k t2)-        []-        t1+    foldrWith+      (\k a c -> maybe c (\b -> insert k (f k a b) c) $ lookup k t2)+      mempty+      t1  -- | /O(m log n)/ Unite a map with another via left-biased key matching union :: (Ord k) => Map k a -> Map k a -> Map k a-union = unionWithKey $ const const---- | /O(m log n)/ Unite a map with another, combining values of matching keys-unionWith :: (Ord k) => (a -> a -> a) -> Map k a -> Map k a -> Map k a-unionWith = unionWithKey . const+union = unionWith $ const const  -- | /O(m log n)/ Unite a map with another, combining values of matching keys-unionWithKey :: (Ord k) => (k -> a -> a -> a) -> Map k a -> Map k a -> Map k a-unionWithKey f t1 t2 = map' t1 go go go t2+unionWith :: (Ord k) => (k -> a -> a -> a) -> Map k a -> Map k a -> Map k a+unionWith f t1 t2 = map' t1 go go go t2  where-  go _ _ _ _ _ _ = foldrWithKey (insertWithKey f) t2 t1---- | Unite a collection of maps via left-biased key matching-unions :: (Foldable t, Ord k) => t (Map k a) -> Map k a-unions = unionsWithKey $ const const---- | Unite a collection of maps, combining values of matching keys-unionsWith :: (Foldable t, Ord k) => (a -> a -> a) -> t (Map k a) -> Map k a-unionsWith = unionsWithKey . const---- | Unite a collection of maps, combining values of matching keys-unionsWithKey :: (Foldable t, Ord k) => (k -> a -> a -> a) -> t (Map k a) -> Map k a-unionsWithKey f = foldr (unionWithKey f) empty+  go _ _ _ _ _ _ = foldrWith (insertWith f) t2 t1  -- Conversion  -- | /O(n)/ Turn a map into a list of @(key, value)@ pairs in ascending order toAscList :: Map k a -> [(k, a)]-toAscList = foldrWithKey (\k a b -> (k, a) : b) []+toAscList = foldrWith (\k a b -> (k, a) : b) []  -- | /O(n)/ Turn a map into a list of @(key, value)@ pairs in descending order toDescList :: Map k a -> [(k, a)]-toDescList = foldlWithKey (\b k a -> (k, a) : b) []+toDescList = foldlWith (\b k a -> (k, a) : b) []  -- Fold  -- | /O(n)/ Reduce a map with a left-associative operation and an accumulator-foldlWithKey :: (b -> k -> a -> b) -> b -> Map k a -> b-foldlWithKey f b = map' b go go go+foldlWith :: (b -> k -> a -> b) -> b -> Map k a -> b+foldlWith f b = map' b go go go  where-  go _ k a r recl _ = foldlWithKey f (f recl k a) r+  go _ k a r recl _ = foldlWith f (f recl k a) r  -- | /O(n)/ Reduce a map with a right-associative operation and an accumulator-foldrWithKey :: (k -> a -> b -> b) -> b -> Map k a -> b-foldrWithKey f b = map' b go go go+foldrWith :: (k -> a -> b -> b) -> b -> Map k a -> b+foldrWith f b = map' b go go go  where-  go l k a _ _ recr = foldrWithKey f (f k a recr) l---- 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+  go l k a _ _ recr = foldrWith f (f k a recr) l --- | /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+-- Max/Min  -- | /O(log n)/ Adjust with an operation the value of the maximum key in a map-adjustMaxWithKey :: (k -> a -> a) -> Map k a -> Map k a-adjustMaxWithKey f = map' E (go L) (go B) (go R)+adjustMax :: (k -> a -> a) -> Map k a -> Map k a+adjustMax f = map' E (go L) (go B) (go R)  where   go c l k a r _ recr = map' (c l k (f k a) r) go' go' go' r    where     go' _ _ _ _ _ _ = c l k a recr  -- | /O(log n)/ Adjust with an operation the value of the minimum key in a map-adjustMin :: (a -> a) -> Map k a -> Map k a-adjustMin = adjustMinWithKey . const---- | /O(log n)/ Adjust with an operation the value of the minimum key in a map-adjustMinWithKey :: (k -> a -> a) -> Map k a -> Map k a-adjustMinWithKey f = map' E (go L) (go B) (go R)+adjustMin :: (k -> a -> a) -> Map k a -> Map k a+adjustMin f = map' E (go L) (go B) (go R)  where   go c l k a r recl _ = map' (c l k (f k a) r) go' go' go' l    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- -- | /O(log n)/ Delete the maximum key from a map deleteMax :: (Ord k) => Map k a -> Map k a-deleteMax t = maybe t (flip delete' t . fst) $ lookupMax t+deleteMax t = maybe t (flip delete t . fst) $ lookupMax t  -- | /O(log n)/ Delete the minimum key from a map deleteMin :: (Ord k) => Map k a -> Map k a-deleteMin t = maybe t (flip delete' t . fst) $ lookupMin t---- | /O(n)/ Keep the bins whose values satisfy a predicate-filter :: (a -> Bool) -> Map k a -> Map k a-filter = filterWithKey . const---- | /O(n)/ Keep the bins whose keys and values satisfy a predicate-filterWithKey :: (k -> a -> Bool) -> Map k a -> Map k a-filterWithKey p =-  fromDistinctAscList-    . foldrWithKey (\k a b -> bool b ((k, a) : b) $ p k a) []+deleteMin t = maybe t (flip delete t . fst) $ lookupMin t --- | /O(log n)/ Insert a key and its value into a map, overwriting if present-insert :: (Ord k) => k -> a -> Map k a -> Map k a-insert = insertWithKey $ const const+-- | /O(log n)/ Fetch the bin with the maximum key+lookupMax :: Map k a -> Maybe (k, a)+lookupMax = map' Nothing go go go+ where+  go _ k a r _ recr = map' (Just (k, a)) go' go' go' r+   where+    go' _ _ _ _ _ _ = recr --- | /O(log n)/ Insert a key and its value, combining new and old if present-insertWith :: (Ord k) => (a -> a -> a) -> k -> a -> Map k a -> Map k a-insertWith = insertWithKey . const+-- | /O(log n)/ Fetch the bin with the minimum key+lookupMin :: Map k a -> Maybe (k, a)+lookupMin = map' Nothing go go go+ where+  go l k a _ recl _ = map' (Just (k, a)) go' go' go' l+   where+    go' _ _ _ _ _ _ = recl --- | /O(log n)/ Modify the value of a key or delete its bin with an operation-update :: (Ord k) => (a -> Maybe a) -> k -> Map k a -> Map k a-update = updateWithKey . const+-- | /O(log n)/ Split a map by its maximum key+splitMax :: (Ord k) => Map k a -> Maybe ((k, a), Map k a)+splitMax t = ((,) <*> flip delete t . fst) <$> lookupMax 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+-- | /O(log n)/ Split a map by its minimum key+splitMin :: (Ord k) => Map k a -> Maybe ((k, a), Map k a)+splitMin t = ((,) <*> flip delete t . fst) <$> lookupMin t  -- | /O(log n)/ Modify the value of the maximum key or delete its bin-updateMaxWithKey :: (Ord k) => (k -> a -> Maybe a) -> Map k a -> Map k a-updateMaxWithKey f t =+updateMax :: (Ord k) => (k -> a -> Maybe a) -> Map k a -> Map k a+updateMax f t =   maybe     t-    ( \(k, a) ->-        maybe-          (delete' k t)-          (\a' -> insert k a' t)-          $ f k a-    )+    (\(k, a) -> maybe (delete k t) (\a' -> insert k a' t) $ f k a)     $ lookupMax t  -- | /O(log n)/ Modify the value of the minimum key or delete its bin-updateMin :: (Ord k) => (a -> Maybe a) -> Map k a -> Map k a-updateMin = updateMinWithKey . const---- | /O(log n)/ Modify the value of the minimum key or delete its bin-updateMinWithKey :: (Ord k) => (k -> a -> Maybe a) -> Map k a -> Map k a-updateMinWithKey f t =+updateMin :: (Ord k) => (k -> a -> Maybe a) -> Map k a -> Map k a+updateMin f t =   maybe     t-    ( \(k, a) ->-        maybe-          (delete' k t)-          (\a' -> insert k a' t)-          $ f k a-    )+    (\(k, a) -> maybe (delete k t) (\a' -> insert k a' t) $ f k a)     $ lookupMin t +-- Modification++-- | /O(log n)/ Adjust with an operation the value of a key in a map+adjust :: (Ord k) => (k -> a -> a) -> k -> Map k a -> Map k a+adjust 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(n log n)/ Keep the bins whose keys and values satisfy a predicate+filter :: (Ord k) => (k -> a -> Bool) -> Map k a -> Map k a+filter p = foldrWith (\k a b -> bool b (insert k a b) $ p k a) mempty++-- | /O(log n)/ Insert a key and its value into a map, overwriting if present+insert :: (Ord k) => k -> a -> Map k a -> Map k a+insert = insertWith $ const 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+update :: (Ord k) => (k -> a -> Maybe a) -> k -> Map k a -> Map k a+update 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---- | /O(n)/ Partition a map with a predicate into @(true, false)@ submaps-partitionWithKey :: (k -> a -> Bool) -> Map k a -> (Map k a, Map k a)-partitionWithKey p =-  bimap fromDistinctAscList fromDistinctAscList-    . foldrWithKey-      (\k a -> bool second first (p k a) ((k, a) :))-      ([], [])+-- | /O(n log n)/ Partition a map with a predicate into @(true, false)@ submaps+partition :: (Ord k) => (k -> a -> Bool) -> Map k a -> (Map k a, Map k a)+partition p =+  foldrWith (\k a -> bool second first (p k a) (insert k a)) (mempty, mempty) --- | /O(n)/ Split a map by a key into @(lt, eq, gt)@ submaps+-- | /O(n log n)/ Split a map by a key into @(lt, eq, gt)@ submaps split :: (Ord k) => k -> Map k a -> (Map k a, Maybe a, Map k a) split k0 =-  (\(lt, a, gt) -> (fromDistinctAscList lt, a, fromDistinctAscList gt))-    . foldrWithKey-      ( \k a (lt, a', gt) ->-          ordering-            ((k, a) : lt, a', gt)-            (lt, Just a, gt)-            (lt, a', (k, a) : gt)-            $ compare k k0-      )-      ([], Nothing, [])---- | /O(log n)/ Split a map by its maximum key-splitMax :: (Ord k) => Map k a -> Maybe ((k, a), Map k a)-splitMax t = ((,) <*> flip delete' t . fst) <$> lookupMax t---- | /O(log n)/ Split a map by its minimum key-splitMin :: (Ord k) => Map k a -> Maybe ((k, a), Map k a)-splitMin t = ((,) <*> flip delete' t . fst) <$> lookupMin t+  foldrWith+    ( \k a (lt, a', gt) ->+        ordering+          (insert k a lt, a', gt)+          (lt, Just a, gt)+          (lt, a', insert k a gt)+          $ compare k k0+    )+    (mempty, Nothing, mempty)  -- Query @@ -599,184 +434,83 @@ disjoint :: (Ord k) => Map k a -> Map k a -> Bool disjoint t1 t2 = map' True go go go t1  where-  go _ _ _ _ _ _ = not $ foldrWithKey (\k _ b -> k `member` t1 || b) False t2---- | /O(n log m)/ Check whether the bins of one map exist in the other-isSubmapOf :: (Ord k, Eq a) => Map k a -> Map k a -> Bool-isSubmapOf = isSubmapOfBy (==)---- | /O(n log m)/ Check if the bins of one map exist in the other by combination-isSubmapOfBy :: (Ord k) => (a -> b -> Bool) -> Map k a -> Map k b -> Bool-isSubmapOfBy p t1 t2 = map' (null t1) go go go t2- where-  go _ _ _ _ _ _ =-    foldrWithKey-      (\k a b -> maybe False ((&& b) . p a) $ lookup k t2)-      True-      t1+  go _ _ _ _ _ _ = not $ foldrWith (\k _ b -> k `member` t1 || b) False t2  -- | /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 =-    ordering-      recl-      (Just a)-      recr-      $ compare k k'+  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 =-    ordering-      recr-      (Just (k, a))-      (recl <|> Just (k, a))-      $ compare k k0+    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 =-    ordering-      recr-      recr-      (recl <|> Just (k, a))-      $ compare k k0+    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 =-    ordering-      (recr <|> Just (k, a))-      (Just (k, a))-      recl-      $ compare k k0+    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 =-    ordering-      (recr <|> Just (k, a))-      recl-      recl-      $ compare k k0---- | /O(log n)/ Fetch the bin with the maximum key-lookupMax :: Map k a -> Maybe (k, a)-lookupMax = map' Nothing go go go- where-  go _ k a r _ recr = map' (Just (k, a)) go' go' go' r-   where-    go' _ _ _ _ _ _ = recr---- | /O(log n)/ Fetch the bin with the minimum key-lookupMin :: Map k a -> Maybe (k, a)-lookupMin = map' Nothing go go go- where-  go l k a _ recl _ = map' (Just (k, a)) go' go' go' l-   where-    go' _ _ _ _ _ _ = recl+    ordering (recr <|> Just (k, a)) recl recl $ compare k k0  -- | /O(log n)/ Check whether a key is in a map member :: (Ord k) => k -> Map k a -> Bool member k0 = map' False go go go  where-  go _ k _ _ recl recr =-    ordering-      recl-      True-      recr-      $ compare k0 k+  go _ k _ _ recl recr = ordering recl True recr $ compare k0 k --- | /O(1)/ Check whether a map is empty-null :: Map k a -> Bool-null = map' True go go go where go _ _ _ _ _ _ = False+-- | /O(n log m)/ Check whether the bins of one map exist in the other+submap :: (Ord k, Eq a) => Map k a -> Map k a -> Bool+submap = submapBy (==) --- | /O(n)/ Get the size of a map-size :: Map k a -> Int-size = map' 0 go go go where go _ _ _ _ recl recr = 1 + recl + recr+-- | /O(n log m)/ Check if the bins of one map exist in the other by combination+submapBy :: (Ord k) => (a -> b -> Bool) -> Map k a -> Map k b -> Bool+submapBy p t1 t2 = map' (null t1) go go go t2+ where+  go _ _ _ _ _ _ =+    foldrWith (\k a b -> maybe False ((&& b) . p a) $ lookup k t2) True t1  -- Traversal  -- | /O(n)/ Apply an operation across a map, transforming its values-fmapWithKey :: (k -> a -> b) -> Map k a -> Map k b-fmapWithKey f = map' E (go L) (go B) (go R)+fmapWith :: (k -> a -> b) -> Map k a -> Map k b+fmapWith f = map' E (go L) (go B) (go R)  where   go c _ k a _ recl = c recl k (f k a)  -- | /O(n)/ Lift a map with a lifting operation on keys and values-traverseWithKey :: (Applicative f) => (k -> a -> f b) -> Map k a -> f (Map k b)-traverseWithKey f = map' (pure E) (go L) (go B) (go R)+traverseWith :: (Applicative f) => (k -> a -> f b) -> Map k a -> f (Map k b)+traverseWith f = map' (pure E) (go L) (go B) (go R)  where   go c _ k a _ recl recr = c <$> recl <*> pure k <*> f k a <*> recr --- Validation---- | /O(n^2)/ Check whether a map is internally height-balanced and ordered-valid :: (Ord k) => Map k a -> Bool-valid = liftA2 (&&) balanced ordered- where-  balanced =-    map'-      True-      (\l _ _ r recl recr -> levels l - levels r == 1 && recl && recr)-      (\l _ _ r recl recr -> levels l - levels r == 0 && recl && recr)-      (\l _ _ r recl recr -> levels r - levels l == 1 && recl && recr)-  levels = map' 0 go go go-   where-    go _ _ _ _ recl recr = 1 + max recl recr :: Int-  ordered = map' True go go go-   where-    go l k _ r recl recr =-      map' True lt lt lt l-        && map' True gt gt gt r-     where-      lt _ lk _ _ _ _ = lk < k && recl && recr-      gt _ rk _ _ _ _ = rk > k && recl && recr- -- Helpers --- O(n) 'nub' on keys for sorted lists of pairs-essence :: (Eq k) => [(k, a)] -> [(k, a)]-essence = list [] go- where-  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-essenceWithKey :: (Eq k) => (k -> a -> a -> a) -> [(k, a)] -> [(k, a)]-essenceWithKey f = list [] (\p -> const . go p)- where-  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---- 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- {-  - Let this comment serve as your warning. Return from whence you came and your  - sanity will be spared. You have been admonished.  -} --- O(log n) Delete a key from a map without checking for membership-delete' :: (Ord k) => k -> Map k a -> Map k a-delete' k0 =+-- | /O(log n)/ Delete a key from a map without checking for membership+delete :: (Ord k) => k -> Map k a -> Map k a+delete k0 =   map'     (error "Map.delete: L0")     ( \l k a r _ _ ->@@ -1291,8 +1025,8 @@       popRightL rl rk ra rr  -- | /O(log n)/ Insert a key and its value, combining new and old if present-insertWithKey :: (Ord k) => (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a-insertWithKey f k0 a0 =+insertWith :: (Ord k) => (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a+insertWith f k0 a0 =   map'     (B E k0 a0 E)     (\l k a r _ _ -> insertL l k a r)

@@ -1,6 +1,3 @@--- incomplete patterns in 'from{Asc,Desc}List'-{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}- -- | A structure containing unique elements module Mini.Data.Set (   -- * Type@@ -8,11 +5,6 @@   set,    -- * Construction-  empty,-  fromAscList,-  fromDescList,-  fromDistinctAscList,-  fromDistinctDescList,   fromList,   singleton, @@ -20,48 +12,42 @@   difference,   intersection,   union,-  unions,    -- * Conversion   toAscList,   toDescList, -  -- * Modification-  delete,+  -- * Max/Min   deleteMax,   deleteMin,+  lookupMax,+  lookupMin,+  splitMax,+  splitMin,++  -- * Modification+  delete,   filter,   insert,    -- * Partition   partition,   split,-  splitMax,-  splitMin,    -- * Query   disjoint,-  isSubsetOf,   lookupGE,   lookupGT,   lookupLE,   lookupLT,-  lookupMax,-  lookupMin,   member,-  null,-  size,--  -- * Validation-  valid,+  subset, ) where  import Control.Applicative (-  liftA2,   (<|>),  ) import Data.Bifunctor (-  bimap,   first,   second,  )@@ -72,9 +58,12 @@   on,  ) import Mini.Data.Recursion (-  list,   ordering,  )+import Mini.Hash.Class (+  Hashable,+  toBytes,+ ) import Prelude (   Bool (     False,@@ -82,7 +71,6 @@   ),   Eq,   Foldable,-  Int,   Maybe (     Just,     Nothing@@ -94,33 +82,25 @@   all,   any,   compare,-  const,-  div,+  concatMap,   error,   flip,   foldl,   foldr,-  length,-  max,+  maximum,   maybe,   mempty,+  minimum,   not,+  null,   show,-  splitAt,   uncurry,-  until,   ($),-  (&&),-  (*),-  (+),-  (-),   (.),-  (<),   (<$>),   (<*>),   (<>),   (==),-  (>),  )  -- Type@@ -149,13 +129,27 @@   foldr f b = set' b go go go    where     go l a _ _ recr = foldr f (f a recr) l+  null = set' True go go go where go _ _ _ _ _ = False+  maximum = set' (error "maximum: empty set") go go go+   where+    go _ a r _ recr = set' a go' go' go' r+     where+      go' _ _ _ _ _ = recr+  minimum = set' (error "minimum: empty set") go go go+   where+    go l a _ recl _ = set' a go' go' go' l+     where+      go' _ _ _ _ _ = recl  instance (Ord a) => Semigroup (Set a) where   (<>) = union  instance (Ord a) => Monoid (Set a) where-  mempty = empty+  mempty = E +instance (Hashable a) => Hashable (Set a) where+  toBytes = concatMap toBytes+ -- | Primitive recursion on sets (internally structured as trees) set   :: b@@ -196,84 +190,33 @@  -- Construction --- | /O(1)/ The empty set-empty :: Set a-empty = E---- | /O(n)/ Make a set from a sorted list of elements-fromAscList :: (Eq a) => [a] -> Set a-fromAscList = fromDistinctAscList . essence---- | /O(n)/ Make a set from a sorted list of elements-fromDescList :: (Eq a) => [a] -> Set a-fromDescList = fromDistinctDescList . essence---- | /O(n)/ Make a set from a sorted list of distinct elements-fromDistinctAscList :: [a] -> Set a-fromDistinctAscList = go <*> power- where-  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 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')- -- | /O(n log n)/ Make a set from a list of elements fromList :: (Ord a) => [a] -> Set a-fromList = foldl (flip insert) empty+fromList = foldl (flip insert) mempty  -- | /O(1)/ Make a set with a single element-singleton :: a -> Set a-singleton a = B E a E+singleton :: (Ord a) => a -> Set a+singleton a = B mempty a mempty  -- 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+difference t1 t2 = set' mempty go go go t1  where-  go _ _ _ _ _ = foldr delete t1 t2+  go _ _ _ _ _ = foldr (\a b -> bool b (delete a b) $ a `member` b) t1 t2  -- | /O(m log n)/ Intersect a set with another intersection :: (Ord a) => Set a -> Set a -> Set a-intersection t1 t2 = set' empty go go go t2+intersection t1 t2 = set' mempty go go go t2  where-  go _ _ _ _ _ =-    fromDistinctAscList $-      foldr-        (\a b -> bool b (a : b) $ a `member` t2)-        []-        t1+  go _ _ _ _ _ = foldr (\a b -> bool b (insert a b) $ a `member` t2) mempty t1  -- | /O(m log n)/ Unite a set with another union :: (Ord a) => Set a -> Set a -> Set a union t1 t2 = set' t2 go go go t1  where-  go _ _ _ _ _ = foldr insert t1 t2---- | Unite a collection of sets-unions :: (Foldable t, Ord a) => t (Set a) -> Set a-unions = foldr union empty+  go _ _ _ _ _ = foldr (\a b -> bool (insert a b) b $ a `member` b) t1 t2  -- Conversion @@ -285,60 +228,65 @@ toDescList :: Set a -> [a] toDescList = foldl (flip (:)) [] --- Modification---- | /O(log n)/ Delete an element from a set-delete :: (Ord a) => a -> Set a -> Set a-delete a t = bool t (delete' a t) $ a `member` t+-- Max/Min  -- | /O(log n)/ Delete the maximum element from a set deleteMax :: (Ord a) => Set a -> Set a-deleteMax t = maybe t (`delete'` t) $ lookupMax t+deleteMax t = maybe t (`delete` t) $ lookupMax t  -- | /O(log n)/ Delete the minimum element from a set deleteMin :: (Ord a) => Set a -> Set a-deleteMin t = maybe t (`delete'` t) $ lookupMin t---- | /O(n)/ Keep the elements satisfying a predicate-filter :: (a -> Bool) -> Set a -> Set a-filter p = fromDistinctAscList . foldr (\a b -> bool b (a : b) $ p a) []---- | /O(log n)/ Insert an element into a set-insert :: (Ord a) => a -> Set a -> Set a-insert a t = bool (insert' a t) t $ a `member` t---- Partition+deleteMin t = maybe t (`delete` t) $ lookupMin t --- | /O(n)/ Partition a set with a predicate into @(true, false)@ subsets-partition :: (a -> Bool) -> Set a -> (Set a, Set a)-partition p =-  bimap fromDistinctAscList fromDistinctAscList-    . foldr-      (\a -> bool second first (p a) (a :))-      ([], [])+-- | /O(log n)/ Fetch the maximum element+lookupMax :: Set a -> Maybe a+lookupMax = set' Nothing go go go+ where+  go _ a r _ recr = set' (Just a) go' go' go' r+   where+    go' _ _ _ _ _ = recr --- | /O(n)/ Split a set by an element into @(lt, eq, gt)@ subsets-split :: (Ord a) => a -> Set a -> (Set a, Bool, Set a)-split a0 =-  (\(lt, a, gt) -> (fromDistinctAscList lt, a, fromDistinctAscList gt))-    . foldr-      ( \a (lt, a', gt) ->-          ordering-            (a : lt, a', gt)-            (lt, True, gt)-            (lt, a', a : gt)-            $ compare a a0-      )-      ([], False, [])+-- | /O(log n)/ Fetch the minimum element+lookupMin :: Set a -> Maybe a+lookupMin = set' Nothing go go go+ where+  go l a _ recl _ = set' (Just a) go' go' go' l+   where+    go' _ _ _ _ _ = recl  -- | /O(log n)/ Split a set by its maximum element splitMax :: (Ord a) => Set a -> Maybe (a, Set a)-splitMax t = ((,) <*> flip delete' t) <$> lookupMax t+splitMax t = ((,) <*> flip delete t) <$> lookupMax t  -- | /O(log n)/ Split a set by its minimum element splitMin :: (Ord a) => Set a -> Maybe (a, Set a)-splitMin t = ((,) <*> flip delete' t) <$> lookupMin t+splitMin t = ((,) <*> flip delete t) <$> lookupMin t +-- Modification++-- | /O(n log n)/ Keep the elements satisfying a predicate+filter :: (Ord a) => (a -> Bool) -> Set a -> Set a+filter p = foldr (\a b -> bool b (insert a b) $ p a) mempty++-- Partition++-- | /O(n log n)/ Partition a set with a predicate into @(true, false)@ subsets+partition :: (Ord a) => (a -> Bool) -> Set a -> (Set a, Set a)+partition p = foldr (\a -> bool second first (p a) (insert a)) (mempty, mempty)++-- | /O(n log n)/ Split a set by an element into @(lt, eq, gt)@ subsets+split :: (Ord a) => a -> Set a -> (Set a, Bool, Set a)+split a0 =+  foldr+    ( \a (lt, a', gt) ->+        ordering+          (insert a lt, a', gt)+          (lt, True, gt)+          (lt, a', insert a gt)+          $ compare a a0+    )+    (mempty, False, mempty)+ -- Query  -- | /O(m log n)/ Check whether two sets have no elements in common@@ -347,137 +295,50 @@  where   go _ _ _ _ _ = not $ any (`member` t1) t2 --- | /O(n log m)/ Check whether the elements of a set exist in the other-isSubsetOf :: (Ord a) => Set a -> Set a -> Bool-isSubsetOf t1 t2 = set' (null t1) go go go t2- where-  go _ _ _ _ _ = all (`member` t2) t1- -- | /O(log n)/ Fetch the least element greater than or equal to the given one lookupGE :: (Ord a) => a -> Set a -> Maybe a lookupGE a0 = set' Nothing go go go  where-  go _ a _ recl recr =-    ordering-      recr-      (Just a)-      (recl <|> Just a)-      $ compare a a0+  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 =-    ordering-      recr-      recr-      (recl <|> Just a)-      $ compare a a0+  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 =-    ordering-      (recr <|> Just a)-      (Just a)-      recl-      $ compare a a0+  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 =-    ordering-      (recr <|> Just a)-      recl-      recl-      $ compare a a0---- | /O(log n)/ Fetch the maximum element-lookupMax :: Set a -> Maybe a-lookupMax = set' Nothing go go go- where-  go _ a r _ recr = set' (Just a) go' go' go' r-   where-    go' _ _ _ _ _ = recr---- | /O(log n)/ Fetch the minimum element-lookupMin :: Set a -> Maybe a-lookupMin = set' Nothing go go go- where-  go l a _ recl _ = set' (Just a) go' go' go' l-   where-    go' _ _ _ _ _ = recl+  go _ a _ recl recr = ordering (recr <|> Just a) recl recl $ compare a a0  -- | /O(log n)/ Check whether an element is in a set member :: (Ord a) => a -> Set a -> Bool member a0 = set' False go go go  where-  go _ a _ recl recr =-    ordering-      recl-      True-      recr-      $ compare a0 a---- | /O(1)/ Check whether a set is empty-null :: Set a -> Bool-null = set' True go go go where go _ _ _ _ _ = False---- | /O(n)/ Get the size of a set-size :: Set a -> Int-size = set' 0 go go go where go _ _ _ recl recr = 1 + recl + recr---- Validation---- | /O(n^2)/ Check whether a set is internally height-balanced and ordered-valid :: (Ord a) => Set a -> Bool-valid = liftA2 (&&) balanced ordered- where-  balanced =-    set'-      True-      (\l _ r recl recr -> levels l - levels r == 1 && recl && recr)-      (\l _ r recl recr -> levels l - levels r == 0 && recl && recr)-      (\l _ r recl recr -> levels r - levels l == 1 && recl && recr)-  levels = set' 0 go go go-   where-    go _ _ _ recl recr = 1 + max recl recr :: Int-  ordered = set' True go go go-   where-    go l a r recl recr =-      set' True lt lt lt l-        && set' True gt gt gt r-     where-      lt _ la _ _ _ = la < a && recl && recr-      gt _ ra _ _ _ = ra > a && recl && recr---- Helpers+  go _ a _ recl recr = ordering recl True recr $ compare a0 a --- O(n) 'nub' for sorted lists-essence :: (Eq a) => [a] -> [a]-essence = list [] go+-- | /O(n log m)/ Check whether the elements of a set exist in the other+subset :: (Ord a) => Set a -> Set a -> Bool+subset t1 t2 = set' (null t1) go go go t2  where-  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-power as = until (> length as) (* 2) 2 `div` 2+  go _ _ _ _ _ = all (`member` t2) t1  {-  - Let this comment serve as your warning. Return from whence you came and your  - sanity will be spared. You have been admonished.  -} --- O(log n) Delete an element from a set without checking for membership-delete' :: (Ord a) => a -> Set a -> Set a-delete' a0 =+-- | /O(log n)/ Delete an element from a set without checking for membership+delete :: (Ord a) => a -> Set a -> Set a+delete a0 =   set'     (error "Set.delete: L0")     ( \l a r _ _ ->@@ -912,9 +773,9 @@   popRightBR l a rl ra rr = first (checkRightB l a) $ popRightR rl ra rr   popRightBL l a rl ra rr = first (checkRightB l a) $ popRightL rl ra rr --- O(log n) Insert an element into a set without checking for membership-insert' :: (Ord a) => a -> Set a -> Set a-insert' a0 =+-- | /O(log n)/ Insert an element into a set without checking for membership+insert :: (Ord a) => a -> Set a -> Set a+insert a0 =   set'     (B E a0 E)     (\l a r _ _ -> insertL l a r)

@@ -31,6 +31,9 @@   Word64,   Word8,  )+import Mini.Data.Array (+  Array,+ ) import Prelude (   Bool,   Char,@@ -54,6 +57,7 @@ class Hash h s d | h -> s d where   -- | Make a hash value from a hashable value and a seed   hash :: (Hashable a) => a -> s -> h+   -- | Extract the digest of a hash value   digest :: h -> d @@ -99,6 +103,9 @@   toBytes = finiteBitsIntegralToBytes  instance (Hashable a) => Hashable [a] where+  toBytes = concatMap toBytes++instance (Hashable a) => Hashable (Array i a) where   toBytes = concatMap toBytes  -- Helpers

@@ -84,15 +84,13 @@   go len h (a : _) = (len + 1, h, fromIntegral a)   go len h _ = (len, h, 0) -- tail :: Word32 -> Word32 -> Word32 -> Word32 tail len h0 k0 =-    let k1 = k0 * 0xcc9e2d51-        k2 = k1 `rotateL` 15-        k3 = k2 * 0x1b873593-        h1 = h0 `xor` k3-     in bool h0 h1 $ len .&. 3 /= 0+  let k1 = k0 * 0xcc9e2d51+      k2 = k1 `rotateL` 15+      k3 = k2 * 0x1b873593+      h1 = h0 `xor` k3+   in bool h0 h1 $ len .&. 3 /= 0  final :: Word32 -> Word32 -> Word32 final len h = mix $ h `xor` len

@@ -205,7 +205,7 @@ (#*#) :: (Vector p, Vector q, Vector r, Num a) => q (p a) -> r (q a) -> r (p a) qp #*# rq = fmap (\q -> foldr (^+^) V.zero $ liftA2 (~*^) q qp) rq -infix 7 #*^+infixl 7 #*^  -- | Matrix-vector multiplication (#*^) :: (Vector p, Vector q, Num a) => q (p a) -> q a -> p a@@ -223,7 +223,7 @@ (#-#) :: (Vector p, Vector q, Num a) => q (p a) -> q (p a) -> q (p a) (#-#) = liftA2 (^-^) -infix 7 ^*#+infixl 7 ^*#  -- | Vector-matrix multiplication (^*#) :: (Vector p, Vector q, Num a) => p a -> q (p a) -> q a

@@ -194,6 +194,8 @@  -- Operations +infixl 7 %*%+ -- | Quaternion-quaternion multiplication (%*%) :: (Num a) => Quaternion a -> Quaternion a -> Quaternion a q %*% r =@@ -210,13 +212,19 @@           (view z v')           w' +infixl 6 %+%+ -- | Quaternion-quaternion addition (%+%) :: (Num a) => Quaternion a -> Quaternion a -> Quaternion a (%+%) = liftA2 (+) +infixl 6 %-%+ -- | Quaternion-quaternion subtraction (%-%) :: (Num a) => Quaternion a -> Quaternion a -> Quaternion a (%-%) = liftA2 (-)++infixl 7 ~*%  -- | Scalar-quaternion multiplication (~*%) :: (Num a) => a -> Quaternion a -> Quaternion a

@@ -40,14 +40,6 @@   Word64,   Word8,  )-import Mini.Random.SplitMix (-  SplitMix,- )-import qualified Mini.Random.SplitMix as SplitMix (-  nextWord32,-  nextWord64,-  split,- ) import Prelude (   Bool,   Char,@@ -73,16 +65,9 @@   nextWord32 = first fromIntegral . nextWord64   nextWord64 :: g -> (Word64, g) -instance Generator SplitMix where-  nextWord32 = SplitMix.nextWord32-  nextWord64 = SplitMix.nextWord64- -- | The class of splittable pseudorandom number generators class (Generator g) => Splittable g where   split :: g -> (g, g)--instance Splittable SplitMix where-  split = SplitMix.split  -- | The class of types for which pseudorandom values can be generated class Random a where

@@ -5,11 +5,6 @@    -- * Construction   seed,--  -- * Operations-  nextWord32,-  nextWord64,-  split, ) where  import Data.Bits (@@ -25,6 +20,13 @@ import Mini.Data.Recursion (   bool,  )+import Mini.Random.Class (+  Generator,+  Splittable,+  nextWord32,+  nextWord64,+  split,+ ) import Prelude (   Eq,   Ord,@@ -42,34 +44,27 @@ data SplitMix = SplitMix Word64 Word64   deriving (Eq, Ord, Show) +instance Generator SplitMix where+  nextWord32 (SplitMix s g) =+    let s' = s + g+     in (mix32 s', SplitMix s' g)+  nextWord64 (SplitMix s g) =+    let s' = s + g+     in (mix64 s', SplitMix s' g)++instance Splittable SplitMix where+  split (SplitMix s g) =+    let s' = s + g+        s'' = s' + g+        sm = SplitMix s'' g+        sm' = SplitMix (mix64 s') (mixGamma s'')+     in (sm, sm')+ -- Construction  -- | Make a generator from a seed seed :: Word64 -> SplitMix seed s = SplitMix (mix64 s) (mixGamma $ s + 0x9e3779b97f4a7c15)---- Operations---- | Generate the next 32-bit word-nextWord32 :: SplitMix -> (Word32, SplitMix)-nextWord32 (SplitMix s g) =-  let s' = s + g-   in (mix32 s', SplitMix s' g)---- | Generate the next 64-bit word-nextWord64 :: SplitMix -> (Word64, SplitMix)-nextWord64 (SplitMix s g) =-  let s' = s + g-   in (mix64 s', SplitMix s' g)---- | Split a generator into two (seemingly) independent generators-split :: SplitMix -> (SplitMix, SplitMix)-split (SplitMix s g) =-  let s' = s + g-      s'' = s' + g-      sm = SplitMix s'' g-      sm' = SplitMix (mix64 s') (mixGamma s'')-   in (sm, sm')  -- Helpers 

@@ -12,12 +12,11 @@  -- Class -{- | Instances should satisfy the following laws:--> lift . pure = pure--> lift (m >>= f) = lift m >>= (lift . f)--}+-- | Instances should satisfy the following laws:+--+-- > lift . pure = pure+--+-- > lift (m >>= f) = lift m >>= (lift . f) class MonadTrans t where   -- | Lift a computation from the inner monad to the transformer monad   lift :: (Monad m) => m a -> t m a

@@ -0,0 +1,115 @@+-- | Extend a monad with the ability to terminate a computation with a value+module Mini.Transformers.Either (+  -- * Type+  EitherT (+    EitherT+  ),+  runEitherT,++  -- * Operations+  eitherT,+  left,+  right,+) where++import Control.Applicative (+  Alternative,+  empty,+  (<|>),+ )+import Control.Monad (+  ap,+  liftM,+ )+import Control.Monad.IO.Class (+  MonadIO,+  liftIO,+ )+import Data.Bifunctor (+  first,+ )+import Mini.Random.Class (+  Random,+  random,+ )+import Mini.Transformers.Class (+  MonadTrans,+  lift,+ )+import Prelude (+  Applicative,+  Either (+    Left,+    Right+  ),+  Functor,+  Monad,+  MonadFail,+  Monoid,+  either,+  fail,+  fmap,+  mappend,+  mempty,+  pure,+  ($),+  (.),+  (<*>),+  (>>=),+ )++-- Type++-- | A terminable transformer with termination /e/, inner monad /m/, return /a/+newtype EitherT e m a = EitherT+  { runEitherT :: m (Either e a)+  -- ^ Unwrap a transformer computation+  }++instance (Monad m) => Functor (EitherT e m) where+  fmap = liftM++instance (Monad m) => Applicative (EitherT e m) where+  pure = right+  (<*>) = ap++instance (Monad m, Monoid e) => Alternative (EitherT e m) where+  empty = left mempty+  m <|> n = eitherT (\e -> eitherT (left . mappend e) right n) right m++instance (Monad m) => Monad (EitherT e m) where+  m >>= k = eitherT left k m++instance MonadTrans (EitherT e) where+  lift = EitherT . fmap Right++instance (MonadFail m) => MonadFail (EitherT e m) where+  fail = EitherT . fail++instance (MonadIO m) => MonadIO (EitherT e m) where+  liftIO = lift . liftIO++instance (Monad m, Random a) => Random (EitherT e m a) where+  random = first right . random++-- Operations++-- | Case analysis on the result of a computation+eitherT+  :: (Monad m)+  => (e -> EitherT e' m b)+  -- ^ Function applied in case of @Left e@+  -> (a -> EitherT e' m b)+  -- ^ Function applied in case of @Right a@+  -> EitherT e m a+  -- ^ Object of the case analysis+  -> EitherT e' m b+eitherT l r m = EitherT $ runEitherT m >>= runEitherT . either l r++-- | Terminate the computation with a value+left :: (Applicative m) => e -> EitherT e m a+left = EitherT . pure . Left++-- | Return a value+right :: (Applicative m) => a -> EitherT e m a+right = EitherT . pure . Right

@@ -1,102 +0,0 @@--- | Extend a monad with the ability to terminate a computation with a value-module Mini.Transformers.EitherT (-  -- * Type-  EitherT (-    EitherT-  ),-  runEitherT,--  -- * Operations-  eitherT,-  left,-  right,-) where--import Control.Applicative (-  Alternative,-  empty,-  (<|>),- )-import Control.Monad (-  ap,-  liftM,- )-import Control.Monad.IO.Class (-  MonadIO,-  liftIO,- )-import Mini.Transformers.Class (-  MonadTrans,-  lift,- )-import Prelude (-  Applicative,-  Either (-    Left,-    Right-  ),-  Functor,-  Monad,-  MonadFail,-  Monoid,-  either,-  fail,-  fmap,-  mappend,-  mempty,-  pure,-  ($),-  (.),-  (<*>),-  (>>=),- )---- Type---- | A terminable transformer with termination /e/, inner monad /m/, return /a/-newtype EitherT e m a = EitherT-  { runEitherT :: m (Either e a)-  -- ^ Unwrap a transformer computation-  }--instance (Monad m) => Functor (EitherT e m) where-  fmap = liftM--instance (Monad m) => Applicative (EitherT e m) where-  pure = right-  (<*>) = ap--instance (Monad m, Monoid e) => Alternative (EitherT e m) where-  empty = left mempty-  m <|> n = eitherT (\e -> eitherT (left . mappend e) right n) right m--instance (Monad m) => Monad (EitherT e m) where-  m >>= k = eitherT left k m--instance MonadTrans (EitherT e) where-  lift = EitherT . fmap Right--instance (MonadFail m) => MonadFail (EitherT e m) where-  fail = EitherT . fail--instance (MonadIO m) => MonadIO (EitherT e m) where-  liftIO = lift . liftIO---- Operations---- | Case analysis on the result of a computation-eitherT-  :: (Monad m)-  => (e -> EitherT e' m b) -- ^ Function applied in case of @Left e@-  -> (a -> EitherT e' m b) -- ^ Function applied in case of @Right a@-  -> EitherT e m a -- ^ Object of the case analysis-  -> EitherT e' m b-eitherT l r m = EitherT $ runEitherT m >>= runEitherT . either l r---- | Terminate the computation with a value-left :: (Applicative m) => e -> EitherT e m a-left = EitherT . pure . Left---- | Return a value-right :: (Applicative m) => a -> EitherT e m a-right = EitherT . pure . Right

@@ -0,0 +1,113 @@+-- | Extend a monad with the ability to terminate a computation without a value+module Mini.Transformers.Maybe (+  -- * Type+  MaybeT (+    MaybeT+  ),+  runMaybeT,++  -- * Operations+  maybeT,+  nothing,+  just,+) where++import Control.Applicative (+  Alternative,+  empty,+  (<|>),+ )+import Control.Monad (+  ap,+  liftM,+ )+import Control.Monad.IO.Class (+  MonadIO,+  liftIO,+ )+import Data.Bifunctor (+  first,+ )+import Mini.Random.Class (+  Random,+  random,+ )+import Mini.Transformers.Class (+  MonadTrans,+  lift,+ )+import Prelude (+  Applicative,+  Functor,+  Maybe (+    Just,+    Nothing+  ),+  Monad,+  MonadFail,+  const,+  fail,+  fmap,+  maybe,+  pure,+  ($),+  (.),+  (<*>),+  (>>=),+ )++-- Type++-- | A terminable transformer with inner monad /m/, return /a/+newtype MaybeT m a = MaybeT+  { runMaybeT :: m (Maybe a)+  -- ^ Unwrap a transformer computation+  }++instance (Monad m) => Functor (MaybeT m) where+  fmap = liftM++instance (Monad m) => Applicative (MaybeT m) where+  pure = just+  (<*>) = ap++instance (Monad m) => Alternative (MaybeT m) where+  empty = nothing+  m <|> n = maybeT n just m++instance (Monad m) => Monad (MaybeT m) where+  m >>= k = maybeT nothing k m++instance MonadTrans MaybeT where+  lift = MaybeT . fmap Just++instance (Monad m) => MonadFail (MaybeT m) where+  fail = const nothing++instance (MonadIO m) => MonadIO (MaybeT m) where+  liftIO = lift . liftIO++instance (Monad m, Random a) => Random (MaybeT m a) where+  random = first just . random++-- Operations++-- | Case analysis on the result of a computation+maybeT+  :: (Monad m)+  => MaybeT m b+  -- ^ Computation in case of @Nothing@+  -> (a -> MaybeT m b)+  -- ^ Function applied in case of @Just a@+  -> MaybeT m a+  -- ^ Object of the case analysis+  -> MaybeT m b+maybeT n j m = MaybeT $ runMaybeT m >>= runMaybeT . maybe n j++-- | Terminate the computation without a value+nothing :: (Applicative m) => MaybeT m a+nothing = MaybeT $ pure Nothing++-- | Return a value+just :: (Applicative m) => a -> MaybeT m a+just = MaybeT . pure . Just

@@ -1,100 +0,0 @@--- | Extend a monad with the ability to terminate a computation without a value-module Mini.Transformers.MaybeT (-  -- * Type-  MaybeT (-    MaybeT-  ),-  runMaybeT,--  -- * Operations-  maybeT,-  nothing,-  just,-) where--import Control.Applicative (-  Alternative,-  empty,-  (<|>),- )-import Control.Monad (-  ap,-  liftM,- )-import Control.Monad.IO.Class (-  MonadIO,-  liftIO,- )-import Mini.Transformers.Class (-  MonadTrans,-  lift,- )-import Prelude (-  Applicative,-  Functor,-  Maybe (-    Just,-    Nothing-  ),-  Monad,-  MonadFail,-  const,-  fail,-  fmap,-  maybe,-  pure,-  ($),-  (.),-  (<*>),-  (>>=),- )---- Type---- | A terminable transformer with inner monad /m/, return /a/-newtype MaybeT m a = MaybeT-  { runMaybeT :: m (Maybe a)-  -- ^ Unwrap a transformer computation-  }--instance (Monad m) => Functor (MaybeT m) where-  fmap = liftM--instance (Monad m) => Applicative (MaybeT m) where-  pure = just-  (<*>) = ap--instance (Monad m) => Alternative (MaybeT m) where-  empty = nothing-  m <|> n = maybeT n just m--instance (Monad m) => Monad (MaybeT m) where-  m >>= k = maybeT nothing k m--instance MonadTrans MaybeT where-  lift = MaybeT . fmap Just--instance (Monad m) => MonadFail (MaybeT m) where-  fail = const nothing--instance (MonadIO m) => MonadIO (MaybeT m) where-  liftIO = lift . liftIO---- Operations---- | Case analysis on the result of a computation-maybeT-  :: (Monad m)-  => MaybeT m b -- ^ Computation in case of @Nothing@-  -> (a -> MaybeT m b) -- ^ Function applied in case of @Just a@-  -> MaybeT m a -- ^ Object of the case analysis-  -> MaybeT m b-maybeT n j m = MaybeT $ runMaybeT m >>= runMaybeT . maybe n j---- | Terminate the computation without a value-nothing :: (Applicative m) => MaybeT m a-nothing = MaybeT $ pure Nothing---- | Return a value-just :: (Applicative m) => a -> MaybeT m a-just = MaybeT . pure . Just

@@ -0,0 +1,302 @@+-- | Extend a monad with the ability to parse symbol sequences+module Mini.Transformers.Parser (+  -- * Type+  ParserT (+    ParserT+  ),+  runParserT,++  -- * Parsers+  eof,+  item,+  look,+  noneOf,+  oneOf,+  peek,+  sat,+  string,+  symbol,++  -- * Combinators+  accept,+  atLeast,+  atMost,+  between,+  chainl1,+  chainr1,+  findAll,+  findAll1,+  findFirst,+  findLast,+  option,+  range,+  reject,+  sepBy,+  sepBy1,+  till,+  till1,+) where++import Control.Applicative (+  Alternative,+  empty,+  many,+  some,+  (<|>),+ )+import Control.Monad (+  ap,+  liftM,+  replicateM,+ )+import Control.Monad.IO.Class (+  MonadIO,+  liftIO,+ )+import Data.Bifunctor (+  first,+ )+import Data.Bool (+  bool,+ )+import Mini.Data.Recursion (+  list,+ )+import Mini.Random.Class (+  Random,+  random,+ )+import Mini.Transformers.Class (+  MonadTrans,+  lift,+ )+import Prelude (+  Applicative,+  Bool (+    True+  ),+  Eq,+  Foldable,+  Functor,+  Int,+  Maybe (+    Just,+    Nothing+  ),+  Monad,+  MonadFail,+  Monoid,+  Semigroup,+  Traversable,+  const,+  elem,+  fail,+  flip,+  fmap,+  maybe,+  mempty,+  notElem,+  pure,+  traverse,+  ($),+  (*>),+  (-),+  (.),+  (<$),+  (<$>),+  (<*),+  (<*>),+  (<>),+  (==),+  (>),+  (>>=),+ )++-- Type++-- | A transformer parsing symbols /s/, inner monad /m/, return /a/+newtype ParserT s m a = ParserT+  { runParserT :: [s] -> m (Maybe (a, [s]))+  -- ^ Unwrap a transformer computation with a sequence of symbols to parse+  }++instance (Monad m) => Functor (ParserT s m) where+  fmap = liftM++instance (Monad m) => Applicative (ParserT s m) where+  pure a = ParserT $ \ss -> pure (Just (a, ss))+  (<*>) = ap++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 $ \ss ->+      runParserT m ss+        >>= maybe+          (pure Nothing)+          (\(a, ss') -> runParserT (k a) ss')++instance MonadTrans (ParserT s) where+  lift m = ParserT $ \ss -> Just . (\a -> (a, ss)) <$> m++instance (Monad m, Semigroup a) => Semigroup (ParserT s m a) where+  m <> n = (<>) <$> m <*> n++instance (Monad m, Monoid a) => Monoid (ParserT s m a) where+  mempty = pure mempty++instance (Monad m) => MonadFail (ParserT s m) where+  fail = const empty++instance (MonadIO m) => MonadIO (ParserT s m) where+  liftIO = lift . liftIO++instance (Monad m, Random a) => Random (ParserT s m a) where+  random = first pure . random++-- Parsers++-- | Parse successfully only at end of input+eof :: (Monad m) => ParserT s m ()+eof = reject item++-- | Parse any symbol+item :: (Applicative m) => ParserT s m s+item = sat $ const True++-- | Parse the rest of the input without consuming it+look :: (Applicative m) => ParserT s m [s]+look = ParserT $ \ss -> pure $ Just (ss, ss)++-- | 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 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) => ParserT s m s+peek = accept item++-- | 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 a sequence of symbols+string :: (Monad m, Traversable t, Eq s) => t s -> ParserT s m (t s)+string = traverse symbol++-- | Parse a specific symbol+symbol :: (Applicative m, Eq s) => s -> ParserT s m s+symbol = sat . (==)++-- Combinators++-- | 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 (\(a, _) -> (a, ss)) <$> 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)+  => ParserT s m a+  -> ParserT s m (a -> a -> a)+  -> ParserT s m a+chainl1 p f = p >>= go+ where+  go a = option a $ f <*> pure a <*> p >>= go++-- | Parse one or more @p@ right-associatively chained by @f@ via @chainr1 p f@+chainr1+  :: (Monad m)+  => ParserT s m a+  -> ParserT s m (a -> a -> a)+  -> ParserT s m a+chainr1 p f = go+ where+  go = p >>= rest+  rest a = option a $ f <*> pure a <*> go >>= rest++-- | 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) => 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) => ParserT s m a -> ParserT s m ()+reject p = ParserT $ \ss ->+  runParserT p ss+    >>= maybe+      (pure $ Just ((), ss))+      (const $ pure Nothing)++-- | 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++-- | 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)++-- | 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++-- | 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

@@ -1,292 +0,0 @@--- | Extend a monad with the ability to parse symbol sequences-module Mini.Transformers.ParserT (-  -- * Type-  ParserT (-    ParserT-  ),-  runParserT,--  -- * Parsers-  eof,-  item,-  look,-  noneOf,-  oneOf,-  peek,-  sat,-  string,-  symbol,--  -- * Combinators-  accept,-  atLeast,-  atMost,-  between,-  chainl1,-  chainr1,-  findAll,-  findAll1,-  findFirst,-  findLast,-  option,-  range,-  reject,-  sepBy,-  sepBy1,-  till,-  till1,-) where--import Control.Applicative (-  Alternative,-  empty,-  many,-  some,-  (<|>),- )-import Control.Monad (-  ap,-  liftM,-  replicateM,- )-import Control.Monad.IO.Class (-  MonadIO,-  liftIO,- )-import Data.Bool (-  bool,- )-import Mini.Data.Recursion (-  list,- )-import Mini.Transformers.Class (-  MonadTrans,-  lift,- )-import Prelude (-  Applicative,-  Bool (-    True-  ),-  Eq,-  Foldable,-  Functor,-  Int,-  Maybe (-    Just,-    Nothing-  ),-  Monad,-  MonadFail,-  Monoid,-  Semigroup,-  Traversable,-  const,-  elem,-  fail,-  flip,-  fmap,-  maybe,-  mempty,-  notElem,-  pure,-  traverse,-  ($),-  (*>),-  (-),-  (.),-  (<$),-  (<$>),-  (<*),-  (<*>),-  (<>),-  (==),-  (>),-  (>>=),- )---- Type---- | A transformer parsing symbols /s/, inner monad /m/, return /a/-newtype ParserT s m a = ParserT-  { runParserT :: [s] -> m (Maybe (a, [s]))-  -- ^ Unwrap a transformer computation with a sequence of symbols to parse-  }--instance (Monad m) => Functor (ParserT s m) where-  fmap = liftM--instance (Monad m) => Applicative (ParserT s m) where-  pure a = ParserT $ \ss -> pure (Just (a, ss))-  (<*>) = ap--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 $ \ss ->-      runParserT m ss-        >>= maybe-          (pure Nothing)-          (\(a, ss') -> runParserT (k a) ss')--instance MonadTrans (ParserT s) where-  lift m = ParserT $ \ss -> Just . (\a -> (a, ss)) <$> m--instance (Monad m, Semigroup a) => Semigroup (ParserT s m a) where-  m <> n = (<>) <$> m <*> n--instance (Monad m, Monoid a) => Monoid (ParserT s m a) where-  mempty = pure mempty--instance (Monad m) => MonadFail (ParserT s m) where-  fail = const empty--instance (MonadIO m) => MonadIO (ParserT s m) where-  liftIO = lift . liftIO---- Parsers---- | Parse successfully only at end of input-eof :: (Monad m) => ParserT s m ()-eof = reject item---- | Parse any symbol-item :: (Applicative m) => ParserT s m s-item = sat $ const True---- | Parse the rest of the input without consuming it-look :: (Applicative m) => ParserT s m [s]-look = ParserT $ \ss -> pure $ Just (ss, ss)---- | 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 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) => ParserT s m s-peek = accept item---- | 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 a sequence of symbols-string :: (Monad m, Traversable t, Eq s) => t s -> ParserT s m (t s)-string = traverse symbol---- | Parse a specific symbol-symbol :: (Applicative m, Eq s) => s -> ParserT s m s-symbol = sat . (==)---- Combinators---- | 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 (\(a, _) -> (a, ss)) <$> 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)-  => ParserT s m a-  -> ParserT s m (a -> a -> a)-  -> ParserT s m a-chainl1 p f = p >>= go- where-  go a = option a $ f <*> pure a <*> p >>= go---- | Parse one or more @p@ right-associatively chained by @f@ via @chainr1 p f@-chainr1-  :: (Monad m)-  => ParserT s m a-  -> ParserT s m (a -> a -> a)-  -> ParserT s m a-chainr1 p f = go- where-  go = p >>= rest-  rest a = option a $ f <*> pure a <*> go >>= rest---- | 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) => 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) => ParserT s m a -> ParserT s m ()-reject p = ParserT $ \ss ->-  runParserT p ss-    >>= maybe-      (pure $ Just ((), ss))-      (const $ pure Nothing)---- | 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---- | 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)---- | 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---- | 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

@@ -0,0 +1,95 @@+-- | Extend a monad with a read-only environment+module Mini.Transformers.Reader (+  -- * Type+  ReaderT (+    ReaderT+  ),+  runReaderT,++  -- * Operations+  ask,+  local,+) where++import Control.Applicative (+  Alternative,+  empty,+  (<|>),+ )+import Control.Monad (+  ap,+  liftM,+ )+import Control.Monad.IO.Class (+  MonadIO,+  liftIO,+ )+import Data.Bifunctor (+  first,+ )+import Mini.Random.Class (+  Random,+  random,+ )+import Mini.Transformers.Class (+  MonadTrans,+  lift,+ )+import Prelude (+  Applicative,+  Functor,+  Monad,+  MonadFail,+  const,+  fail,+  fmap,+  pure,+  ($),+  (.),+  (<*>),+  (>>=),+ )++-- Type++-- | A transformer with read-only /r/, inner monad /m/, return /a/+newtype ReaderT r m a = ReaderT+  { runReaderT :: r -> m a+  -- ^ Unwrap a transformer computation with an initial read-only value+  }++instance (Monad m) => Functor (ReaderT r m) where+  fmap = liftM++instance (Monad m) => Applicative (ReaderT r m) where+  pure = lift . pure+  (<*>) = ap++instance (Monad m, Alternative m) => Alternative (ReaderT r m) where+  empty = lift empty+  m <|> n = ReaderT $ \r -> runReaderT m r <|> runReaderT n r++instance (Monad m) => Monad (ReaderT r m) where+  m >>= k = ReaderT $ \r -> runReaderT m r >>= (`runReaderT` r) . k++instance MonadTrans (ReaderT r) where+  lift = ReaderT . const++instance (MonadFail m) => MonadFail (ReaderT r m) where+  fail = lift . fail++instance (MonadIO m) => MonadIO (ReaderT r m) where+  liftIO = lift . liftIO++instance (Monad m, Random a) => Random (ReaderT r m a) where+  random = first pure . random++-- Operations++-- | Fetch the read-only environment+ask :: (Monad m) => ReaderT r m r+ask = ReaderT pure++-- | Run a computation in a modified environment+local :: (r -> r') -> ReaderT r' m a -> ReaderT r m a+local f m = ReaderT $ runReaderT m . f

@@ -1,85 +0,0 @@--- | Extend a monad with a read-only environment-module Mini.Transformers.ReaderT (-  -- * Type-  ReaderT (-    ReaderT-  ),-  runReaderT,--  -- * Operations-  ask,-  local,-) where--import Control.Applicative (-  Alternative,-  empty,-  (<|>),- )-import Control.Monad (-  ap,-  liftM,- )-import Control.Monad.IO.Class (-  MonadIO,-  liftIO,- )-import Mini.Transformers.Class (-  MonadTrans,-  lift,- )-import Prelude (-  Applicative,-  Functor,-  Monad,-  MonadFail,-  const,-  fail,-  fmap,-  pure,-  ($),-  (.),-  (<*>),-  (>>=),- )---- Type---- | A transformer with read-only /r/, inner monad /m/, return /a/-newtype ReaderT r m a = ReaderT-  { runReaderT :: r -> m a-  -- ^ Unwrap a transformer computation with an initial read-only value-  }--instance (Monad m) => Functor (ReaderT r m) where-  fmap = liftM--instance (Monad m) => Applicative (ReaderT r m) where-  pure = lift . pure-  (<*>) = ap--instance (Monad m, Alternative m) => Alternative (ReaderT r m) where-  empty = lift empty-  m <|> n = ReaderT $ \r -> runReaderT m r <|> runReaderT n r--instance (Monad m) => Monad (ReaderT r m) where-  m >>= k = ReaderT $ \r -> runReaderT m r >>= (`runReaderT` r) . k--instance MonadTrans (ReaderT r) where-  lift = ReaderT . const--instance (MonadFail m) => MonadFail (ReaderT r m) where-  fail = lift . fail--instance (MonadIO m) => MonadIO (ReaderT r m) where-  liftIO = lift . liftIO---- Operations---- | Fetch the read-only environment-ask :: (Monad m) => ReaderT r m r-ask = ReaderT pure---- | Run a computation in a modified environment-local :: (r -> r') -> ReaderT r' m a -> ReaderT r m a-local f m = ReaderT $ runReaderT m . f

@@ -0,0 +1,101 @@+-- | Extend a monad with a modifiable environment+module Mini.Transformers.State (+  -- * Type+  StateT (+    StateT+  ),+  runStateT,++  -- * Operations+  get,+  modify,+  put,+) where++import Control.Applicative (+  Alternative,+  empty,+  (<|>),+ )+import Control.Monad (+  ap,+  liftM,+ )+import Control.Monad.IO.Class (+  MonadIO,+  liftIO,+ )+import Data.Bifunctor (+  first,+ )+import Mini.Random.Class (+  Random,+  random,+ )+import Mini.Transformers.Class (+  MonadTrans,+  lift,+ )+import Prelude (+  Applicative,+  Functor,+  Monad,+  MonadFail,+  const,+  fail,+  fmap,+  pure,+  ($),+  (.),+  (<$>),+  (<*>),+  (>>=),+ )++-- Type++-- | A transformer with state /s/, inner monad /m/, return /a/+newtype StateT s m a = StateT+  { runStateT :: s -> m (a, s)+  -- ^ Unwrap a transformer computation with an initial state+  }++instance (Monad m) => Functor (StateT s m) where+  fmap = liftM++instance (Monad m) => Applicative (StateT s m) where+  pure a = StateT $ \s -> pure (a, s)+  (<*>) = ap++instance (Monad m, Alternative m) => Alternative (StateT s m) where+  empty = StateT $ const empty+  m <|> n = StateT $ \s -> runStateT m s <|> runStateT n s++instance (Monad m) => Monad (StateT s m) where+  m >>= k = StateT $ \s -> runStateT m s >>= (\(a, s') -> runStateT (k a) s')++instance MonadTrans (StateT s) where+  lift m = StateT $ \s -> (\a -> (a, s)) <$> m++instance (MonadFail m) => MonadFail (StateT s m) where+  fail = StateT . const . fail++instance (MonadIO m) => MonadIO (StateT s m) where+  liftIO = lift . liftIO++instance (Monad m, Random a) => Random (StateT s m a) where+  random = first pure . random++-- Operations++-- | Fetch the current state+get :: (Monad m) => StateT s m s+get = StateT $ \s -> pure (s, s)++-- | Update the current state with an operation+modify :: (Monad m) => (s -> s) -> StateT s m ()+modify f = StateT $ \s -> pure ((), f s)++-- | Overwrite the current state with a value+put :: (Monad m) => s -> StateT s m ()+put s = StateT . const $ pure ((), s)

@@ -1,91 +0,0 @@--- | Extend a monad with a modifiable environment-module Mini.Transformers.StateT (-  -- * Type-  StateT (-    StateT-  ),-  runStateT,--  -- * Operations-  get,-  modify,-  put,-) where--import Control.Applicative (-  Alternative,-  empty,-  (<|>),- )-import Control.Monad (-  ap,-  liftM,- )-import Control.Monad.IO.Class (-  MonadIO,-  liftIO,- )-import Mini.Transformers.Class (-  MonadTrans,-  lift,- )-import Prelude (-  Applicative,-  Functor,-  Monad,-  MonadFail,-  const,-  fail,-  fmap,-  pure,-  ($),-  (.),-  (<$>),-  (<*>),-  (>>=),- )---- Type---- | A transformer with state /s/, inner monad /m/, return /a/-newtype StateT s m a = StateT-  { runStateT :: s -> m (a, s)-  -- ^ Unwrap a transformer computation with an initial state-  }--instance (Monad m) => Functor (StateT s m) where-  fmap = liftM--instance (Monad m) => Applicative (StateT s m) where-  pure a = StateT $ \s -> pure (a, s)-  (<*>) = ap--instance (Monad m, Alternative m) => Alternative (StateT s m) where-  empty = StateT $ const empty-  m <|> n = StateT $ \s -> runStateT m s <|> runStateT n s--instance (Monad m) => Monad (StateT s m) where-  m >>= k = StateT $ \s -> runStateT m s >>= (\(a, s') -> runStateT (k a) s')--instance MonadTrans (StateT s) where-  lift m = StateT $ \s -> (\a -> (a, s)) <$> m--instance (MonadFail m) => MonadFail (StateT s m) where-  fail = StateT . const . fail--instance (MonadIO m) => MonadIO (StateT s m) where-  liftIO = lift . liftIO---- Operations---- | Fetch the current state-get :: (Monad m) => StateT s m s-get = StateT $ \s -> pure (s, s)---- | Update the current state with an operation-modify :: (Monad m) => (s -> s) -> StateT s m ()-modify f = StateT $ \s -> pure ((), f s)---- | Overwrite the current state with a value-put :: (Monad m) => s -> StateT s m ()-put s = StateT . const $ pure ((), s)

@@ -0,0 +1,95 @@+-- | Extend a monad with an accumulative write-only environment+module Mini.Transformers.Writer (+  -- * Type+  WriterT (+    WriterT+  ),+  runWriterT,++  -- * Operations+  tell,+) where++import Control.Applicative (+  Alternative,+  empty,+  (<|>),+ )+import Control.Monad (+  ap,+  liftM,+ )+import Control.Monad.IO.Class (+  MonadIO,+  liftIO,+ )+import Data.Bifunctor (+  first,+ )+import Mini.Random.Class (+  Random,+  random,+ )+import Mini.Transformers.Class (+  MonadTrans,+  lift,+ )+import Prelude (+  Applicative,+  Functor,+  Monad,+  MonadFail,+  Monoid,+  fail,+  fmap,+  mempty,+  pure,+  ($),+  (.),+  (<*>),+  (<>),+  (>>=),+ )++-- Type++-- | A transformer with monoidal write-only /w/, inner monad /m/, return /a/+newtype WriterT w m a = WriterT+  { runWriterT :: m (a, w)+  -- ^ Unwrap a transformer computation+  }++instance (Monad m, Monoid w) => Functor (WriterT w m) where+  fmap = liftM++instance (Monad m, Monoid w) => Applicative (WriterT w m) where+  pure a = WriterT $ pure (a, mempty)+  (<*>) = ap++instance (Monad m, Alternative m, Monoid w) => Alternative (WriterT w m) where+  empty = WriterT empty+  m <|> n = WriterT $ runWriterT m <|> runWriterT n++instance (Monad m, Monoid w) => Monad (WriterT w m) where+  m >>= k = WriterT $ do+    (a, w) <- runWriterT m+    (b, w') <- runWriterT (k a)+    pure (b, w <> w')++instance (Monoid w) => MonadTrans (WriterT w) where+  lift = WriterT . fmap (\a -> (a, mempty))++instance (MonadFail m, Monoid w) => MonadFail (WriterT w m) where+  fail = WriterT . fail++instance (MonadIO m, Monoid w) => MonadIO (WriterT w m) where+  liftIO = lift . liftIO++instance (Monad m, Monoid w, Random a) => Random (WriterT w m a) where+  random = first pure . random++-- Operations++-- | Append a value to the write-only environment+tell :: (Monad m) => w -> WriterT w m ()+tell w = WriterT $ pure ((), w)

@@ -1,85 +0,0 @@--- | Extend a monad with an accumulative write-only environment-module Mini.Transformers.WriterT (-  -- * Type-  WriterT (-    WriterT-  ),-  runWriterT,--  -- * Operations-  tell,-) where--import Control.Applicative (-  Alternative,-  empty,-  (<|>),- )-import Control.Monad (-  ap,-  liftM,- )-import Control.Monad.IO.Class (-  MonadIO,-  liftIO,- )-import Mini.Transformers.Class (-  MonadTrans,-  lift,- )-import Prelude (-  Applicative,-  Functor,-  Monad,-  MonadFail,-  Monoid,-  fail,-  fmap,-  mempty,-  pure,-  ($),-  (.),-  (<*>),-  (<>),-  (>>=),- )---- Type---- | A transformer with monoidal write-only /w/, inner monad /m/, return /a/-newtype WriterT w m a = WriterT-  { runWriterT :: m (a, w)-  -- ^ Unwrap a transformer computation-  }--instance (Monad m, Monoid w) => Functor (WriterT w m) where-  fmap = liftM--instance (Monad m, Monoid w) => Applicative (WriterT w m) where-  pure a = WriterT $ pure (a, mempty)-  (<*>) = ap--instance (Monad m, Alternative m, Monoid w) => Alternative (WriterT w m) where-  empty = WriterT empty-  m <|> n = WriterT $ runWriterT m <|> runWriterT n--instance (Monad m, Monoid w) => Monad (WriterT w m) where-  m >>= k = WriterT $ do-    (a, w) <- runWriterT m-    (b, w') <- runWriterT (k a)-    pure (b, w <> w')--instance (Monoid w) => MonadTrans (WriterT w) where-  lift = WriterT . fmap (\a -> (a, mempty))--instance (MonadFail m, Monoid w) => MonadFail (WriterT w m) where-  fail = WriterT . fail--instance (MonadIO m, Monoid w) => MonadIO (WriterT w m) where-  liftIO = lift . liftIO---- Operations---- | Append a value to the write-only environment-tell :: (Monad m) => w -> WriterT w m ()-tell w = WriterT $ pure ((), w)