exotic-list-monads 1.0.1 → 1.1.0

raw patch · 6 files changed

+516/−73 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +12/−0
• README.md +9/−2
• exotic-list-monads.cabal +1/−1
• src/Control/Monad/List/Exotic.hs +410/−49
• src/Control/Monad/List/NonEmpty/Exotic.hs +1/−1
• test/Control/Monad/List/ExoticSpec.hs +83/−20

@@ -1,5 +1,17 @@ # exotic-list-monad changelog +## v1.1.0++- Add the AtMost monad++- Add the NumericalMonoidMonad monad++- Fixed the documentation to make Mini and Odd instances of NumericalMonoidMonad++- Add AtLeast as another instance of NumericalMonoidMonad++- Add the ContinuumOfMonads construction+ ## v1.0.1  - Fixes in documentation

@@ -2,6 +2,13 @@  The usual [list monad](https://hackage.haskell.org/package/base-4.14.0.0/docs/src/GHC.Base.html#line-1133) is only one of infinitely many ways to turn the list functor into a monad. The same applies to the usual [non-empty list monad](https://hackage.haskell.org/package/base-4.14.0.0/docs/src/GHC.Base.html#line-1105) and the non-empty list functor. This library collects such non-standard "list" and "non-empty list" monads. -Most of the constructions implemented in this library have been first introduced in the paper [Degrading lists](degrading-lists.pdf) by Dylan McDermott, Maciej Piróg, and Tarmo Uustalu (PPDP 2020), but there are some new specimens as well.- It is quite possible that there exist "list" and "non-empty list" monads that we are not aware of, so pull requests are appreciated. Moreover, not every monad in this library has been formally verified to be a monad (it is not a trivial task because of combinatorial explosions of the number of cases to be considered in some proofs of associativity), so if you're currently playing around with tools like Coq and have a spare afternoon...++Most of the monads defined in this module have been introduced in the following papers (although there are some new specimens as well):++* [Degrading Lists](https://raw.githubusercontent.com/maciejpirog/exotic-list-monads/master/degrading-lists.pdf) by Dylan McDermott, Maciej Piróg, Tarmo Uustalu (PPDP 2020),++* [Counting Monads on Lists](https://cla.tcs.uj.edu.pl/pdfs/McDermott-Pirog-Uustalu-Abstract.pdf) by Dylan McDermott, Maciej Piróg, Tarmo Uustalu (CLA 2023),++* [Hybrid Programs](http://alfa.di.uminho.pt/~nevrenato/pdfs/thesis.pdf) by Renato Neves (PhD Thesis, 2018).+

@@ -7,7 +7,7 @@ -- hash: 5b5385de8f22ca1f51a19de7b8b393b9012fded676d9ea7412ac96fde7fc9d83  name:           exotic-list-monads-version:        1.0.1+version:        1.1.0 synopsis:       Non-standard monads on lists and non-empty lists description:    The usual list monad is only one of infinitely many ways to turn the list functor into a monad. The same applies to the usual non-empty list monad and the non-empty list functor. This library collects such non-standard "list" and "non-empty list" monads. category:       List, Monads

@@ -14,6 +14,10 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE PartialTypeSignatures #-} +{-# LANGUAGE AllowAmbiguousTypes #-} -- these are needed for numerical monoids+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeApplications #-}+ -- The following two extensions are used only in examples:  -- {-# LANGUAGE OverloadedLists #-}@@ -30,9 +34,7 @@ -- -- The usual list monad is only one of infinitely many ways to turn -- the List functor into a monad. This module collects a number of--- such exotic "list monads". Most of them have been introduced in the--- paper [Degrading Lists](https://raw.githubusercontent.com/maciejpirog/exotic-list-monads/master/degrading-lists.pdf)--- by Dylan McDermott, Maciej Piróg, Tarmo Uustalu (PPDP 2020).+-- such non-standard "list" monads. -- -- __Notes:__ --@@ -40,16 +42,16 @@ -- monads (yet), though they were thoroughly tested with billions of -- QuickCheck tests. ----- * Monads in this module are presented in terms of @join@ rather--- than '>>='. In each case 'return' is singleton (it is not known if+-- * Monads in this module are defined in terms of @join@ rather than+-- '>>='. The 'return' of every monad is singleton (it is not known if -- there exists a monad on lists with a different return). -- -- * For readability, code snippets in this documentation assume the--- @OverloadedLists@ and @OverloadedStrings@ extensions, which allow--- us to omit some @newtype@ constructors. Example definitions of--- joins of monads always skip the @newtype@ constructors, that is,--- assume '>>=' is always defined as follows for a particular local--- @join@:+-- @OverloadedLists@ and @OverloadedStrings@ language extensions,+-- which make it possible to omit some @newtype@ constructors. Example+-- definitions of joins of monads always skip the @newtype@+-- constructors, that is, assume '>>=' is always defined as follows+-- for a particular local @join@: -- -- @ -- m '>>=' f = 'wrap' $ join $ 'map' ('unwrap' . f) $ 'unwrap' m@@ -61,6 +63,20 @@ -- run-time performance. This is because the monads in this module -- don't seem to be of any practical use, they are more of a -- theoretical curiosity.+--+-- __References:__+--+-- Most of the monads defined in this module have been introduced in+-- the following papers (although there are some new specimens as+-- well):+-- +-- * [Degrading Lists](https://raw.githubusercontent.com/maciejpirog/exotic-list-monads/master/degrading-lists.pdf)+-- by Dylan McDermott, Maciej Piróg, Tarmo Uustalu (PPDP 2020),+-- +-- * [Counting Monads on Lists](https://cla.tcs.uj.edu.pl/pdfs/McDermott-Pirog-Uustalu-Abstract.pdf)+-- by Dylan McDermott, Maciej Piróg, Tarmo Uustalu (CLA 2023),+--+-- * [Hybrid Programs](http://alfa.di.uminho.pt/~nevrenato/pdfs/thesis.pdf) by Renato Neves (PhD Thesis, 2018). module Control.Monad.List.Exotic   (   -- * List monads in general@@ -116,22 +132,44 @@   , StutterStutterAlgebra   , StutterStutter(..) -  -- * Other monads+  -- * Monads from numerical monoids -  -- $no_finite_presentation+  -- $numerical_monoids      -- ** The Mini monad    , Mini(..)   -  -- ** The Odd monad (?)+  -- ** The Odd monad    , Odd(..)++  -- ** The At Least monad++  , AtLeast(..)++  -- ** The Numerical Monoid monad++  , NumericalMonoidGenerators(..)+  , NumericalMonoidMonad(..)   +  -- * Other list monads++  -- ** The At Most monad++  , AtMost(..)++  -- ** The Continuum-of-Monads monad++  -- $continuum-monads++  , SetOfNats(..)+  , ContinuumOfMonads(..)+     -- ** The Short Stutter-Keeper monad (?)    , ShortStutterKeeper(..)-  +   ) where  import Prelude hiding ((<>))@@ -218,7 +256,7 @@ -- binary and one nullary operation, that is, each is a subclass of -- "PointedMagma" with additional laws. (So does the usual list monad, -- where the subclass is monoid.) It is not known if there exists a--- list monad that have a finite presentation but necessarily with a+-- list monad that has a finite presentation but necessarily with a -- different set of operations (there are such monads on non-empty -- lists, for example, 'Control.Monad.List.NonEmpty.Exotic.HeadTails' -- and 'Control.Monad.List.NonEmpty.Exotic.HeadsTail').@@ -488,9 +526,6 @@ -- DiscreteHybrid "ynOrbison" -- >>> join ["Roy", "", "Orbison"] :: DiscreteHybrid Char -- DiscreteHybrid "yOrbison"------ Different versions of hybrid monads originate from Renato Neves's--- [PhD thesis](http://alfa.di.uminho.pt/~nevrenato/pdfs/thesis.pdf). newtype DiscreteHybrid a = DiscreteHybrid { unDiscreteHybrid :: [a] }  deriving (Functor, Show, Eq) @@ -685,14 +720,6 @@  instance (KnownNat n) => FreeRBPM (Stutter n) (StutterAlgebra n) --- $no_finite_presentation------ While all list monads have presentations in terms of operations and--- equations, some require infinitely many operations. This section--- contains monads that are either known to require infinitely many--- operations, or those for which no finite presentation is known, but--- we don't know for sure that such a presentation doesn't exist.- ------------------------------ -- The Stutter-Keeper monad -- ------------------------------@@ -853,19 +880,62 @@ instance (KnownNat n, KnownNat m)   => FreeRBPM (StutterStutter n m) (StutterStutterAlgebra n m) +-- $numerical_monoids+-- +-- A /numerical monoid/ is a subset of the set of natural numbers that+-- contains 0 and is closed under addition. That is,+-- \(M \subseteq \mathbb N\)+-- is a numerical monoid if+--+--  * \(0 \in M\),+--+--  * if \(x,y \in M\), then \(x+y \in M\).+--+-- Representing a numerical monoid \(M\) using its characteristic+-- function @m :: Int -> Bool@ (revealing if a given number belongs to+-- \(M\)), we can define a monad as follows:+--+-- @+-- join xss | isSingle xss || all isSingle xss                         = concat xss+--          | null xss || any null xss                                 = []+--          | m (length xss - 1) && all (\\xs -> m $ length xs - 1) xss = concat xss+--          | otherwise                                                = []+-- @+--+-- There is also some intuition behind the "@- 1@" part: For a set \(M \subseteq \mathbb N\),+-- we define a set shifted by 1 as \(M^{+} =\{x \in \mathbb N \ |\ x-1 \in M\}\).+-- Then, \(M\) is a numerical monoid if and only if:+--+-- * \(1 \in M^{+}\),+--+-- * if \(n, x_1, \ldots, x_n \in M^{+}\), then \(\displaystyle \sum_{i = 0}^n x_i \in M^{+}\).+--+-- (Do note that in the above \(n\) is in \(M^{+}\) as well!) This+-- means that \(M^{+}\) is a set of "accepted lengths" of lists, while+-- the condition above states that when we concatenate an accepted+-- number of accepted lists, we still obtain an accepted list. This in+-- turn can be used to prove the associativity law for monads: breadly+-- speaking, @join :: [[[a]]] -> [a]@ is a concat only if all the+-- lists on all levels are of accepted lengths (save for the unit+-- laws), and joining (either the inner lists or the outer list first)+-- will not produce a non-accepted list.+--+-- Below, we first show a couple of concrete examples of monads+-- arising from particular numerical monoids, and then the general+-- version via a set of generators.+ -------------------- -- The Mini monad -- -------------------- --- | The Mini monad is the minimal list monad, meaning that its join--- fails (= results in an empty list) for all values except the ones--- that appear in the unit laws (i.e., a singleton or a list of--- singletons):+-- | The Mini monad is, in a sense, a minimal list monad, meaning that+-- its join fails (= results in an empty list) for all values except+-- the ones that appear in the unit laws (i.e., a singleton or a list+-- of singletons): -- -- @--- join xss | isSingle xss     = concat xss---          | all isSingle xss = concat xss---          | otherwise        = []+-- join xss | isSingle xss || all isSingle xss = concat xss+--          | otherwise                        = [] -- @ -- -- For example:@@ -874,7 +944,11 @@ -- Mini "HelloThere" -- >>> join ["Hello", "There"] :: Mini Char -- Mini ""+-- >>> join ["H", "T"] :: Mini Char+-- Mini "HT" --+-- This monad arises from the numerical monoid \(\{0\}\).+-- -- It does not arise from a subclass of 'PointedMagma' (or any -- algebraic theory with a finite number of operations for that  -- matter).@@ -891,10 +965,8 @@   return x = Mini [x]   Mini xs >>= f = Mini $ join $ map (unMini . f) xs     where-    join xss | isSingle xss || all isSingle xss-             = concat xss-             | otherwise-             = []+    join xss | isSingle xss || all isSingle xss = concat xss+             | otherwise                        = []  instance IsList (Mini a) where   type Item (Mini a) = a@@ -913,11 +985,10 @@ -- laws), it returns an empty list. -- -- @--- join xss | isSingle xss               = concat xss---          | all isSingle xss           = concat xss+-- join xss | isSingle xss || all isSingle xss  = concat xss --          | odd (length xss)---             && all (odd . length) xss = concat xss ---          | otherwise                  = []+--             && all (odd . length) xss        = concat xss +--          | otherwise                         = [] -- @ -- -- For example:@@ -929,8 +1000,11 @@ -- >>> join ["Roy", "Kelton", "Orbison"] :: Odd Char -- Odd "" --+-- It arises from the numerical monoid \(\{0,2,4,6,\ldots\}\). -- Note that the sum of even numbers is always even, which cannot be said of odd numbers!+--+-- -- At the moment, it is unclear whether it comes from a finite--- algebraic theory (or that it is indeed a monad).+-- algebraic theory. newtype Odd a = Odd { unOdd :: [a] }  deriving (Functor, Show, Eq) @@ -958,6 +1032,291 @@  instance ListMonad Odd +------------------------+-- The At Least monad --+------------------------++-- | The join of the @AtLeast n@ monad is a concat of the inner lists+-- provided there are at least @n@ inner lists and all the inner lists+-- are of length at least @n@ or 1 (plus the cases required by the+-- unit laws).+--+-- The join can thus be defined as follows (omitting the conversion of+-- the type-level nats to run-time values):+--+-- @+-- join xss | isSingle xss || all isSingle xss  = concat xss+--          | otherwise = let ok :: forall x. [x] -> Bool+--                            ok xs = length xs >= n || length xs == 1+--                        in if ok xss && all ok xss+--                             then concat xss+--                             else []+-- @+--+-- For example:+--+-- >>> join ["Strawberry", "Fields", "Forever"] :: AtLeast 3 Char+-- AtLeast "StrawberryFieldsForever"+-- >>> join ["All", "You", "Need", "Is", "Love"] :: AtLeast 3 Char+-- AtLeast []+-- >>> join ["I", "Want", "You"] :: AtLeast 3 Char+-- AtLeast "IWantYou"+-- >>> join ["I", "Am", "The", "Walrus"] :: AtLeast 3 Char+-- AtLeast []+--+-- The monad @AtLeast n@ arises from the numerical monoid \(\{0, n-1, n, n+1, n+2,\ldots\}\).+newtype AtLeast (n :: Nat) a = AtLeast { unAtLeast :: [a] }+ deriving (Functor, Show, Eq)++deriving instance (KnownNat n) => IsString (AtLeast n Char)++instance (KnownNat n) => Applicative (AtLeast n) where+  pure  = return+  (<*>) = ap++instance (KnownNat n) => Monad (AtLeast n) where+  return x = AtLeast [x]+  AtLeast xs >>= f = AtLeast $ join $ map (unAtLeast . f) xs +   where+    join xss | isSingle xss     = concat xss+             | all isSingle xss = concat xss+             | otherwise        = let n = fromIntegral $ natVal (Proxy :: Proxy n)+                                      ok :: forall x. [x] -> Bool+                                      ok xs = length xs >= n || length xs == 1+                                  in if ok xss && all ok xss+                                       then concat xss+                                       else []++instance (KnownNat n) => IsList (AtLeast n a) where+  type Item (AtLeast n a) = a+  toList   = unAtLeast+  fromList = AtLeast++instance (KnownNat n) => ListMonad (AtLeast n)++--------------------------------+-- The Numerical Monoid monad --+--------------------------------++-- | An interesting property of numerical monoids is that they are+-- always finitely generated. This means that every numerical monoid+-- can be constructed by starting out with a finite set of nautral+-- numbers and closing it under addition. For example, the set+-- \(\{0,2,4,6,\ldots\}\) is generated by \(\{2\}\), because every+-- even number is of the form \(2k\) for some \(k\).+--+-- The class @'NumericalMonoidGenerators'@ represents a set of+-- generators given as a type-level list of nats.+class NumericalMonoidGenerators (ns :: [Nat]) where+  -- | Check if a given number is in the numerical monoid generatted+  -- by @ns@. It is the characteristic function of the generated+  -- numerical monoid.+  isInNumericalMonoid :: Int -> Bool++instance NumericalMonoidGenerators '[] where+  isInNumericalMonoid = (== 0)++instance (KnownNat g, NumericalMonoidGenerators gs) => NumericalMonoidGenerators (g ': gs) where+  isInNumericalMonoid x+     | x < 0     = False+     | otherwise =  isInNumericalMonoid @gs x+                 || x >= g && g > 0 && isInNumericalMonoid @(g ': gs) (x - g)+   where+    g = fromIntegral $ natVal (Proxy :: Proxy g)++-- | The monad generated by the numerical monoid generated by a set of generators @ns@.+--+-- @+-- join xss | null xss || any null xss                                     = []+--          | isInNumericalMonoid \@ns (length xss - 1)+--             && all (\\xs -> isInNumericalMonoid \@ns (length xs - 1)) xss = concat xss+--          | otherwise                                                    = []+-- @+--+-- In particular:+--+-- * @'Mini'@ is equivalent to @NumericalMonoidMonad '[]@,+--+-- * @'GlobalFailure'@ is equivalent to @NumericalMonoidMonad '[1]@,+--+-- * @'Odd'@ is equivalent to @NumericalMonoidMonad '[2]@,+--+-- * @'AtLeast' n@ is equivalent to @NumericalMonoidMonad '[n-1, n, n+1, ..., 2n-3]@.+newtype NumericalMonoidMonad (ns :: [Nat]) a = NumericalMonoidMonad { unNumericalMonoidMonad :: [a] }+ deriving (Functor, Show, Eq)++deriving instance IsString (NumericalMonoidMonad ns Char)++instance (NumericalMonoidGenerators ns) => Applicative (NumericalMonoidMonad ns) where+  pure  = return+  (<*>) = ap++instance (NumericalMonoidGenerators ns) => Monad (NumericalMonoidMonad ns) where+  return x = NumericalMonoidMonad [x]+  NumericalMonoidMonad xs >>= f = NumericalMonoidMonad $ join $ map (unNumericalMonoidMonad . f) xs +   where+    join xss | isSingle xss || all isSingle xss                          = concat xss+             | null xss || any null xss                                  = []+             | isInNumericalMonoid @ns (length xss - 1)+             && all (\xs -> isInNumericalMonoid @ns (length xs - 1)) xss = concat xss+             | otherwise                                                 = []++instance IsList (NumericalMonoidMonad ns a) where+  type Item (NumericalMonoidMonad ns a) = a+  toList   = unNumericalMonoidMonad+  fromList = NumericalMonoidMonad++instance (NumericalMonoidGenerators ns) => ListMonad (NumericalMonoidMonad ns)++-----------------------+-- The At Most monad --+-----------------------++-- | The monad whose join is concat, but only if the total length of+-- the list (that is, the sum of the lengths of the inner lists) is+-- not greater than @n@ (except for the unit laws and the "global+-- failure" property):+--+-- @+-- join xss | isSingle xss || all isSingle xss = concat xss+--          | any null xss                     = []+--          | length (concat xss) <= n         = concat xss+--          | otherwise                        = []+-- @+--+-- For example:+--+-- >>> join ["El","vis"] :: AtMost 5 Char+-- AtMost "Elvis"+-- >>> join ["El","v","i"] :: AtMost 5 Char+-- AtMost "Elvi"+-- >>> join ["El","","vis"] :: AtMost 5 Char+-- AtMost ""+-- >>> join ["Presley"] :: AtMost 5 Char+-- AtMost "Presley"+-- >>> join ["P","r","e","s","l","e","y"] :: AtMost 5 Char+-- AtMost "Presley"+-- >>> join ["Pre","s","ley"] :: AtMost 5 Char+-- AtMost ""+newtype AtMost (n :: Nat) a = AtMost { unAtMost :: [a] }+ deriving (Functor, Show, Eq)++deriving instance (KnownNat n) => IsString (AtMost n Char)++instance (KnownNat n) => Applicative (AtMost n) where+  pure  = return+  (<*>) = ap++instance (KnownNat n) => Monad (AtMost n) where+  return x = AtMost [x]+  AtMost xs >>= f = AtMost $ join $ map (unAtMost . f) xs +   where+    join xss | isSingle xss || all isSingle xss                                = concat xss+             | any null xss                                                    = []+             | length (concat xss) <= fromIntegral (natVal (Proxy :: Proxy n)) = concat xss+             | otherwise                                                       = []++instance (KnownNat n) => IsList (AtMost n a) where+  type Item (AtMost n a) = a+  toList   = unAtMost+  fromList = AtMost++instance (KnownNat n) => ListMonad (AtMost n)++-----------------------------------+-- The Continuum-of-Monads monad --+-----------------------------------++-- $continuum-monads+--+-- The "Continuum of Monads" monad construction was introduced in+-- [this+-- paper](https://cla.tcs.uj.edu.pl/pdfs/McDermott-Pirog-Uustalu-Abstract.pdf)+-- to show that the set of list monads is a+-- [continuum](https://en.wikipedia.org/wiki/Cardinality_of_the_continuum)+-- (that is, that there are as many list monads in the category of+-- sets as there are real numbers, and more than there are natural+-- numbers).+--+-- We define a family of monads @'ContinuumOfMonads'@, which is+-- parameterised by a subset of the set of natural numbers+-- (@'SetOfNats'@).++-- | The @SetOfNats@ class defines a subset of the set of natural+-- numbers (from which we are actually interested in odd numbers+-- only). We give two instances, @Primes@ and @Fib@, as examples, so+-- if one wants to construct their own monad, they need to define an+-- instance first: any total @'elemOf'@ gives a monad.+--+-- For example:+--+-- >>> filter (elemOf @"Primes") [0..100]+-- [2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97]+-- >>> filter (elemOf @"Fib") [0..100]+-- [0,1,2,3,5,8,13,21,34,55,89]+class SetOfNats (a :: Symbol) where+  -- | The characteristic function of the defined set.+  elemOf :: Int -> Bool++-- Example sets:++primes :: [Int]+primes = sieve [2..] where sieve ps = head ps : sieve [x | x <- tail ps, x `mod` head ps > 0]++-- | The set of prime numbers.+instance SetOfNats "Primes" where elemOf n = n `elem` takeWhile (<= n) primes++fib :: [Int]+fib = 0 : 1 : zipWith (+) fib (tail fib)++-- | The set of Fibonacci numbers.+instance SetOfNats "Fib" where elemOf n = n `elem` takeWhile (<= n) fib++-- | The @'ContinuumOfMonads'@ monad is parameterised by a set of+-- natural numbers (a symbol that instantiates @'SetOfNats'@).+--+-- The @join@ of @ContinuumOfMonads s@ is defined as follows:+--+-- @+-- join xss       | isSingle xss    || all isSingle xss      = concat xss+--                | null xss        || any null xss          = []+-- join [[x], xs] | odd (length xs) && elemOf @s (length xs) = x : xs+-- join _                                                    = []+-- @+--+-- For example:+--+-- >>> join [[0],[1,2,3]] :: ContinuumOfMonads "Primes" Int+-- ContinuumOfMonads [0,1,2,3]+-- >>> join [[0],[1,2,3,4]] :: ContinuumOfMonads "Primes" Int+-- ContinuumOfMonads []+-- >>> join [[0,1],[1,2,3,4,5]] :: ContinuumOfMonads "Primes" Int+-- ContinuumOfMonads []+newtype ContinuumOfMonads (s :: Symbol) a = ContinuumOfMonads { unContinuumOfMonads :: [a] }+ deriving (Functor, Show, Eq)++deriving instance IsString (ContinuumOfMonads s Char)++instance (SetOfNats s) => Applicative (ContinuumOfMonads s) where+  pure  = return+  (<*>) = ap++instance (SetOfNats s) => Monad (ContinuumOfMonads s) where+  return x = ContinuumOfMonads [x]+  ContinuumOfMonads xs >>= f = ContinuumOfMonads $ join $ map (unContinuumOfMonads . f) xs +   where+    join xss | isSingle xss || all isSingle xss               = concat xss+             | null xss || any null xss                       = []+    join [[x], xs] | odd (length xs) && elemOf @s (length xs) = x : xs+    join _                                                    = []++instance IsList (ContinuumOfMonads s a) where+  type Item (ContinuumOfMonads s a) = a+  toList   = unContinuumOfMonads+  fromList = ContinuumOfMonads++instance (SetOfNats s) => ListMonad (ContinuumOfMonads s)+ ------------------------------------ -- The Short Stutter-Keeper monad -- ------------------------------------@@ -999,13 +1358,15 @@ instance (KnownNat n, KnownNat p) => Monad (ShortStutterKeeper n p) where   return x = ShortStutterKeeper [x]   ShortStutterKeeper xs >>= f = ShortStutterKeeper $ join $ map (unShortStutterKeeper . f) xs-   where join xss | isSingle xss = concat xss-                  | all isSingle xss = concat xss-                  | otherwise-                  = let p = fromIntegral $ natVal (Proxy :: Proxy p)-                    in  take (p + 2) $ toList-                        ((Control.Monad.join $ StutterKeeper $ fmap StutterKeeper xss)-                          :: StutterKeeper n _)+   where+    join :: forall x. [[x]] -> [x]+    join xss | isSingle xss = concat xss+             | all isSingle xss = concat xss+             | otherwise =+                  let p = fromIntegral $ natVal (Proxy :: Proxy p)+                  in  take (p + 2) $ toList+                      ((Control.Monad.join $ StutterKeeper $ fmap StutterKeeper xss)+                        :: StutterKeeper n x)  instance (KnownNat n, KnownNat p) => IsList (ShortStutterKeeper n p a) where   type Item (ShortStutterKeeper n p a) = a

@@ -693,7 +693,7 @@ foldHeadTails f (HeadTails (x :| [])) = hd (f x) foldHeadTails f (HeadTails (x :| (y : ys))) =   htt (f x) (f y) (foldHeadTails f $ HeadTails $ y :| ys)-  + -- The following two are needed for examples in the docs:  instance IsList (HeadTails a) where

@@ -8,6 +8,7 @@ {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}  {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -26,27 +27,20 @@ deriving instance (Arbitrary a) => Arbitrary (MazeWalk a) deriving instance (Arbitrary a) => Arbitrary (DiscreteHybrid a) deriving instance (Arbitrary a) => Arbitrary (ListUnfold a)-deriving instance (Arbitrary a) => Arbitrary (Stutter 0 a)-deriving instance (Arbitrary a) => Arbitrary (Stutter 1 a)-deriving instance (Arbitrary a) => Arbitrary (Stutter 5 a)-deriving instance (Arbitrary a) => Arbitrary (StutterKeeper 0 a)-deriving instance (Arbitrary a) => Arbitrary (StutterKeeper 1 a)-deriving instance (Arbitrary a) => Arbitrary (StutterKeeper 5 a)-deriving instance (Arbitrary a) => Arbitrary (StutterStutter 0 0 a)-deriving instance (Arbitrary a) => Arbitrary (StutterStutter 0 1 a)-deriving instance (Arbitrary a) => Arbitrary (StutterStutter 1 0 a)-deriving instance (Arbitrary a) => Arbitrary (StutterStutter 1 1 a)-deriving instance (Arbitrary a) => Arbitrary (StutterStutter 5 3 a)-deriving instance (Arbitrary a) => Arbitrary (StutterStutter 3 5 a)+deriving instance (Arbitrary a) => Arbitrary (Stutter m a)+deriving instance (Arbitrary a) => Arbitrary (StutterKeeper m a)+deriving instance (Arbitrary a) => Arbitrary (StutterStutter m n a) deriving instance (Arbitrary a) => Arbitrary (Mini a) deriving instance (Arbitrary a) => Arbitrary (Odd a)-deriving instance (Arbitrary a) => Arbitrary (ShortStutterKeeper 0 0 a)-deriving instance (Arbitrary a) => Arbitrary (ShortStutterKeeper 0 1 a)-deriving instance (Arbitrary a) => Arbitrary (ShortStutterKeeper 1 0 a)-deriving instance (Arbitrary a) => Arbitrary (ShortStutterKeeper 1 1 a)-deriving instance (Arbitrary a) => Arbitrary (ShortStutterKeeper 5 3 a)-deriving instance (Arbitrary a) => Arbitrary (ShortStutterKeeper 3 5 a)+deriving instance (Arbitrary a) => Arbitrary (AtLeast n a)+deriving instance (Arbitrary a) => Arbitrary (NumericalMonoidMonad xs a)+deriving instance (Arbitrary a) => Arbitrary (AtMost n a)+deriving instance (Arbitrary a) => Arbitrary (ContinuumOfMonads s a)+deriving instance (Arbitrary a) => Arbitrary (ShortStutterKeeper m n a) +assocTests :: Int+assocTests = 250+ testMonad :: forall m. (Eq (Item (m Int)), ListMonad m, Arbitrary (m Int),                         Arbitrary (m (m (m Int))),                         IsList (m Int),@@ -58,11 +52,32 @@       \xs -> toList (join (fmap return xs)) == toList ((xs :: m Int))      it "right unit:" $ property $       \xs -> toList (join (return xs))      == toList ((xs :: m Int))-    modifyMaxSuccess (const 150) $ it "associativity:" $ property $+    modifyMaxSuccess (const assocTests) $ it "associativity:" $ property $       \xsss -> toList (join (join xsss))    == toList (join (fmap join xsss) :: m Int)-      ++testMonadIsomorphism :: forall m n. (Eq (Item (m Int)), ListMonad m, Arbitrary (m Int),+                        Arbitrary (m (m Int)),+                        IsList (m Int),+                        Show (m Int), Show (m (m Int)),+                        Eq (Item (n Int)), ListMonad n, Arbitrary (n Int),+                        Arbitrary (n (n Int)),+                        IsList (n Int),+                        Show (n Int), Show (n (n Int)))+          => String -> String -> Proxy m -> Proxy n -> (forall a. m a -> n a) -> (forall a. n a -> m a) -> SpecWith ()+testMonadIsomorphism name name' _ _ f g =+  describe (name ++ " and " ++ name' ++ " are isomorphic as monads") $ do+    it "inverse:" $ property $+      \xs -> toList (xs :: m Int) == toList (g (f xs))+    it "other inverse:" $ property $+      \xs -> toList (xs :: n Int) == toList (f (g xs))+    it "homomorphism:" $ property $+      \xs -> toList (join (xs :: m (m (Int)))) == toList (g (join (f (fmap f xs))))+    it "other homomorphism:" $ property $+      \xs -> toList (join (xs :: n (n (Int)))) == toList (f (join (g (fmap g xs))))+ spec :: Spec spec = do+     describe "palindromize" $ do     it "palindromizes a non-empty list" $       palindromize "abcd" `shouldBe` "abcdcba"@@ -115,23 +130,71 @@       $ property $ \(x :: ListUnfold Int)     -> eps <> x       ==  eps     it                                          "(x <> y) <> z  ==  eps"       $ property $ \(x :: ListUnfold Int) y z -> (x <> y) <> z  ==  eps+         testMonad  "Stutter 1"          (Proxy :: Proxy (Stutter 0))   testMonad  "Stutter 2"          (Proxy :: Proxy (Stutter 1))   testMonad  "Stutter 5"          (Proxy :: Proxy (Stutter 5))+   testMonad  "StutterKeeper 0"    (Proxy :: Proxy (StutterKeeper 0))   testMonad  "StutterKeeper 1"    (Proxy :: Proxy (StutterKeeper 1))+  testMonad  "StutterKeeper 2"    (Proxy :: Proxy (StutterKeeper 2))+  testMonad  "StutterKeeper 3"    (Proxy :: Proxy (StutterKeeper 3))+  testMonad  "StutterKeeper 4"    (Proxy :: Proxy (StutterKeeper 4))   testMonad  "StutterKeeper 5"    (Proxy :: Proxy (StutterKeeper 5))+  testMonad  "StutterKeeper 10"   (Proxy :: Proxy (StutterKeeper 10))+     testMonad  "StutterStutter 0 0" (Proxy :: Proxy (StutterStutter 0 0))   testMonad  "StutterStutter 0 1" (Proxy :: Proxy (StutterStutter 0 1))   testMonad  "StutterStutter 1 0" (Proxy :: Proxy (StutterStutter 1 0))   testMonad  "StutterStutter 1 1" (Proxy :: Proxy (StutterStutter 1 1))   testMonad  "StutterStutter 5 3" (Proxy :: Proxy (StutterStutter 5 3))   testMonad  "StutterStutter 3 5" (Proxy :: Proxy (StutterStutter 3 5))+     testMonad  "Mini"               (Proxy :: Proxy Mini)   testMonad  "Odd"                (Proxy :: Proxy Odd)+  +  testMonad  "AtLeast 10"         (Proxy :: Proxy (AtLeast 10))+  testMonad  "AtLeast 4"          (Proxy :: Proxy (AtLeast 4))+  testMonad  "AtLeast 3"          (Proxy :: Proxy (AtLeast 3))+  testMonad  "AtLeast 2"          (Proxy :: Proxy (AtLeast 2))+  testMonad  "AtLeast 1"          (Proxy :: Proxy (AtLeast 1))+  testMonad  "AtLeast 0"          (Proxy :: Proxy (AtLeast 0))++  testMonadIsomorphism "AtLeast 1" "GlobalFailure" (Proxy :: Proxy (AtLeast 1)) (Proxy :: Proxy GlobalFailure) (GlobalFailure . unAtLeast) (AtLeast . unGlobalFailure)++  testMonad  "NumericalMonoidMonad []" (Proxy :: Proxy (NumericalMonoidMonad '[]))+  testMonad  "NumericalMonoidMonad [0]" (Proxy :: Proxy (NumericalMonoidMonad '[0]))+  testMonad  "NumericalMonoidMonad [1]" (Proxy :: Proxy (NumericalMonoidMonad '[1]))+  testMonad  "NumericalMonoidMonad [0,1]" (Proxy :: Proxy (NumericalMonoidMonad '[0,1]))+  testMonad  "NumericalMonoidMonad [2,7,20,22]" (Proxy :: Proxy (NumericalMonoidMonad '[2,7,20,22]))+  testMonad  "NumericalMonoidMonad [2]" (Proxy :: Proxy (NumericalMonoidMonad '[2]))+  testMonad  "NumericalMonoidMonad [3,4,5]" (Proxy :: Proxy (NumericalMonoidMonad '[3,4,5]))+  testMonad  "NumericalMonoidMonad [3,7]" (Proxy :: Proxy (NumericalMonoidMonad '[3,7]))+  testMonad  "NumericalMonoidMonad [2,4,11]" (Proxy :: Proxy (NumericalMonoidMonad '[2,4,11]))++  testMonadIsomorphism "Mini" "NumericalMonoidMonad '[]" (Proxy :: Proxy Mini) (Proxy :: Proxy (NumericalMonoidMonad '[])) (NumericalMonoidMonad . unMini) (Mini . unNumericalMonoidMonad)+  testMonadIsomorphism "Odd" "NumericalMonoidMonad '[2]" (Proxy :: Proxy Odd) (Proxy :: Proxy (NumericalMonoidMonad '[2])) (NumericalMonoidMonad . unOdd) (Odd . unNumericalMonoidMonad)+  testMonadIsomorphism "AtLeast 1" "NumericalMonoidMonad '[1]" (Proxy :: Proxy (AtLeast 3)) (Proxy :: Proxy (NumericalMonoidMonad '[2,3])) (NumericalMonoidMonad . unAtLeast) (AtLeast . unNumericalMonoidMonad)+  testMonadIsomorphism "AtLeast 3" "NumericalMonoidMonad '[2,3]" (Proxy :: Proxy (AtLeast 3)) (Proxy :: Proxy (NumericalMonoidMonad '[2,3])) (NumericalMonoidMonad . unAtLeast) (AtLeast . unNumericalMonoidMonad)+  testMonadIsomorphism "AtLeast 4" "NumericalMonoidMonad '[3,4,5]" (Proxy :: Proxy (AtLeast 4)) (Proxy :: Proxy (NumericalMonoidMonad '[3,4,5])) (NumericalMonoidMonad . unAtLeast) (AtLeast . unNumericalMonoidMonad)+  testMonadIsomorphism "AtLeast 5" "NumericalMonoidMonad '[4,5,6,7]" (Proxy :: Proxy (AtLeast 5)) (Proxy :: Proxy (NumericalMonoidMonad '[4,5,6,7])) (NumericalMonoidMonad . unAtLeast) (AtLeast . unNumericalMonoidMonad)++  testMonad  "AtMost 6"           (Proxy :: Proxy (AtMost 6))+  testMonad  "AtMost 5"           (Proxy :: Proxy (AtMost 5))+  testMonad  "AtMost 4"           (Proxy :: Proxy (AtMost 4))+  testMonad  "AtMost 3"           (Proxy :: Proxy (AtMost 3))+  testMonad  "AtMost 2"           (Proxy :: Proxy (AtMost 2))+  testMonad  "AtMost 1"           (Proxy :: Proxy (AtMost 1))+  testMonad  "AtMost 0"           (Proxy :: Proxy (AtMost 0))+  +  testMonad  "ContinuumOfMonads Primes" (Proxy :: Proxy (ContinuumOfMonads "Primes"))+  testMonad  "ContinuumOfMonads Fib" (Proxy :: Proxy (ContinuumOfMonads "Fib"))+   testMonad  "ShortStutterKeeper 0 0" (Proxy :: Proxy (ShortStutterKeeper 0 0))   testMonad  "ShortStutterKeeper 0 1" (Proxy :: Proxy (ShortStutterKeeper 0 1))   testMonad  "ShortStutterKeeper 0 1" (Proxy :: Proxy (ShortStutterKeeper 1 0))   testMonad  "ShortStutterKeeper 1 1" (Proxy :: Proxy (ShortStutterKeeper 1 1))   testMonad  "ShortStutterKeeper 5 3" (Proxy :: Proxy (ShortStutterKeeper 5 3))   testMonad  "ShortStutterKeeper 3 5" (Proxy :: Proxy (ShortStutterKeeper 3 5))++