diff --git a/README.md b/README.md
index 44a860137a38cffabcb2931a9d88c800a12b0197..5459be2938bc74aa3747565f946ecc2e6abb1d41 100644
--- a/README.md
+++ b/README.md
@@ -10,8 +10,8 @@ existing Hackage package(s).
   you submit a PR).
 
 - The patches SHOULD work with at least GHC HEAD and the most recent
-  stable released GHC version (currently this means with GHC 9.0 and
-  GHC 9.1).
+  stable released GHC version (currently this means with GHC 9.0, GHC 9.2, and
+  GHC 9.3).
 
 - The patches SHOULD ideally result in the same code being compiled,
   as one of the main purposes of these patches is to make regression
diff --git a/ci/TestPatches.hs b/ci/TestPatches.hs
index f407692ed3f20d6919cc4f8a6d82f3ce066556a1..23935a24fcc5098bcb0cf3fa19344f2348bf0009 100644
--- a/ci/TestPatches.hs
+++ b/ci/TestPatches.hs
@@ -273,9 +273,14 @@ buildPackage cfg pname version = do
               ExitSuccess -> PP.cyan "succeeded"
               ExitFailure n -> PP.red "failed" <+> PP.parens ("code" <+> pshow n)
         in "=> Build of" <+> prettyPackageVersion pname version <+> result
+      -- N.B. we remove the build directory on failure to ensure
+      -- that we re-extract the source if the user re-runs after
+      -- modifying a patch.
+      unless (code == ExitSuccess) $ removeDirectoryRecursive dirName
       return $ PackageResult (code == ExitSuccess) (mergeInfoPlan (planToBuildInfo plan) results)
     False -> do
       logMsg $ PP.red $ "=> Planning for" <+> prettyPackageVersion pname version <+> "failed"
+      removeDirectoryRecursive dirName
       return $ PackagePlanningFailed mempty
   where
     planToBuildInfo :: PlanJson -> M.Map UnitId BuildInfo
diff --git a/ci/config.sh b/ci/config.sh
index 5566066da2f96d5aedc89f35d1f2ca49d44045e5..eba4408d64de83060353e245416623f2de7995d0 100644
--- a/ci/config.sh
+++ b/ci/config.sh
@@ -74,14 +74,12 @@ case $version in
     #       package             ticket
     ;;
 
-  9.1.*)
+  9.2.*)
     #       package             ticket
-    broken  "plots"             19042
     ;;
 
-  9.2.*)
+  9.3.*)
     #       package             ticket
-    broken  "plots"             19042
     ;;
 
   *)
@@ -105,6 +103,7 @@ extra_package hgmp
 
 # Build-tool packages
 build_tool_package alex
+build_tool_package happy
 
 # Quick build configuration
 # =========================
diff --git a/patches/HTTP-4000.3.16.patch b/patches/HTTP-4000.3.16.patch
new file mode 100644
index 0000000000000000000000000000000000000000..9c74eb8c061e1fa266bd3396e2b748e645f9fa28
--- /dev/null
+++ b/patches/HTTP-4000.3.16.patch
@@ -0,0 +1,110 @@
+diff --git a/Network/HTTP/Cookie.hs b/Network/HTTP/Cookie.hs
+index 1b5175d..2c4c72e 100644
+--- a/Network/HTTP/Cookie.hs
++++ b/Network/HTTP/Cookie.hs
+@@ -3,14 +3,14 @@
+ -- Module      :  Network.HTTP.Cookie
+ -- Copyright   :  See LICENSE file
+ -- License     :  BSD
+--- 
++--
+ -- Maintainer  :  Ganesh Sittampalam <ganesh@earth.li>
+ -- Stability   :  experimental
+ -- Portability :  non-portable (not tested)
+ --
+ -- This module provides the data types and functions for working with HTTP cookies.
+ -- Right now, it contains mostly functionality needed by 'Network.Browser'.
+--- 
++--
+ -----------------------------------------------------------------------------
+ module Network.HTTP.Cookie
+        ( Cookie(..)
+@@ -24,7 +24,7 @@ module Network.HTTP.Cookie
+ import Network.HTTP.Headers
+ 
+ import Data.Char
+-import Data.List
++import Data.List (intercalate, isPrefixOf, isSuffixOf)
+ import Data.Maybe
+ 
+ import Text.ParserCombinators.Parsec
+@@ -38,8 +38,8 @@ import Text.ParserCombinators.Parsec
+ 
+ -- | @Cookie@ is the Haskell representation of HTTP cookie values.
+ -- See its relevant specs for authoritative details.
+-data Cookie 
+- = MkCookie 
++data Cookie
++ = MkCookie
+     { ckDomain  :: String
+     , ckName    :: String
+     , ckValue   :: String
+@@ -50,8 +50,8 @@ data Cookie
+     deriving(Show,Read)
+ 
+ instance Eq Cookie where
+-    a == b  =  ckDomain a == ckDomain b 
+-            && ckName a == ckName b 
++    a == b  =  ckDomain a == ckDomain b
++            && ckName a == ckName b
+             && ckPath a == ckPath b
+ 
+ -- | @cookieToHeaders ck@ serialises @Cookie@s to an HTTP request header.
+@@ -66,7 +66,7 @@ mkCookieHeaderValue = intercalate "; " . map mkCookieHeaderValue1
+     mkCookieHeaderValue1 c = ckName c ++ "=" ++ ckValue c
+ 
+ -- | @cookieMatch (domain,path) ck@ performs the standard cookie
+--- match wrt the given domain and path. 
++-- match wrt the given domain and path.
+ cookieMatch :: (String, String) -> Cookie -> Bool
+ cookieMatch (dom,path) ck =
+  ckDomain ck `isSuffixOf` dom &&
+@@ -75,13 +75,13 @@ cookieMatch (dom,path) ck =
+    Just p  -> p `isPrefixOf` path
+ 
+ 
+--- | @processCookieHeaders dom hdrs@ 
++-- | @processCookieHeaders dom hdrs@
+ processCookieHeaders :: String -> [Header] -> ([String], [Cookie])
+ processCookieHeaders dom hdrs = foldr (headerToCookies dom) ([],[]) hdrs
+ 
+--- | @headerToCookies dom hdr acc@ 
++-- | @headerToCookies dom hdr acc@
+ headerToCookies :: String -> Header -> ([String], [Cookie]) -> ([String], [Cookie])
+-headerToCookies dom (Header HdrSetCookie val) (accErr, accCookie) = 
++headerToCookies dom (Header HdrSetCookie val) (accErr, accCookie) =
+     case parse cookies "" val of
+         Left{}  -> (val:accErr, accCookie)
+         Right x -> (accErr, x ++ accCookie)
+@@ -100,11 +100,11 @@ headerToCookies dom (Header HdrSetCookie val) (accErr, accCookie) =
+           return $ mkCookie name val1 args
+ 
+    cvalue :: Parser String
+-   
++
+    spaces_l = many (satisfy isSpace)
+ 
+    cvalue = quotedstring <|> many1 (satisfy $ not . (==';')) <|> return ""
+-   
++
+    -- all keys in the result list MUST be in lower case
+    cdetail :: Parser [(String,String)]
+    cdetail = many $
+@@ -118,7 +118,7 @@ headerToCookies dom (Header HdrSetCookie val) (accErr, accCookie) =
+            )
+ 
+    mkCookie :: String -> String -> [(String,String)] -> Cookie
+-   mkCookie nm cval more = 
++   mkCookie nm cval more =
+           MkCookie { ckName    = nm
+                    , ckValue   = cval
+                    , ckDomain  = map toLower (fromMaybe dom (lookup "domain" more))
+@@ -128,7 +128,7 @@ headerToCookies dom (Header HdrSetCookie val) (accErr, accCookie) =
+                    }
+ headerToCookies _ _ acc = acc
+ 
+-      
++
+ 
+ 
+ word, quotedstring :: Parser String
diff --git a/patches/HUnit-1.6.2.0.patch b/patches/HUnit-1.6.2.0.patch
new file mode 100644
index 0000000000000000000000000000000000000000..e61960224fe7259b52afb0198fe0574f038a4e9b
--- /dev/null
+++ b/patches/HUnit-1.6.2.0.patch
@@ -0,0 +1,13 @@
+diff --git a/src/Test/HUnit/Lang.hs b/src/Test/HUnit/Lang.hs
+index 1be740d..9889803 100644
+--- a/src/Test/HUnit/Lang.hs
++++ b/src/Test/HUnit/Lang.hs
+@@ -28,7 +28,7 @@ module Test.HUnit.Lang (
+ import           Control.DeepSeq
+ import           Control.Exception as E
+ import           Control.Monad
+-import           Data.List
++import           Data.List (intercalate)
+ import           Data.Typeable
+ import           Data.CallStack
+ 
diff --git a/patches/QuickCheck-2.14.2.patch b/patches/QuickCheck-2.14.2.patch
new file mode 100644
index 0000000000000000000000000000000000000000..bf89e00043f1e08a3d596512bea7eb638c3a7824
--- /dev/null
+++ b/patches/QuickCheck-2.14.2.patch
@@ -0,0 +1,52 @@
+diff --git a/src/Test/QuickCheck/All.hs b/src/Test/QuickCheck/All.hs
+index f9c0fbb..57d4f89 100644
+--- a/src/Test/QuickCheck/All.hs
++++ b/src/Test/QuickCheck/All.hs
+@@ -24,7 +24,7 @@ import Language.Haskell.TH
+ import Test.QuickCheck.Property hiding (Result)
+ import Test.QuickCheck.Test
+ import Data.Char
+-import Data.List
++import Data.List (nubBy, isPrefixOf)
+ import Control.Monad
+ 
+ import qualified System.IO as S
+diff --git a/src/Test/QuickCheck/Features.hs b/src/Test/QuickCheck/Features.hs
+index b2bbf5c..f2bebfc 100644
+--- a/src/Test/QuickCheck/Features.hs
++++ b/src/Test/QuickCheck/Features.hs
+@@ -9,7 +9,7 @@ import Test.QuickCheck.State
+ import Test.QuickCheck.Text
+ import qualified Data.Set as Set
+ import Data.Set(Set)
+-import Data.List
++import Data.List(intersperse)
+ import Data.IORef
+ import Data.Maybe
+ 
+diff --git a/src/Test/QuickCheck/Gen.hs b/src/Test/QuickCheck/Gen.hs
+index ee1507a..506a1ae 100644
+--- a/src/Test/QuickCheck/Gen.hs
++++ b/src/Test/QuickCheck/Gen.hs
+@@ -32,7 +32,7 @@ import Control.Applicative
+   ( Applicative(..) )
+ 
+ import Test.QuickCheck.Random
+-import Data.List
++import Data.List (sortBy)
+ import Data.Ord
+ import Data.Maybe
+ #ifndef NO_SPLITMIX
+diff --git a/src/Test/QuickCheck/Text.hs b/src/Test/QuickCheck/Text.hs
+index 115cfa9..787822e 100644
+--- a/src/Test/QuickCheck/Text.hs
++++ b/src/Test/QuickCheck/Text.hs
+@@ -43,7 +43,7 @@ import System.IO
+   )
+ 
+ import Data.IORef
+-import Data.List
++import Data.List (transpose, intersperse)
+ import Text.Printf
+ import Test.QuickCheck.Exception
+ 
diff --git a/patches/aivika-5.9.patch b/patches/aivika-5.9.patch
index f9e5582d19c30ddb13038a32149471d878a00dcb..215c20c7d50e0f6d7ed9609c667b4e82cc89fca1 100644
--- a/patches/aivika-5.9.patch
+++ b/patches/aivika-5.9.patch
@@ -41,6 +41,19 @@ index 379c2dc..f7ce5f9 100644
                do f <- invokeEvent p $
                        contPreemptionBegun $
                        contId $ contAux c
+diff --git a/Simulation/Aivika/Results/Locale/Types.hs b/Simulation/Aivika/Results/Locale/Types.hs
+index 25281fb..1dd5569 100644
+--- a/Simulation/Aivika/Results/Locale/Types.hs
++++ b/Simulation/Aivika/Results/Locale/Types.hs
+@@ -31,7 +31,7 @@ module Simulation.Aivika.Results.Locale.Types
+         resultNameToTitle) where
+ 
+ import Data.Char
+-import Data.List
++import Data.List (groupBy)
+ import qualified Data.Map as M
+ 
+ import Simulation.Aivika.Dynamics
 diff --git a/Simulation/Aivika/Stream.hs b/Simulation/Aivika/Stream.hs
 index 74d126c..7daa04c 100644
 --- a/Simulation/Aivika/Stream.hs
diff --git a/patches/aivika-transformers-5.9.patch b/patches/aivika-transformers-5.9.patch
index c46f63bdb34058df7e03a11cb9cd3f28dd38b4bd..7415129b983af0160b2a2a8cdb43a52cc698584f 100644
--- a/patches/aivika-transformers-5.9.patch
+++ b/patches/aivika-transformers-5.9.patch
@@ -28,6 +28,321 @@ index 26736d3..d241f12 100644
                do f <- invokeEvent p $
                        contPreemptionBegun $
                        contId $ contAux c
+diff --git a/Simulation/Aivika/Trans/Results/Locale/Types.hs b/Simulation/Aivika/Trans/Results/Locale/Types.hs
+index 2b70d92..0abb632 100644
+--- a/Simulation/Aivika/Trans/Results/Locale/Types.hs
++++ b/Simulation/Aivika/Trans/Results/Locale/Types.hs
+@@ -31,7 +31,7 @@ module Simulation.Aivika.Trans.Results.Locale.Types
+         resultNameToTitle) where
+ 
+ import Data.Char
+-import Data.List
++import Data.List (groupBy)
+ import qualified Data.Map as M
+ 
+ import Simulation.Aivika.Trans.Dynamics
+diff --git a/Simulation/Aivika/Trans/Signal.hs b/Simulation/Aivika/Trans/Signal.hs
+index 7eea382..f279112 100644
+--- a/Simulation/Aivika/Trans/Signal.hs
++++ b/Simulation/Aivika/Trans/Signal.hs
+@@ -7,10 +7,10 @@
+ -- Stability  : experimental
+ -- Tested with: GHC 8.0.1
+ --
+--- This module defines the signal which we can subscribe handlers to. 
+--- These handlers can be disposed. The signal is triggered in the 
+--- current time point actuating the corresponded computations from 
+--- the handlers. 
++-- This module defines the signal which we can subscribe handlers to.
++-- These handlers can be disposed. The signal is triggered in the
++-- current time point actuating the corresponded computations from
++-- the handlers.
+ --
+ 
+ module Simulation.Aivika.Trans.Signal
+@@ -64,7 +64,7 @@ module Simulation.Aivika.Trans.Signal
+ import Data.Monoid hiding ((<>))
+ import Data.Semigroup (Semigroup(..))
+ import Data.List.NonEmpty (NonEmpty((:|)))
+-import Data.List
++import Data.List (delete)
+ import Data.Array
+ 
+ import Control.Monad
+@@ -85,15 +85,15 @@ data SignalSource m a =
+   SignalSource { publishSignal :: Signal m a,
+                                   -- ^ Publish the signal.
+                  triggerSignal :: a -> Event m ()
+-                                  -- ^ Trigger the signal actuating 
+-                                  -- all its handlers at the current 
++                                  -- ^ Trigger the signal actuating
++                                  -- all its handlers at the current
+                                   -- simulation time point.
+                }
+-  
+--- | The signal that can have disposable handlers.  
++
++-- | The signal that can have disposable handlers.
+ data Signal m a =
+   Signal { handleSignal :: (a -> Event m ()) -> Event m (DisposableEvent m)
+-           -- ^ Subscribe the handler to the specified 
++           -- ^ Subscribe the handler to the specified
+            -- signal and return a nested computation
+            -- within a disposable object that, being applied,
+            -- unsubscribes the handler from this signal.
+@@ -102,7 +102,7 @@ data Signal m a =
+ -- | The queue of signal handlers.
+ data SignalHandlerQueue m a =
+   SignalHandlerQueue { queueList :: Ref m [SignalHandler m a] }
+-  
++
+ -- | It contains the information about the disposable queue handler.
+ data SignalHandler m a =
+   SignalHandler { handlerComp :: a -> Event m (),
+@@ -117,7 +117,7 @@ instance MonadDES m => Eq (SignalHandler m a) where
+ -- To subscribe the disposable handlers, use function 'handleSignal'.
+ handleSignal_ :: MonadDES m => Signal m a -> (a -> Event m ()) -> Event m ()
+ {-# INLINE handleSignal_ #-}
+-handleSignal_ signal h = 
++handleSignal_ signal h =
+   do x <- handleSignal signal h
+      return ()
+ 
+@@ -127,7 +127,7 @@ handleSignalComposite :: MonadDES m => Signal m a -> (a -> Event m ()) -> Compos
+ handleSignalComposite signal h =
+   do x <- liftEvent $ handleSignal signal h
+      disposableComposite x
+-     
++
+ -- | Create a new signal source.
+ newSignalSource :: MonadDES m => Simulation m (SignalSource m a)
+ {-# INLINABLE newSignalSource #-}
+@@ -135,7 +135,7 @@ newSignalSource =
+   do list <- newRef []
+      let queue  = SignalHandlerQueue { queueList = list }
+          signal = Signal { handleSignal = handle }
+-         source = SignalSource { publishSignal = signal, 
++         source = SignalSource { publishSignal = signal,
+                                  triggerSignal = trigger }
+          handle h =
+            Event $ \p ->
+@@ -146,7 +146,7 @@ newSignalSource =
+          trigger a =
+            triggerSignalHandlers queue a
+      return source
+-     
++
+ -- | Create a new signal source within more low level computation than 'Simulation'.
+ newSignalSource0 :: (MonadDES m, MonadRef0 m) => m (SignalSource m a)
+ {-# INLINABLE newSignalSource0 #-}
+@@ -154,7 +154,7 @@ newSignalSource0 =
+   do list <- newRef0 []
+      let queue  = SignalHandlerQueue { queueList = list }
+          signal = Signal { handleSignal = handle }
+-         source = SignalSource { publishSignal = signal, 
++         source = SignalSource { publishSignal = signal,
+                                  triggerSignal = trigger }
+          handle h =
+            Event $ \p ->
+@@ -174,8 +174,8 @@ triggerSignalHandlers q a =
+   do hs <- invokeEvent p $ readRef (queueList q)
+      forM_ hs $ \h ->
+        invokeEvent p $ handlerComp h a
+-            
+--- | Enqueue the handler and return its representative in the queue.            
++
++-- | Enqueue the handler and return its representative in the queue.
+ enqueueSignalHandler :: MonadDES m => SignalHandlerQueue m a -> (a -> Event m ()) -> Event m (SignalHandler m a)
+ {-# INLINABLE enqueueSignalHandler #-}
+ enqueueSignalHandler q h =
+@@ -189,14 +189,14 @@ enqueueSignalHandler q h =
+ -- | Dequeue the handler representative.
+ dequeueSignalHandler :: MonadDES m => SignalHandlerQueue m a -> SignalHandler m a -> Event m ()
+ {-# INLINABLE dequeueSignalHandler #-}
+-dequeueSignalHandler q h = 
++dequeueSignalHandler q h =
+   modifyRef (queueList q) (delete h)
+ 
+ instance MonadDES m => Functor (Signal m) where
+ 
+   {-# INLINE fmap #-}
+   fmap = mapSignal
+-  
++
+ instance MonadDES m => Semigroup (Signal m a) where
+ 
+   {-# INLINE (<>) #-}
+@@ -208,10 +208,10 @@ instance MonadDES m => Semigroup (Signal m a) where
+   sconcat (x1 :| [x2, x3]) = merge3Signals x1 x2 x3
+   sconcat (x1 :| [x2, x3, x4]) = merge4Signals x1 x2 x3 x4
+   sconcat (x1 :| [x2, x3, x4, x5]) = merge5Signals x1 x2 x3 x4 x5
+-  sconcat (x1 :| (x2 : x3 : x4 : x5 : xs)) = 
++  sconcat (x1 :| (x2 : x3 : x4 : x5 : xs)) =
+     sconcat $ merge5Signals x1 x2 x3 x4 x5 :| xs
+ 
+-instance MonadDES m => Monoid (Signal m a) where 
++instance MonadDES m => Monoid (Signal m a) where
+ 
+   {-# INLINE mempty #-}
+   mempty = emptySignal
+@@ -222,15 +222,15 @@ instance MonadDES m => Monoid (Signal m a) where
+   {-# INLINABLE mconcat #-}
+   mconcat [] = mempty
+   mconcat (h:t) = sconcat (h :| t)
+-  
++
+ -- | Map the signal according the specified function.
+ mapSignal :: MonadDES m => (a -> b) -> Signal m a -> Signal m b
+ {-# INLINABLE mapSignal #-}
+ mapSignal f m =
+-  Signal { handleSignal = \h -> 
++  Signal { handleSignal = \h ->
+             handleSignal m $ h . f }
+ 
+--- | Filter only those signal values that satisfy 
++-- | Filter only those signal values that satisfy
+ -- the specified predicate.
+ filterSignal :: MonadDES m => (a -> Bool) -> Signal m a -> Signal m a
+ {-# INLINABLE filterSignal #-}
+@@ -239,7 +239,7 @@ filterSignal p m =
+             handleSignal m $ \a ->
+             when (p a) $ h a }
+ 
+--- | Filter only those signal values that satisfy 
++-- | Filter only those signal values that satisfy
+ -- the specified predicate, but then ignoring the values.
+ filterSignal_ :: MonadDES m => (a -> Bool) -> Signal m a -> Signal m ()
+ {-# INLINABLE filterSignal_ #-}
+@@ -247,8 +247,8 @@ filterSignal_ p m =
+   Signal { handleSignal = \h ->
+             handleSignal m $ \a ->
+             when (p a) $ h () }
+-  
+--- | Filter only those signal values that satisfy 
++
++-- | Filter only those signal values that satisfy
+ -- the specified predicate.
+ filterSignalM :: MonadDES m => (a -> Event m Bool) -> Signal m a -> Signal m a
+ {-# INLINABLE filterSignalM #-}
+@@ -257,8 +257,8 @@ filterSignalM p m =
+             handleSignal m $ \a ->
+             do x <- p a
+                when x $ h a }
+-  
+--- | Filter only those signal values that satisfy 
++
++-- | Filter only those signal values that satisfy
+ -- the specified predicate, but then ignoring the values.
+ filterSignalM_ :: MonadDES m => (a -> Event m Bool) -> Signal m a -> Signal m ()
+ {-# INLINABLE filterSignalM_ #-}
+@@ -267,7 +267,7 @@ filterSignalM_ p m =
+             handleSignal m $ \a ->
+             do x <- p a
+                when x $ h () }
+-  
++
+ -- | Merge two signals.
+ merge2Signals :: MonadDES m => Signal m a -> Signal m a -> Signal m a
+ {-# INLINABLE merge2Signals #-}
+@@ -299,7 +299,7 @@ merge4Signals m1 m2 m3 m4 =
+                x3 <- handleSignal m3 h
+                x4 <- handleSignal m4 h
+                return $ x1 <> x2 <> x3 <> x4 }
+-           
++
+ -- | Merge five signals.
+ merge5Signals :: MonadDES m
+                  => Signal m a -> Signal m a -> Signal m a
+@@ -320,7 +320,7 @@ mapSignalM :: MonadDES m => (a -> Event m b) -> Signal m a -> Signal m b
+ mapSignalM f m =
+   Signal { handleSignal = \h ->
+             handleSignal m (f >=> h) }
+-  
++
+ -- | Transform the signal.
+ apSignal :: MonadDES m => Event m (a -> b) -> Signal m a -> Signal m b
+ {-# INLINABLE apSignal #-}
+@@ -336,7 +336,7 @@ emptySignal =
+ 
+ -- | Represents the history of the signal values.
+ data SignalHistory m a =
+-  SignalHistory { signalHistorySignal :: Signal m a,  
++  SignalHistory { signalHistorySignal :: Signal m a,
+                   -- ^ The signal for which the history is created.
+                   signalHistoryTimes  :: Ref m [Double],
+                   signalHistoryValues :: Ref m [a] }
+@@ -368,7 +368,7 @@ newSignalHistoryStartingWith init signal =
+      return SignalHistory { signalHistorySignal = signal,
+                             signalHistoryTimes  = ts,
+                             signalHistoryValues = xs }
+-       
++
+ -- | Read the history of signal values.
+ readSignalHistory :: MonadDES m => SignalHistory m a -> Event m (Array Int Double, Array Int a)
+ {-# INLINABLE readSignalHistory #-}
+@@ -378,7 +378,7 @@ readSignalHistory history =
+      let n  = length xs0
+          xs = listArray (0, n - 1) (reverse xs0)
+          ys = listArray (0, n - 1) (reverse ys0)
+-     return (xs, ys)     
++     return (xs, ys)
+ 
+ -- | Trigger the signal with the current time.
+ triggerSignalWithCurrentTime :: MonadDES m => SignalSource m Double -> Event m ()
+@@ -393,7 +393,7 @@ newSignalInTimes xs =
+   do s <- liftSimulation newSignalSource
+      enqueueEventWithTimes xs $ triggerSignalWithCurrentTime s
+      return $ publishSignal s
+-       
++
+ -- | Return a signal that is triggered in the integration time points.
+ -- It should be called with help of 'runEventInStartTime'.
+ newSignalInIntegTimes :: MonadDES m => Event m (Signal m Double)
+@@ -402,7 +402,7 @@ newSignalInIntegTimes =
+   do s <- liftSimulation newSignalSource
+      enqueueEventWithIntegTimes $ triggerSignalWithCurrentTime s
+      return $ publishSignal s
+-     
++
+ -- | Return a signal that is triggered in the start time.
+ -- It should be called with help of 'runEventInStartTime'.
+ newSignalInStartTime :: MonadDES m => Event m (Signal m Double)
+@@ -486,7 +486,7 @@ appendSignalable m1 m2 =
+ -- saving the information about the time points at which the original signal was received.
+ arrivalSignal :: MonadDES m => Signal m a -> Signal m (Arrival a)
+ {-# INLINABLE arrivalSignal #-}
+-arrivalSignal m = 
++arrivalSignal m =
+   Signal { handleSignal = \h ->
+              do r <- liftSimulation $ newRef Nothing
+                 handleSignal m $ \a ->
+@@ -511,7 +511,7 @@ delaySignal delta m =
+                h <- handleSignal m $ \a ->
+                  Event $ \p ->
+                  invokeEvent p $
+-                 enqueueEvent (pointTime p + delta) $ 
++                 enqueueEvent (pointTime p + delta) $
+                  do x <- readRef r
+                     unless x $ h a
+                return $ DisposableEvent $
+@@ -529,7 +529,7 @@ delaySignalM delta m =
+                  Event $ \p ->
+                  do delta' <- invokeEvent p delta
+                     invokeEvent p $
+-                      enqueueEvent (pointTime p + delta') $ 
++                      enqueueEvent (pointTime p + delta') $
+                       do x <- readRef r
+                          unless x $ h a
+                return $ DisposableEvent $
+@@ -538,7 +538,7 @@ delaySignalM delta m =
+          }
+ 
+ -- | Show the debug message with the current simulation time.
+-traceSignal :: MonadDES m => String -> Signal m a -> Signal m a 
++traceSignal :: MonadDES m => String -> Signal m a -> Signal m a
+ {-# INLINABLE traceSignal #-}
+ traceSignal message m =
+   Signal { handleSignal = \h ->
 diff --git a/Simulation/Aivika/Trans/Stream.hs b/Simulation/Aivika/Trans/Stream.hs
 index 1cc5017..82af37c 100644
 --- a/Simulation/Aivika/Trans/Stream.hs
diff --git a/patches/bifunctors-5.5.10.patch b/patches/bifunctors-5.5.10.patch
index f520ba47c38a9228a3764374c2d5b8278302dcef..4c1c5e7de2237b666197c19a1850713091161d76 100644
--- a/patches/bifunctors-5.5.10.patch
+++ b/patches/bifunctors-5.5.10.patch
@@ -1,8 +1,18 @@
 diff --git a/src/Data/Bifunctor/TH.hs b/src/Data/Bifunctor/TH.hs
-index 6545db1..41f77ea 100644
+index 6545db1..cf1a410 100644
 --- a/src/Data/Bifunctor/TH.hs
 +++ b/src/Data/Bifunctor/TH.hs
-@@ -1252,7 +1252,11 @@ mkSimpleConMatch :: (Name -> [a] -> Q Exp)
+@@ -65,7 +65,8 @@ module Data.Bifunctor.TH (
+ import           Control.Monad (guard, unless, when)
+ 
+ import           Data.Bifunctor.TH.Internal
+-import           Data.List
++import           Data.Foldable (foldl')
++import           Data.List (union)
+ import qualified Data.Map as Map ((!), fromList, keys, lookup, member, size)
+ import           Data.Maybe
+ 
+@@ -1252,7 +1253,11 @@ mkSimpleConMatch :: (Name -> [a] -> Q Exp)
                   -> Q Match
  mkSimpleConMatch fold conName insides = do
    varsNeeded <- newNameList "_arg" $ length insides
@@ -15,7 +25,7 @@ index 6545db1..41f77ea 100644
    rhs <- fold conName (zipWith (\i v -> i $ VarE v) insides varsNeeded)
    return $ Match pat (NormalB rhs) []
  
-@@ -1276,7 +1280,11 @@ mkSimpleConMatch2 :: (Exp -> [Exp] -> Q Exp)
+@@ -1276,7 +1281,11 @@ mkSimpleConMatch2 :: (Exp -> [Exp] -> Q Exp)
                    -> Q Match
  mkSimpleConMatch2 fold conName insides = do
    varsNeeded <- newNameList "_arg" lengthInsides
@@ -28,3 +38,17 @@ index 6545db1..41f77ea 100644
        -- Make sure to zip BEFORE invoking catMaybes. We want the variable
        -- indicies in each expression to match up with the argument indices
        -- in conExpr (defined below).
+diff --git a/src/Data/Bifunctor/TH/Internal.hs b/src/Data/Bifunctor/TH/Internal.hs
+index d213ca9..bac7b99 100644
+--- a/src/Data/Bifunctor/TH/Internal.hs
++++ b/src/Data/Bifunctor/TH/Internal.hs
+@@ -15,8 +15,7 @@ Template Haskell-related utilities.
+ -}
+ module Data.Bifunctor.TH.Internal where
+ 
+-import           Data.Foldable (foldr')
+-import           Data.List
++import           Data.Foldable (foldr', foldl')
+ import qualified Data.Map as Map (singleton)
+ import           Data.Map (Map)
+ import           Data.Maybe (fromMaybe, mapMaybe)
diff --git a/patches/bytestring-strict-builder-0.4.5.4.patch b/patches/bytestring-strict-builder-0.4.5.4.patch
index 1c6a6d374a06da33c58356846171ed06a3ad5abf..673bca8b5008795ee24abd6c8161f71834430647 100644
--- a/patches/bytestring-strict-builder-0.4.5.4.patch
+++ b/patches/bytestring-strict-builder-0.4.5.4.patch
@@ -46,3 +46,16 @@ index 69ba0ff..9b1d2bc 100644
  
  -- | Select an implementation depending on the bit-size of 'Word's.
  -- Currently, it produces a runtime failure if the bitsize is different.
+diff --git a/library/ByteString/StrictBuilder/Prelude.hs b/library/ByteString/StrictBuilder/Prelude.hs
+index ce29bac..fba28f4 100644
+--- a/library/ByteString/StrictBuilder/Prelude.hs
++++ b/library/ByteString/StrictBuilder/Prelude.hs
+@@ -33,7 +33,7 @@ import Data.Functor.Compose as Exports
+ import Data.Int as Exports
+ import Data.IORef as Exports
+ import Data.Ix as Exports
+-import Data.List as Exports hiding (sortOn, isSubsequenceOf, uncons, concat, foldr, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, find, maximumBy, minimumBy, mapAccumL, mapAccumR, foldl')
++--import Data.List as Exports hiding (sortOn, isSubsequenceOf, uncons, concat, foldr, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, find, maximumBy, minimumBy, mapAccumL, mapAccumR, foldl')
+ import Data.List.NonEmpty as Exports (NonEmpty(..))
+ import Data.Maybe as Exports
+ import Data.Monoid as Exports hiding (Alt, (<>))
diff --git a/patches/colour-2.3.5.patch b/patches/colour-2.3.5.patch
new file mode 100644
index 0000000000000000000000000000000000000000..f7bafed5d77db08c552c7415c058e787c4bc85af
--- /dev/null
+++ b/patches/colour-2.3.5.patch
@@ -0,0 +1,52 @@
+diff --git a/Data/Colour/CIE.hs b/Data/Colour/CIE.hs
+index 0b733c4..0a9e797 100644
+--- a/Data/Colour/CIE.hs
++++ b/Data/Colour/CIE.hs
+@@ -37,7 +37,7 @@ module Data.Colour.CIE
+  )
+ where
+ 
+-import Data.List
++import Data.List (foldl1')
+ import Data.Colour
+ import Data.Colour.RGB
+ import Data.Colour.SRGB.Linear
+diff --git a/Data/Colour/Internal.hs b/Data/Colour/Internal.hs
+index 07cb3e8..377d90f 100644
+--- a/Data/Colour/Internal.hs
++++ b/Data/Colour/Internal.hs
+@@ -22,7 +22,7 @@ THE SOFTWARE.
+ -}
+ module Data.Colour.Internal where
+ 
+-import Data.List
++import Data.List (foldl1')
+ import qualified Data.Colour.Chan as Chan
+ import Data.Colour.Chan (Chan(Chan))
+ import Data.Monoid
+diff --git a/Data/Colour/Matrix.hs b/Data/Colour/Matrix.hs
+index 4540b30..b8633ad 100644
+--- a/Data/Colour/Matrix.hs
++++ b/Data/Colour/Matrix.hs
+@@ -22,7 +22,7 @@ THE SOFTWARE.
+ -}
+ module Data.Colour.Matrix where
+ 
+-import Data.List
++import Data.List (transpose)
+ 
+ default (Rational)
+ 
+diff --git a/Data/Colour/RGB.hs b/Data/Colour/RGB.hs
+index 2be488c..d0950a7 100644
+--- a/Data/Colour/RGB.hs
++++ b/Data/Colour/RGB.hs
+@@ -22,7 +22,7 @@ THE SOFTWARE.
+ -}
+ module Data.Colour.RGB where
+ 
+-import Data.List
++import Data.List (elemIndex, transpose)
+ import Data.Colour.Matrix
+ import Data.Colour.CIE.Chromaticity
+ import Control.Applicative
diff --git a/patches/combinat-0.2.9.0.patch b/patches/combinat-0.2.9.0.patch
index f72642d04d688371dc75919ce4c549bd5ea2c3ee..a0374baf8b63fb3fb6758ca945f1ac4dda651c11 100644
--- a/patches/combinat-0.2.9.0.patch
+++ b/patches/combinat-0.2.9.0.patch
@@ -11,6 +11,587 @@ index 3760cac..7030ea2 100644
    n    = numberOfStrands braid
    perm = _braidPermutation n (map brGenIdx gens)
  
+diff --git a/Math/Combinat/Groups/Thompson/F.hs b/Math/Combinat/Groups/Thompson/F.hs
+index c500238..9fa4426 100644
+--- a/Math/Combinat/Groups/Thompson/F.hs
++++ b/Math/Combinat/Groups/Thompson/F.hs
+@@ -12,7 +12,7 @@ module Math.Combinat.Groups.Thompson.F where
+ 
+ --------------------------------------------------------------------------------
+ 
+-import Data.List
++import Data.List (intersperse)
+ 
+ import Math.Combinat.Classes
+ import Math.Combinat.ASCII
+@@ -23,9 +23,9 @@ import qualified Math.Combinat.Trees.Binary as B
+ --------------------------------------------------------------------------------
+ -- * Tree diagrams
+ 
+--- | A tree diagram, consisting of two binary trees with the same number of leaves, 
++-- | A tree diagram, consisting of two binary trees with the same number of leaves,
+ -- representing an element of the group F.
+-data TDiag = TDiag 
++data TDiag = TDiag
+   { _width  :: !Int      -- ^ the width is the number of leaves, minus 1, of both diagrams
+   , _domain :: !T        -- ^ the top diagram correspond to the /domain/
+   , _range  :: !T        -- ^ the bottom diagram corresponds to the /range/
+@@ -39,17 +39,17 @@ instance HasWidth TDiag where
+   width = _width
+ 
+ -- | Creates a tree diagram from two trees
+-mkTDiag :: T -> T -> TDiag 
++mkTDiag :: T -> T -> TDiag
+ mkTDiag d1 d2 = reduce $ mkTDiagDontReduce d1 d2
+ 
+ -- | Creates a tree diagram, but does not reduce it.
+-mkTDiagDontReduce :: T -> T -> TDiag 
+-mkTDiagDontReduce top bot = 
+-  if w1 == w2 
+-    then TDiag w1 top bot 
++mkTDiagDontReduce :: T -> T -> TDiag
++mkTDiagDontReduce top bot =
++  if w1 == w2
++    then TDiag w1 top bot
+     else error "mkTDiag: widths do not match"
+   where
+-    w1 = treeWidth top 
++    w1 = treeWidth top
+     w2 = treeWidth bot
+ 
+ 
+@@ -77,10 +77,10 @@ xk :: Int -> TDiag
+ xk = go where
+   go k | k< 0      = error "xk: negative indexed generator"
+        | k==0      = x0
+-       | otherwise = let TDiag _ t b = go (k-1) 
++       | otherwise = let TDiag _ t b = go (k-1)
+                      in  TDiag (k+2) (branch leaf t) (branch leaf b)
+ 
+--- | The identity element in the group F                     
++-- | The identity element in the group F
+ identity :: TDiag
+ identity = TDiag 0 Lf Lf
+ 
+@@ -110,8 +110,8 @@ reduce = worker where
+     Just diag' -> worker diag'
+ 
+   step :: TDiag -> Maybe TDiag
+-  step (TDiag w top bot) = 
+-    if null idxs 
++  step (TDiag w top bot) =
++    if null idxs
+       then Nothing
+       else Just $ TDiag w' top' bot'
+     where
+@@ -122,7 +122,7 @@ reduce = worker where
+       top' = removeCarets idxs top
+       bot' = removeCarets idxs bot
+ 
+-  -- | Intersects sorted lists      
++  -- | Intersects sorted lists
+   sortedIntersect :: [Int] -> [Int] -> [Int]
+   sortedIntersect = go where
+     go [] _  = []
+@@ -135,14 +135,14 @@ reduce = worker where
+ -- | List of carets at the bottom of the tree, indexed by their left edge position
+ treeCaretList :: T -> [Int]
+ treeCaretList = snd . go 0 where
+-  go !x t = case t of 
++  go !x t = case t of
+     Lf        ->  (x+1 , []  )
+     Ct        ->  (x+2 , [x] )
+     Br t1 t2  ->  (x2  , cs1++cs2) where
+       (x1 , cs1) = go x  t1
+       (x2 , cs2) = go x1 t2
+ 
+--- | Remove the carets with the given indices 
++-- | Remove the carets with the given indices
+ -- (throws an error if there is no caret at the given index)
+ removeCarets :: [Int] -> T -> T
+ removeCarets idxs tree = if null rem then final else error ("removeCarets: some stuff remained: " ++ show rem) where
+@@ -157,11 +157,11 @@ removeCarets idxs tree = if null rem then final else error ("removeCarets: some
+     Br t1 t2  ->  (x2  , iis2 , Br t1' t2') where
+       (x1 , iis1 , t1') = go x  iis  t1
+       (x2 , iis2 , t2') = go x1 iis1 t2
+-      
++
+ --------------------------------------------------------------------------------
+ -- * Composition of tree diagrams
+ 
+--- | If @diag1@ corresponds to the PL function @f@, and @diag2@ to @g@, then @compose diag1 diag2@ 
++-- | If @diag1@ corresponds to the PL function @f@, and @diag2@ to @g@, then @compose diag1 diag2@
+ -- will correspond to @(g.f)@ (note that the order is opposite than normal function composition!)
+ --
+ -- This is the multiplication in the group F.
+@@ -172,7 +172,7 @@ compose d1 d2 = reduce (composeDontReduce d1 d2)
+ -- | Compose two tree diagrams without reducing the result
+ composeDontReduce :: TDiag -> TDiag -> TDiag
+ composeDontReduce (TDiag w1 top1 bot1) (TDiag w2 top2 bot2) = new where
+-  new = mkTDiagDontReduce top' bot' 
++  new = mkTDiagDontReduce top' bot'
+   (list1,list2) = extensionToCommonTree bot1 top2
+   top' = listGraft list1 top1
+   bot' = listGraft list2 bot2
+@@ -181,12 +181,12 @@ composeDontReduce (TDiag w1 top1 bot1) (TDiag w2 top2 bot2) = new where
+ -- the first (resp. the second) tree, results in the same extended tree.
+ extensionToCommonTree :: T -> T -> ([T],[T])
+ extensionToCommonTree t1 t2 = snd $ go (0,0) (t1,t2) where
+-  go (!x1,!x2) (!t1,!t2) = 
++  go (!x1,!x2) (!t1,!t2) =
+     case (t1,t2) of
+       ( Lf       , Lf       ) -> ( (x1+n1 , x2+n2 ) , (             [Lf] ,             [Lf] ) )
+       ( Lf       , Br _  _  ) -> ( (x1+n1 , x2+n2 ) , (             [t2] , replicate n2 Lf  ) )
+       ( Br _  _  , Lf       ) -> ( (x1+n1 , x2+n2 ) , ( replicate n1 Lf  ,             [t1] ) )
+-      ( Br l1 r1 , Br l2 r2 ) 
++      ( Br l1 r1 , Br l2 r2 )
+         -> let ( (x1' ,x2' ) , (ps1,ps2) ) = go (x1 ,x2 ) (l1,l2)
+                ( (x1'',x2'') , (qs1,qs2) ) = go (x1',x2') (r1,r2)
+            in  ( (x1'',x2'') , (ps1++qs1, ps2++qs2) )
+@@ -225,11 +225,11 @@ data Tree a
+ graft :: Tree (Tree a) -> Tree a
+ graft = go where
+   go (Branch l r) = Branch (go l) (go r)
+-  go (Leaf   t  ) = t 
++  go (Leaf   t  ) = t
+ 
+ -- | A list version of 'graft'
+ listGraft :: [Tree a] -> Tree b -> Tree a
+-listGraft subs big = snd $ go subs big where  
++listGraft subs big = snd $ go subs big where
+   go ggs@(g:gs) t = case t of
+     Leaf   _   -> (gs,g)
+     Branch l r -> (gs2, Branch l' r') where
+@@ -240,7 +240,7 @@ listGraft subs big = snd $ go subs big where
+ type T = Tree ()
+ 
+ instance DrawASCII T where
+-  ascii = asciiT 
++  ascii = asciiT
+ 
+ instance HasNumberOfLeaves (Tree a) where
+   numberOfLeaves = treeNumberOfLeaves
+@@ -260,7 +260,7 @@ caret = branch leaf leaf
+ treeNumberOfLeaves :: Tree a -> Int
+ treeNumberOfLeaves = go where
+   go (Branch l r) = go l + go r
+-  go (Leaf   _  ) = 1  
++  go (Leaf   _  ) = 1
+ 
+ -- | The width of the tree is the number of leaves minus 1.
+ treeWidth :: Tree a -> Int
+@@ -277,21 +277,21 @@ enumerate = go 0 where
+     Leaf   _   -> (k+1 , Leaf k)
+     Branch l r -> let (k' ,l') = go k  l
+                       (k'',r') = go k' r
+-                  in (k'', Branch l' r') 
++                  in (k'', Branch l' r')
+ 
+--- | \"Right vine\" of the given width 
++-- | \"Right vine\" of the given width
+ rightVine :: Int -> T
+-rightVine k 
++rightVine k
+   | k< 0      = error "rightVine: negative width"
+   | k==0      = leaf
+   | otherwise = branch leaf (rightVine (k-1))
+ 
+--- | \"Left vine\" of the given width 
++-- | \"Left vine\" of the given width
+ leftVine :: Int -> T
+-leftVine k 
++leftVine k
+   | k< 0      = error "leftVine: negative width"
+   | k==0      = leaf
+-  | otherwise = branch (leftVine (k-1)) leaf 
++  | otherwise = branch (leftVine (k-1)) leaf
+ 
+ -- | Flips each node of a binary tree
+ flipTree :: Tree a -> Tree a
+@@ -313,11 +313,11 @@ toBinTree = go where
+   go (Branch l r) = B.Branch (go l) (go r)
+   go (Leaf   y  ) = B.Leaf   y
+ 
+-fromBinTree :: B.BinTree a -> Tree a 
++fromBinTree :: B.BinTree a -> Tree a
+ fromBinTree = go where
+   go (B.Branch l r) = Branch (go l) (go r)
+   go (B.Leaf   y  ) = Leaf   y
+-    
++
+ --------------------------------------------------------------------------------
+ -- * Pattern synonyms
+ 
+@@ -339,22 +339,22 @@ asciiT' :: Bool -> T -> ASCII
+ asciiT' inv = go where
+ 
+   go t = case t of
+-    Leaf _                   -> emptyRect 
+-    Branch l r -> 
++    Leaf _                   -> emptyRect
++    Branch l r ->
+       if yl >= yr
+-        then pasteOnto (yl+yr+1,if inv then yr else 0) (rs $ yl+1) $ 
+-               vcat HCenter 
+-                 (bc $ yr+1) 
++        then pasteOnto (yl+yr+1,if inv then yr else 0) (rs $ yl+1) $
++               vcat HCenter
++                 (bc $ yr+1)
+                  (hcat bot al ar)
+         else pasteOnto (yl, if inv then yl else 0) (ls $ yr+1) $
+-               vcat HCenter 
+-                 (bc $ yl+1) 
++               vcat HCenter
++                 (bc $ yl+1)
+                  (hcat bot al ar)
+       where
+         al = go l
+         ar = go r
+-        yl = asciiYSize al 
+-        yr = asciiYSize ar 
++        yl = asciiYSize al
++        yr = asciiYSize ar
+ 
+   bot = if inv then VTop else VBottom
+   hcat align p q = hCatWith align (HSepString "  ") [p,q]
+@@ -369,16 +369,16 @@ asciiT' inv = go where
+   asciiBigInvCaret :: Int -> ASCII
+   asciiBigInvCaret k = hCatWith VTop HSepEmpty [ asciiBigRightSlope k , asciiBigLeftSlope k ]
+ 
+-  asciiBigLeftSlope :: Int -> ASCII  
+-  asciiBigLeftSlope k = if k>0 
++  asciiBigLeftSlope :: Int -> ASCII
++  asciiBigLeftSlope k = if k>0
+     then asciiFromLines [ replicate l ' ' ++ "/" | l<-[k-1,k-2..0] ]
+     else emptyRect
+ 
+-  asciiBigRightSlope :: Int -> ASCII  
+-  asciiBigRightSlope k = if k>0 
++  asciiBigRightSlope :: Int -> ASCII
++  asciiBigRightSlope k = if k>0
+     then asciiFromLines [ replicate l ' ' ++ "\\" | l<-[0..k-1] ]
+     else emptyRect
+-  
++
+ -- | Draws a binary tree, with all leaves at the same (bottom) row, and labelling
+ -- the leaves starting with 0 (continuing with letters after 9)
+ asciiTLabels :: T -> ASCII
+@@ -386,15 +386,15 @@ asciiTLabels = asciiTLabels' False
+ 
+ -- | When the flag is true, we draw upside down
+ asciiTLabels' :: Bool -> T -> ASCII
+-asciiTLabels' inv t = 
+-  if inv 
++asciiTLabels' inv t =
++  if inv
+     then vCatWith HLeft VSepEmpty [ labels , asciiT' inv t ]
+     else vCatWith HLeft VSepEmpty [ asciiT' inv t , labels ]
+   where
+     w = treeWidth t
+     labels = asciiFromString $ intersperse ' ' $ take (w+1) allLabels
+     allLabels = ['0'..'9'] ++ ['a'..'z']
+-    
++
+ -- | Draws a tree diagram
+ asciiTDiag :: TDiag -> ASCII
+ asciiTDiag (TDiag _ top bot) = vCatWith HLeft (VSepString " ") [asciiT' False top , asciiT' True bot]
+diff --git a/Math/Combinat/Helper.hs b/Math/Combinat/Helper.hs
+index 1acd3f3..8c8e91a 100644
+--- a/Math/Combinat/Helper.hs
++++ b/Math/Combinat/Helper.hs
+@@ -10,7 +10,7 @@ import Control.Monad
+ import Control.Applicative ( Applicative(..) )    -- required before AMP (before GHC 7.10)
+ import Data.Functor.Identity
+ 
+-import Data.List
++import Data.List (sortBy, groupBy, transpose, foldl')
+ import Data.Ord
+ import Data.Proxy
+ 
+diff --git a/Math/Combinat/LatticePaths.hs b/Math/Combinat/LatticePaths.hs
+index 741dc1c..0831baa 100644
+--- a/Math/Combinat/LatticePaths.hs
++++ b/Math/Combinat/LatticePaths.hs
+@@ -12,7 +12,7 @@ module Math.Combinat.LatticePaths where
+ 
+ --------------------------------------------------------------------------------
+ 
+-import Data.List
++import Data.List (transpose)
+ import System.Random
+ 
+ import Math.Combinat.Classes
+@@ -24,12 +24,12 @@ import Math.Combinat.ASCII as ASCII
+ -- * Types
+ 
+ -- | A step in a lattice path
+-data Step 
++data Step
+   = UpStep         -- ^ the step @(1,1)@
+   | DownStep       -- ^ the step @(1,-1)@
+   deriving (Eq,Ord,Show)
+ 
+--- | A lattice path is a path using only the allowed steps, never going below the zero level line @y=0@. 
++-- | A lattice path is a path using only the allowed steps, never going below the zero level line @y=0@.
+ --
+ -- Note that if you rotate such a path by 45 degrees counterclockwise,
+ -- you get a path which uses only the steps @(1,0)@ and @(0,1)@, and stays
+@@ -55,11 +55,11 @@ asciiPath p = asciiFromLines $ transpose (go 0 p) where
+   maxh   = pathHeight p
+ 
+   ee h x = replicate (maxh-h-1) ' ' ++ [ch x] ++ replicate h ' '
+-  ch x   = case x of 
+-    UpStep   -> '/' 
+-    DownStep -> '\\' 
++  ch x   = case x of
++    UpStep   -> '/'
++    DownStep -> '\\'
+ 
+-instance DrawASCII LatticePath where 
++instance DrawASCII LatticePath where
+   ascii = asciiPath
+ 
+ --------------------------------------------------------------------------------
+@@ -71,7 +71,7 @@ isValidPath = go 0 where
+   go :: Int -> LatticePath -> Bool
+   go !y []     = y>=0
+   go !y (t:ts) = let y' = case t of { UpStep -> y+1 ; DownStep -> y-1 }
+-                 in  if y'<0 then False 
++                 in  if y'<0 then False
+                              else go y' ts
+ 
+ -- | A Dyck path is a lattice path whose last point lies on the @y=0@ line
+@@ -80,7 +80,7 @@ isDyckPath = go 0 where
+   go :: Int -> LatticePath -> Bool
+   go !y []     = y==0
+   go !y (t:ts) = let y' = case t of { UpStep -> y+1 ; DownStep -> y-1 }
+-                 in  if y'<0 then False 
++                 in  if y'<0 then False
+                              else go y' ts
+ 
+ -- | Maximal height of a lattice path
+@@ -103,7 +103,7 @@ pathEndpoint :: LatticePath -> (Int,Int)
+ pathEndpoint = go 0 0 where
+   go :: Int -> Int -> LatticePath -> (Int,Int)
+   go !x !y []     = (x,y)
+-  go !x !y (t:ts) = case t of                         
++  go !x !y (t:ts) = case t of
+     UpStep   -> go (x+1) (y+1) ts
+     DownStep -> go (x+1) (y-1) ts
+ 
+@@ -127,11 +127,11 @@ pathNumberOfDownSteps = snd . pathNumberOfUpDownSteps
+ 
+ -- | Counts both the up-steps and down-steps
+ pathNumberOfUpDownSteps :: LatticePath -> (Int,Int)
+-pathNumberOfUpDownSteps = go 0 0 where 
++pathNumberOfUpDownSteps = go 0 0 where
+   go :: Int -> Int -> LatticePath -> (Int,Int)
+-  go !u !d (p:ps) = case p of 
+-    UpStep   -> go (u+1)  d    ps  
+-    DownStep -> go  u    (d+1) ps    
++  go !u !d (p:ps) = case p of
++    UpStep   -> go (u+1)  d    ps
++    DownStep -> go  u    (d+1) ps
+   go !u !d []     = (u,d)
+ 
+ --------------------------------------------------------------------------------
+@@ -152,7 +152,7 @@ pathNumberOfZeroTouches = pathNumberOfTouches' 0
+ 
+ -- | Number of points on the path which touch the level line at height @h@
+ -- (excluding the starting point @(0,0)@, but including the endpoint).
+-pathNumberOfTouches' 
++pathNumberOfTouches'
+   :: Int       -- ^ @h@ = the touch level
+   -> LatticePath -> Int
+ pathNumberOfTouches' h = go 0 0 0 where
+@@ -165,29 +165,29 @@ pathNumberOfTouches' h = go 0 0 0 where
+ --------------------------------------------------------------------------------
+ -- * Dyck paths
+ 
+--- | @dyckPaths m@ lists all Dyck paths from @(0,0)@ to @(2m,0)@. 
+--- 
++-- | @dyckPaths m@ lists all Dyck paths from @(0,0)@ to @(2m,0)@.
++--
+ -- Remark: Dyck paths are obviously in bijection with nested parentheses, and thus
+ -- also with binary trees.
+ --
+ -- Order is reverse lexicographical:
+ --
+ -- > sort (dyckPaths m) == reverse (dyckPaths m)
+--- 
++--
+ dyckPaths :: Int -> [LatticePath]
+-dyckPaths = map nestedParensToDyckPath . nestedParentheses 
++dyckPaths = map nestedParensToDyckPath . nestedParentheses
+ 
+--- | @dyckPaths m@ lists all Dyck paths from @(0,0)@ to @(2m,0)@. 
++-- | @dyckPaths m@ lists all Dyck paths from @(0,0)@ to @(2m,0)@.
++--
++-- > sort (dyckPathsNaive m) == sort (dyckPaths m)
+ --
+--- > sort (dyckPathsNaive m) == sort (dyckPaths m) 
+---  
+ -- Naive recursive algorithm, order is ad-hoc
+ --
+ dyckPathsNaive :: Int -> [LatticePath]
+ dyckPathsNaive = worker where
+   worker  0 = [[]]
+   worker  m = as ++ bs where
+-    as = [ bracket p      | p <- worker (m-1) ] 
++    as = [ bracket p      | p <- worker (m-1) ]
+     bs = [ bracket p ++ q | k <- [1..m-1] , p <- worker (k-1) , q <- worker (m-k) ]
+   bracket p = UpStep : p ++ [DownStep]
+ 
+@@ -215,12 +215,12 @@ boundedDyckPaths
+   :: Int   -- ^ @h@ = maximum height
+   -> Int   -- ^ @m@ = half-length
+   -> [LatticePath]
+-boundedDyckPaths = boundedDyckPathsNaive 
++boundedDyckPaths = boundedDyckPathsNaive
+ 
+ -- | @boundedDyckPathsNaive h m@ lists all Dyck paths from @(0,0)@ to @(2m,0)@ whose height is at most @h@.
+ --
+ -- > sort (boundedDyckPaths h m) == sort [ p | p <- dyckPaths m , pathHeight p <= h ]
+--- > sort (boundedDyckPaths m m) == sort (dyckPaths m) 
++-- > sort (boundedDyckPaths m m) == sort (dyckPaths m)
+ --
+ -- Naive recursive algorithm, resulting order is pretty ad-hoc.
+ --
+@@ -229,12 +229,12 @@ boundedDyckPathsNaive
+   -> Int   -- ^ @m@ = half-length
+   -> [LatticePath]
+ boundedDyckPathsNaive = worker where
+-  worker !h !m 
++  worker !h !m
+     | h<0        = []
+     | m<0        = []
+     | m==0       = [[]]
+     | h<=0       = []
+-    | otherwise  = as ++ bs 
++    | otherwise  = as ++ bs
+     where
+       bracket p = UpStep : p ++ [DownStep]
+       as = [ bracket p      |                 p <- boundedDyckPaths (h-1) (m-1)                                 ]
+@@ -259,7 +259,7 @@ latticePaths = latticePathsNaive
+ --
+ latticePathsNaive :: (Int,Int) -> [LatticePath]
+ latticePathsNaive (x,y) = worker x y where
+-  worker !x !y 
++  worker !x !y
+     | odd (x-y)     = []
+     | x<0           = []
+     | y<0           = []
+@@ -267,20 +267,20 @@ latticePathsNaive (x,y) = worker x y where
+     | x==1 && y==1  = [[UpStep]]
+     | otherwise     = as ++ bs
+     where
+-      bracket p = UpStep : p ++ [DownStep] 
++      bracket p = UpStep : p ++ [DownStep]
+       as = [ UpStep : p     | p <- worker (x-1) (y-1) ]
+       bs = [ bracket p ++ q | k <- [1..(div x 2)] , p <- dyckPaths (k-1) , q <- worker (x-2*k) y ]
+ 
+ -- | Lattice paths are counted by the numbers in the Catalan triangle.
+ countLatticePaths :: (Int,Int) -> Integer
+-countLatticePaths (x,y) 
++countLatticePaths (x,y)
+   | even (x+y)  = catalanTriangle (div (x+y) 2) (div (x-y) 2)
+   | otherwise   = 0
+ 
+ --------------------------------------------------------------------------------
+ -- * Zero-level touches
+ 
+--- | @touchingDyckPaths k m@ lists all Dyck paths from @(0,0)@ to @(2m,0)@ which touch the 
++-- | @touchingDyckPaths k m@ lists all Dyck paths from @(0,0)@ to @(2m,0)@ which touch the
+ -- zero level line @y=0@ exactly @k@ times (excluding the starting point, but including the endpoint;
+ -- thus, @k@ should be positive). Synonym for 'touchingDyckPathsNaive'.
+ touchingDyckPaths
+@@ -290,12 +290,12 @@ touchingDyckPaths
+ touchingDyckPaths = touchingDyckPathsNaive
+ 
+ 
+--- | @touchingDyckPathsNaive k m@ lists all Dyck paths from @(0,0)@ to @(2m,0)@ which touch the 
++-- | @touchingDyckPathsNaive k m@ lists all Dyck paths from @(0,0)@ to @(2m,0)@ which touch the
+ -- zero level line @y=0@ exactly @k@ times (excluding the starting point, but including the endpoint;
+ -- thus, @k@ should be positive).
+ --
+ -- > sort (touchingDyckPathsNaive k m) == sort [ p | p <- dyckPaths m , pathNumberOfZeroTouches p == k ]
+--- 
++--
+ -- Naive recursive algorithm, resulting order is pretty ad-hoc.
+ --
+ touchingDyckPathsNaive
+@@ -303,20 +303,20 @@ touchingDyckPathsNaive
+   -> Int   -- ^ @m@ = half-length
+   -> [LatticePath]
+ touchingDyckPathsNaive = worker where
+-  worker !k !m 
++  worker !k !m
+     | m == 0    = if k==0 then [[]] else []
+     | k <= 0    = []
+     | m <  0    = []
+     | k == 1    = [ bracket p      |                 p <- dyckPaths (m-1)                           ]
+     | otherwise = [ bracket p ++ q | l <- [1..m-1] , p <- dyckPaths (l-1) , q <- worker (k-1) (m-l) ]
+     where
+-      bracket p = UpStep : p ++ [DownStep] 
++      bracket p = UpStep : p ++ [DownStep]
+ 
+ 
+ -- | There is a bijection from the set of non-empty Dyck paths of length @2n@ which touch the zero lines @t@ times,
+ -- to lattice paths from @(0,0)@ to @(2n-t-1,t-1)@ (just remove all the down-steps just before touching
+ -- the zero line, and also the very first up-step). This gives us a counting formula.
+-countTouchingDyckPaths 
++countTouchingDyckPaths
+   :: Int   -- ^ @k@ = number of zero-touches
+   -> Int   -- ^ @m@ = half-length
+   -> Integer
+@@ -335,39 +335,39 @@ peakingDyckPaths
+   :: Int      -- ^ @k@ = number of peaks
+   -> Int      -- ^ @m@ = half-length
+   -> [LatticePath]
+-peakingDyckPaths = peakingDyckPathsNaive 
++peakingDyckPaths = peakingDyckPathsNaive
+ 
+ -- | @peakingDyckPathsNaive k m@ lists all Dyck paths from @(0,0)@ to @(2m,0)@ with exactly @k@ peaks.
+ --
+ -- > sort (peakingDyckPathsNaive k m) = sort [ p | p <- dyckPaths m , pathNumberOfPeaks p == k ]
+---  
++--
+ -- Naive recursive algorithm, resulting order is pretty ad-hoc.
+ --
+-peakingDyckPathsNaive 
++peakingDyckPathsNaive
+   :: Int      -- ^ @k@ = number of peaks
+   -> Int      -- ^ @m@ = half-length
+   -> [LatticePath]
+ peakingDyckPathsNaive = worker where
+   worker !k !m
+-    | m == 0    = if k==0 then [[]] else []       
++    | m == 0    = if k==0 then [[]] else []
+     | k <= 0    = []
+     | m <  0    = []
+-    | k == 1    = [ singlePeak m ] 
++    | k == 1    = [ singlePeak m ]
+     | otherwise = as ++ bs ++ cs
+     where
+       as = [ bracket p      |                                 p <- worker k (m-1)                           ]
+       bs = [ smallHill ++ q |                                                       q <- worker (k-1) (m-1) ]
+       cs = [ bracket p ++ q | l <- [2..m-1] , a <- [1..k-1] , p <- worker a (l-1) , q <- worker (k-a) (m-l) ]
+       smallHill     = [ UpStep , DownStep ]
+-      singlePeak !m = replicate m UpStep ++ replicate m DownStep 
+-      bracket p = UpStep : p ++ [DownStep] 
++      singlePeak !m = replicate m UpStep ++ replicate m DownStep
++      bracket p = UpStep : p ++ [DownStep]
+ 
+ -- | Dyck paths of length @2m@ with @k@ peaks are counted by the Narayana numbers @N(m,k) = \binom{m}{k} \binom{m}{k-1} / m@
+ countPeakingDyckPaths
+   :: Int      -- ^ @k@ = number of peaks
+   -> Int      -- ^ @m@ = half-length
+   -> Integer
+-countPeakingDyckPaths k m 
++countPeakingDyckPaths k m
+   | m == 0    = if k==0 then 1 else 0
+   | k <= 0    = 0
+   | m <  0    = 0
 diff --git a/Math/Combinat/Numbers/Primes.hs b/Math/Combinat/Numbers/Primes.hs
 index 6cf837f..0122d6d 100644
 --- a/Math/Combinat/Numbers/Primes.hs
@@ -28,16 +609,4742 @@ index 6cf837f..0122d6d 100644
      | k==p  = scanl (\c d->c+p*d) (p*p) ws : roll (k+w) t u              
      | True  = roll (k+w) t ps   
  
-diff --git a/Math/Combinat/Tableaux/LittlewoodRichardson.hs b/Math/Combinat/Tableaux/LittlewoodRichardson.hs
-index a6a58e3..3e4229f 100644
---- a/Math/Combinat/Tableaux/LittlewoodRichardson.hs
-+++ b/Math/Combinat/Tableaux/LittlewoodRichardson.hs
-@@ -212,7 +212,7 @@ lrScalar :: SkewPartition -> SkewPartition -> Int
- lrScalar lambdaMu alphaBeta = _lrScalar (fromSkewPartition lambdaMu) (fromSkewPartition alphaBeta)
+diff --git a/Math/Combinat/Numbers/Series.hs b/Math/Combinat/Numbers/Series.hs
+index c31d1b1..8f940c8 100644
+--- a/Math/Combinat/Numbers/Series.hs
++++ b/Math/Combinat/Numbers/Series.hs
+@@ -4,7 +4,7 @@
+ --
+ -- Note: the \"@convolveWithXXX@\" functions are much faster than the equivalent
+ -- @(XXX \`convolve\`)@!
+--- 
++--
+ -- TODO: better names for these functions.
+ --
  
- _lrScalar :: (Partition,Partition) -> (Partition,Partition) -> Int
--_lrScalar (plam  @(Partition lam  ) , pmu  @(Partition mu0)  ) 
-+_lrScalar (plam@(Partition lam  ) , pmu@(Partition mu0)  ) 
-          (palpha@(Partition alpha) , pbeta@(Partition beta)) = 
-   if    not (pmu   `isSubPartitionOf` plam  ) 
-      || not (pbeta `isSubPartitionOf` palpha) 
+@@ -13,7 +13,7 @@ module Math.Combinat.Numbers.Series where
+ 
+ --------------------------------------------------------------------------------
+ 
+-import Data.List
++import Data.List (foldl', foldl1')
+ 
+ import Math.Combinat.Sign
+ import Math.Combinat.Numbers
+@@ -65,7 +65,7 @@ scaleSeries s = map (*s)
+ 
+ -- | A different implementation, taken from:
+ --
+--- M. Douglas McIlroy: Power Series, Power Serious 
++-- M. Douglas McIlroy: Power Series, Power Serious
+ mulSeries :: Num a => [a] -> [a] -> [a]
+ mulSeries xs ys = go (xs ++ repeat 0) (ys ++ repeat 0) where
+   go (f:fs) ggs@(g:gs) = f*g : (scaleSeries f gs) `addSeries` go fs ggs
+@@ -80,12 +80,12 @@ productOfSeries = convolveMany
+ --------------------------------------------------------------------------------
+ -- * Convolution (product)
+ 
+--- | Convolution of series (that is, multiplication of power series). 
++-- | Convolution of series (that is, multiplication of power series).
+ -- The result is always an infinite list. Warning: This is slow!
+ convolve :: Num a => [a] -> [a] -> [a]
+ convolve xs1 ys1 = res where
+   res = [ foldl' (+) 0 (zipWith (*) xs (reverse (take n ys)))
+-        | n<-[1..] 
++        | n<-[1..]
+         ]
+   xs = xs1 ++ repeat 0
+   ys = ys1 ++ repeat 0
+@@ -100,7 +100,7 @@ convolveMany xss = foldl1 convolve xss
+ 
+ -- | Division of series.
+ --
+--- Taken from: M. Douglas McIlroy: Power Series, Power Serious 
++-- Taken from: M. Douglas McIlroy: Power Series, Power Serious
+ divSeries :: (Eq a, Fractional a) => [a] -> [a] -> [a]
+ divSeries xs ys = go (xs ++ repeat 0) (ys ++ repeat 0) where
+   go (0:fs)     (0:gs) = go fs gs
+@@ -120,13 +120,13 @@ reciprocalSeries series = case series of
+ {-# SPECIALIZE integralReciprocalSeries :: [Int]     -> [Int]     #-}
+ {-# SPECIALIZE integralReciprocalSeries :: [Integer] -> [Integer] #-}
+ integralReciprocalSeries :: (Eq a, Num a) => [a] -> [a]
+-integralReciprocalSeries series = case series of 
++integralReciprocalSeries series = case series of
+   [] -> error "integralReciprocalSeries: empty input series (const 0 function does not have an inverse)"
+   (a:as) -> case a of
+     1 -> 1 : worker [1]
+     _ -> error "integralReciprocalSeries: input series must start with 1"
+   where
+-    worker bs = let b' = - sum (zipWith (*) (tail series) bs) 
++    worker bs = let b' = - sum (zipWith (*) (tail series) bs)
+                 in  b' : worker (b':bs)
+ 
+ --------------------------------------------------------------------------------
+@@ -137,13 +137,13 @@ integralReciprocalSeries series = case series of
+ --
+ -- This implementation is taken from
+ --
+--- M. Douglas McIlroy: Power Series, Power Serious 
++-- M. Douglas McIlroy: Power Series, Power Serious
+ composeSeries :: (Eq a, Num a) => [a] -> [a] -> [a]
+ composeSeries xs ys = go (xs ++ repeat 0) (ys ++ repeat 0) where
+   go (f:fs) (0:gs) = f : mulSeries gs (go fs (0:gs))
+   go (f:fs) (_:gs) = error "PowerSeries/composeSeries: we expect the the constant term of the inner series to be zero"
+ 
+--- | @substitute f g@ is the power series corresponding to @g(f(x))@. 
++-- | @substitute f g@ is the power series corresponding to @g(f(x))@.
+ -- Equivalently, this is the composition of univariate functions (in the \"wrong\" order).
+ --
+ -- Note: for this to be meaningful in general (not depending on convergence properties),
+@@ -157,7 +157,7 @@ composeSeriesNaive g f = substituteNaive f g
+ 
+ -- | Naive implementation of 'substitute'
+ substituteNaive :: (Eq a, Num a) => [a] -> [a] -> [a]
+-substituteNaive as_ bs_ = 
++substituteNaive as_ bs_ =
+   case head as of
+     0 -> [ f n | n<-[0..] ]
+     _ -> error "PowerSeries/substituteNaive: we expect the the constant term of the inner series to be zero"
+@@ -168,7 +168,7 @@ substituteNaive as_ bs_ =
+     b j = bs !! j
+     f n = sum
+             [ b m * product [ (a i)^j | (i,j)<-es ] * fromInteger (multinomial (map snd es))
+-            | p <- partitions n 
++            | p <- partitions n
+             , let es = toExponentialForm p
+             , let m  = partitionWidth    p
+             ]
+@@ -183,7 +183,7 @@ substituteNaive as_ bs_ =
+ --
+ -- This implementation is taken from:
+ --
+--- M. Douglas McIlroy: Power Series, Power Serious 
++-- M. Douglas McIlroy: Power Series, Power Serious
+ lagrangeInversion :: (Eq a, Fractional a) => [a] -> [a]
+ lagrangeInversion xs = go (xs ++ repeat 0) where
+   go (0:fs) = rs where rs = 0 : divSeries unitSeries (composeSeries fs rs)
+@@ -204,24 +204,24 @@ lagrangeCoeff p = div numer denom where
+ -- > substitute (integralLagrangeInversion f) f == (0 : 1 : repeat 0)
+ --
+ integralLagrangeInversionNaive :: (Eq a, Num a) => [a] -> [a]
+-integralLagrangeInversionNaive series_ = 
++integralLagrangeInversionNaive series_ =
+   case series of
+     (0:1:rest) -> 0 : 1 : [ f n | n<-[1..] ]
+     _ -> error "integralLagrangeInversionNaive: the series should start with (0 + x + a2*x^2 + ...)"
+   where
+     series = series_ ++ repeat 0
+-    as  = tail series 
++    as  = tail series
+     a i = as !! i
+     f n = sum [ fromInteger (lagrangeCoeff p) * product [ (a i)^j | (i,j) <- toExponentialForm p ]
+               | p <- partitions n
+-              ] 
++              ]
+ 
+ -- | Naive implementation of 'lagrangeInversion'
+ lagrangeInversionNaive :: (Eq a, Fractional a) => [a] -> [a]
+-lagrangeInversionNaive series_ = 
++lagrangeInversionNaive series_ =
+   case series of
+-    (0:a1:rest) -> if a1 ==0 
+-      then err 
++    (0:a1:rest) -> if a1 ==0
++      then err
+       else 0 : (1/a1) : [ f n / a1^(n+1) | n<-[1..] ]
+     _ -> err
+   where
+@@ -232,7 +232,7 @@ lagrangeInversionNaive series_ =
+     a i = as !! i
+     f n = sum [ fromInteger (lagrangeCoeff p) * product [ (a i)^j | (i,j) <- toExponentialForm p ]
+               | p <- partitions n
+-              ] 
++              ]
+ 
+ 
+ --------------------------------------------------------------------------------
+@@ -295,29 +295,29 @@ dyckSeries = [ fromInteger (catalan i) | i<-[(0::Int)..] ]
+ --------------------------------------------------------------------------------
+ -- * \"Coin\" series
+ 
+--- | Power series expansion of 
+--- 
++-- | Power series expansion of
++--
+ -- > 1 / ( (1-x^k_1) * (1-x^k_2) * ... * (1-x^k_n) )
+ --
+ -- Example:
+ --
+--- @(coinSeries [2,3,5])!!k@ is the number of ways 
++-- @(coinSeries [2,3,5])!!k@ is the number of ways
+ -- to pay @k@ dollars with coins of two, three and five dollars.
+ --
+ -- TODO: better name?
+ coinSeries :: [Int] -> [Integer]
+ coinSeries [] = 1 : repeat 0
+ coinSeries (k:ks) = xs where
+-  xs = zipWith (+) (coinSeries ks) (replicate k 0 ++ xs) 
++  xs = zipWith (+) (coinSeries ks) (replicate k 0 ++ xs)
+ 
+--- | Generalization of the above to include coefficients: expansion of 
+---  
+--- > 1 / ( (1-a_1*x^k_1) * (1-a_2*x^k_2) * ... * (1-a_n*x^k_n) ) 
+--- 
++-- | Generalization of the above to include coefficients: expansion of
++--
++-- > 1 / ( (1-a_1*x^k_1) * (1-a_2*x^k_2) * ... * (1-a_n*x^k_n) )
++--
+ coinSeries' :: Num a => [(a,Int)] -> [a]
+ coinSeries' [] = 1 : repeat 0
+ coinSeries' ((a,k):aks) = xs where
+-  xs = zipWith (+) (coinSeries' aks) (replicate k 0 ++ map (*a) xs) 
++  xs = zipWith (+) (coinSeries' aks) (replicate k 0 ++ map (*a) xs)
+ 
+ convolveWithCoinSeries :: [Int] -> [Integer] -> [Integer]
+ convolveWithCoinSeries ks series1 = worker ks where
+@@ -349,52 +349,52 @@ convolveWithProductPSeries :: [[Int]] -> [Integer] -> [Integer]
+ convolveWithProductPSeries kss ser = foldl (flip convolveWithPSeries) ser kss
+ 
+ -- | This is the most general function in this module; all the others
+--- are special cases of this one.  
+-convolveWithProductPSeries' :: Num a => [[(a,Int)]] -> [a] -> [a] 
++-- are special cases of this one.
++convolveWithProductPSeries' :: Num a => [[(a,Int)]] -> [a] -> [a]
+ convolveWithProductPSeries' akss ser = foldl (flip convolveWithPSeries') ser akss
+-  
++
+ --------------------------------------------------------------------------------
+ -- * Reciprocals of polynomials
+ 
+ -- Reciprocals of polynomials, without coefficients
+ 
+--- | The power series expansion of 
++-- | The power series expansion of
+ --
+ -- > 1 / (1 - x^k_1 - x^k_2 - x^k_3 - ... - x^k_n)
+ --
+ pseries :: [Int] -> [Integer]
+ pseries ks = convolveWithPSeries ks unitSeries
+ 
+--- | Convolve with (the expansion of) 
++-- | Convolve with (the expansion of)
+ --
+ -- > 1 / (1 - x^k_1 - x^k_2 - x^k_3 - ... - x^k_n)
+ --
+ convolveWithPSeries :: [Int] -> [Integer] -> [Integer]
+-convolveWithPSeries ks series1 = ys where 
+-  series = series1 ++ repeat 0 
+-  ys = worker ks ys 
+-  worker [] _ = series 
++convolveWithPSeries ks series1 = ys where
++  series = series1 ++ repeat 0
++  ys = worker ks ys
++  worker [] _ = series
+   worker (k:ks) ys = xs where
+     xs = zipWith (+) (replicate k 0 ++ ys) (worker ks ys)
+ 
+ --------------------------------------------------------------------------------
+ --  Reciprocals of polynomials, with coefficients
+ 
+--- | The expansion of 
++-- | The expansion of
+ --
+ -- > 1 / (1 - a_1*x^k_1 - a_2*x^k_2 - a_3*x^k_3 - ... - a_n*x^k_n)
+ --
+ pseries' :: Num a => [(a,Int)] -> [a]
+ pseries' aks = convolveWithPSeries' aks unitSeries
+ 
+--- | Convolve with (the expansion of) 
++-- | Convolve with (the expansion of)
+ --
+ -- > 1 / (1 - a_1*x^k_1 - a_2*x^k_2 - a_3*x^k_3 - ... - a_n*x^k_n)
+ --
+ convolveWithPSeries' :: Num a => [(a,Int)] -> [a] -> [a]
+-convolveWithPSeries' aks series1 = ys where 
+-  series = series1 ++ repeat 0 
+-  ys = worker aks ys 
++convolveWithPSeries' aks series1 = ys where
++  series = series1 ++ repeat 0
++  ys = worker aks ys
+   worker [] _ = series
+   worker ((a,k):aks) ys = xs where
+     xs = zipWith (+) (replicate k 0 ++ map (*a) ys) (worker aks ys)
+@@ -407,10 +407,10 @@ signValue Plus  =  1
+ signValue Minus = -1
+ -}
+ 
+-signedPSeries :: [(Sign,Int)] -> [Integer] 
++signedPSeries :: [(Sign,Int)] -> [Integer]
+ signedPSeries aks = convolveWithSignedPSeries aks unitSeries
+ 
+--- | Convolve with (the expansion of) 
++-- | Convolve with (the expansion of)
+ --
+ -- > 1 / (1 +- x^k_1 +- x^k_2 +- x^k_3 +- ... +- x^k_n)
+ --
+@@ -418,17 +418,17 @@ signedPSeries aks = convolveWithSignedPSeries aks unitSeries
+ -- Note: 'Plus' corresponds to the coefficient @-1@ in `pseries'` (since
+ -- there is a minus sign in the definition there)!
+ convolveWithSignedPSeries :: [(Sign,Int)] -> [Integer] -> [Integer]
+-convolveWithSignedPSeries aks series1 = ys where 
+-  series = series1 ++ repeat 0 
+-  ys = worker aks ys 
++convolveWithSignedPSeries aks series1 = ys where
++  series = series1 ++ repeat 0
++  ys = worker aks ys
+   worker [] _ = series
+   worker ((a,k):aks) ys = xs where
+     xs = case a of
+-      Minus -> zipWith (+) one two 
++      Minus -> zipWith (+) one two
+       Plus  -> zipWith (-) one two
+     one = worker aks ys
+     two = replicate k 0 ++ ys
+-     
++
+ --------------------------------------------------------------------------------
+ 
+ 
+diff --git a/Math/Combinat/Partitions/Integer.hs b/Math/Combinat/Partitions/Integer.hs
+index 1b25e0b..35e38e1 100644
+--- a/Math/Combinat/Partitions/Integer.hs
++++ b/Math/Combinat/Partitions/Integer.hs
+@@ -15,61 +15,61 @@
+ -- can be represented by the (English notation) Ferrers diagram:
+ --
+ -- <<svg/ferrers.svg>>
+--- 
++--
+ 
+ {-# LANGUAGE CPP, BangPatterns, ScopedTypeVariables #-}
+-module Math.Combinat.Partitions.Integer 
++module Math.Combinat.Partitions.Integer
+   ( -- module Math.Combinat.Partitions.Integer.Count
+     module Math.Combinat.Partitions.Integer.Naive
+     -- * Types and basic stuff
+   , Partition
+     -- * Conversion to\/from lists
+-  , fromPartition 
+-  , mkPartition 
+-  , toPartition 
+-  , toPartitionUnsafe 
+-  , isPartition 
++  , fromPartition
++  , mkPartition
++  , toPartition
++  , toPartitionUnsafe
++  , isPartition
+     -- * Union and sum
+   , unionOfPartitions
+   , sumOfPartitions
+     -- * Generating partitions
+-  , partitions 
++  , partitions
+   , partitions'
+-  , allPartitions 
+-  , allPartitionsGrouped 
+-  , allPartitions'  
+-  , allPartitionsGrouped'  
++  , allPartitions
++  , allPartitionsGrouped
++  , allPartitions'
++  , allPartitionsGrouped'
+     -- * Counting partitions
+   , countPartitions
+   , countPartitions'
+   , countAllPartitions
+   , countAllPartitions'
+-  , countPartitionsWithKParts 
++  , countPartitionsWithKParts
+     -- * Random partitions
+   , randomPartition
+   , randomPartitions
+     -- * Dominating \/ dominated partitions
+-  , dominatedPartitions 
+-  , dominatingPartitions 
++  , dominatedPartitions
++  , dominatingPartitions
+     -- * Partitions with given number of parts
+   , partitionsWithKParts
+     -- * Partitions with only odd\/distinct parts
+-  , partitionsWithOddParts 
++  , partitionsWithOddParts
+   , partitionsWithDistinctParts
+     -- * Sub- and super-partitions of a given partition
+-  , subPartitions 
+-  , allSubPartitions 
+-  , superPartitions 
++  , subPartitions
++  , allSubPartitions
++  , superPartitions
+     -- * ASCII Ferrers diagrams
+   , PartitionConvention(..)
+-  , asciiFerrersDiagram 
++  , asciiFerrersDiagram
+   , asciiFerrersDiagram'
+   )
+   where
+ 
+ --------------------------------------------------------------------------------
+ 
+-import Data.List
++import Data.List (sortBy)
+ import Control.Monad ( liftM , replicateM )
+ 
+ -- import Data.Map (Map)
+@@ -92,7 +92,7 @@ import Math.Combinat.Partitions.Integer.Count
+ 
+ fromPartition :: Partition -> [Int]
+ fromPartition (Partition_ part) = part
+-  
++
+ -- | Sorts the input, and cuts the nonpositive elements.
+ mkPartition :: [Int] -> Partition
+ mkPartition xs = toPartitionUnsafe $ sortBy (reverseCompare) $ filter (>0) xs
+@@ -106,8 +106,8 @@ toPartition xs = if isPartition xs
+ -- | Assumes that the input is decreasing.
+ toPartitionUnsafe :: [Int] -> Partition
+ toPartitionUnsafe = Partition_
+-  
+--- | This returns @True@ if the input is non-increasing sequence of 
++
++-- | This returns @True@ if the input is non-increasing sequence of
+ -- /positive/ integers (possibly empty); @False@ otherwise.
+ --
+ isPartition :: [Int] -> Bool
+@@ -118,13 +118,13 @@ isPartition (x:xs@(y:_)) = (x >= y) && isPartition xs
+ --------------------------------------------------------------------------------
+ -- * Union and sum
+ 
+--- | This is simply the union of parts. For example 
++-- | This is simply the union of parts. For example
+ --
+ -- > Partition [4,2,1] `unionOfPartitions` Partition [4,3,1] == Partition [4,4,3,2,1,1]
+ --
+ -- Note: This is the dual of pointwise sum, 'sumOfPartitions'
+ --
+-unionOfPartitions :: Partition -> Partition -> Partition 
++unionOfPartitions :: Partition -> Partition -> Partition
+ unionOfPartitions (Partition_ xs) (Partition_ ys) = mkPartition (xs ++ ys)
+ 
+ -- | Pointwise sum of the parts. For example:
+@@ -133,7 +133,7 @@ unionOfPartitions (Partition_ xs) (Partition_ ys) = mkPartition (xs ++ ys)
+ --
+ -- Note: This is the dual of 'unionOfPartitions'
+ --
+-sumOfPartitions :: Partition -> Partition -> Partition 
++sumOfPartitions :: Partition -> Partition -> Partition
+ sumOfPartitions (Partition_ xs) (Partition_ ys) = Partition_ (longZipWith 0 0 (+) xs ys)
+ 
+ --------------------------------------------------------------------------------
+@@ -144,11 +144,11 @@ partitions :: Int -> [Partition]
+ partitions = map toPartitionUnsafe . _partitions
+ 
+ -- | Partitions of d, fitting into a given rectangle. The order is again lexicographic.
+-partitions'  
++partitions'
+   :: (Int,Int)     -- ^ (height,width)
+   -> Int           -- ^ d
+   -> [Partition]
+-partitions' hw d = map toPartitionUnsafe $ _partitions' hw d        
++partitions' hw d = map toPartitionUnsafe $ _partitions' hw d
+ 
+ --------------------------------------------------------------------------------
+ 
+@@ -162,13 +162,13 @@ allPartitionsGrouped :: Int -> [[Partition]]
+ allPartitionsGrouped d = [ partitions i | i <- [0..d] ]
+ 
+ -- | All integer partitions fitting into a given rectangle.
+-allPartitions'  
++allPartitions'
+   :: (Int,Int)        -- ^ (height,width)
+   -> [Partition]
+ allPartitions' (h,w) = concat [ partitions' (h,w) i | i <- [0..d] ] where d = h*w
+ 
+ -- | All integer partitions fitting into a given rectangle, grouped by weight.
+-allPartitionsGrouped'  
++allPartitionsGrouped'
+   :: (Int,Int)        -- ^ (height,width)
+   -> [[Partition]]
+ allPartitionsGrouped' (h,w) = [ partitions' (h,w) i | i <- [0..d] ] where d = h*w
+@@ -177,7 +177,7 @@ allPartitionsGrouped' (h,w) = [ partitions' (h,w) i | i <- [0..d] ] where d = h*
+ ---------------------------------------------------------------------------------
+ -- * Random partitions
+ 
+--- | Uniformly random partition of the given weight. 
++-- | Uniformly random partition of the given weight.
+ --
+ -- NOTE: This algorithm is effective for small @n@-s (say @n@ up to a few hundred \/ one thousand it should work nicely),
+ -- and the first time it is executed may be slower (as it needs to build the table of partitions counts first)
+@@ -195,19 +195,19 @@ randomPartition n g = (p, g') where
+ -- | Generates several uniformly random partitions of @n@ at the same time.
+ -- Should be a little bit faster then generating them individually.
+ --
+-randomPartitions 
+-  :: forall g. RandomGen g 
++randomPartitions
++  :: forall g. RandomGen g
+   => Int   -- ^ number of partitions to generate
+   -> Int   -- ^ the weight of the partitions
+   -> g -> ([Partition], g)
+ randomPartitions howmany n = runRand $ replicateM howmany (worker n []) where
+ 
+   cnt = countPartitions
+- 
++
+   finish :: [(Int,Int)] -> Partition
+   finish = mkPartition . concatMap f where f (j,d) = replicate j d
+ 
+-  fi :: Int -> Integer 
++  fi :: Int -> Integer
+   fi = fromIntegral
+ 
+   find_jd :: Int -> Integer -> (Int,Int)
+@@ -215,9 +215,9 @@ randomPartitions howmany n = runRand $ replicateM howmany (worker n []) where
+     go :: Integer -> [(Int,Int)] -> (Int,Int)
+     go !s []   = (1,1)       -- ??
+     go !s [jd] = jd          -- ??
+-    go !s (jd@(j,d):rest) = 
+-      if s' > capm 
+-        then jd 
++    go !s (jd@(j,d):rest) =
++      if s' > capm
++        then jd
+         else go s' rest
+       where
+         s' = s + fi d * cnt (m - j*d)
+@@ -236,16 +236,16 @@ randomPartitions howmany n = runRand $ replicateM howmany (worker n []) where
+ -- (that is, all partial sums are less or equal):
+ --
+ -- > dominatedPartitions lam == [ mu | mu <- partitions (weight lam), lam `dominates` mu ]
+--- 
+-dominatedPartitions :: Partition -> [Partition]    
++--
++dominatedPartitions :: Partition -> [Partition]
+ dominatedPartitions (Partition_ lambda) = map Partition_ (_dominatedPartitions lambda)
+ 
+ -- | Lists all partitions of the sime weight as @mu@ and also dominating @mu@
+ -- (that is, all partial sums are greater or equal):
+ --
+ -- > dominatingPartitions mu == [ lam | lam <- partitions (weight mu), lam `dominates` mu ]
+--- 
+-dominatingPartitions :: Partition -> [Partition]    
++--
++dominatingPartitions :: Partition -> [Partition]
+ dominatingPartitions (Partition_ mu) = map Partition_ (_dominatingPartitions mu)
+ 
+ --------------------------------------------------------------------------------
+@@ -257,7 +257,7 @@ dominatingPartitions (Partition_ mu) = map Partition_ (_dominatingPartitions mu)
+ --
+ -- Naive recursive algorithm.
+ --
+-partitionsWithKParts 
++partitionsWithKParts
+   :: Int    -- ^ @k@ = number of parts
+   -> Int    -- ^ @n@ = the integer we partition
+   -> [Partition]
+@@ -267,7 +267,7 @@ partitionsWithKParts k n = map Partition_ $ go n k n where
+   k = number of parts
+   n = integer
+ -}
+-  go !h !k !n 
++  go !h !k !n
+     | k <  0     = []
+     | k == 0     = if h>=0 && n==0 then [[] ] else []
+     | k == 1     = if h>=n && n>=1 then [[n]] else []
+@@ -294,7 +294,7 @@ partitionsWithEvenParts d = map Partition (go d d) where
+ -}
+ 
+ -- | Partitions of @n@ with distinct parts.
+--- 
++--
+ -- Note:
+ --
+ -- > length (partitionsWithDistinctParts d) == length (partitionsWithOddParts d)
+@@ -324,7 +324,7 @@ allSubPartitions (Partition_ ps) = map Partition_ (_allSubPartitions ps)
+ --
+ superPartitions :: Int -> Partition -> [Partition]
+ superPartitions d (Partition_ ps) = map toPartitionUnsafe (_superPartitions d ps)
+-    
++
+ 
+ --------------------------------------------------------------------------------
+ -- * ASCII Ferrers diagrams
+@@ -333,7 +333,7 @@ superPartitions d (Partition_ ps) = map toPartitionUnsafe (_superPartitions d ps
+ -- For example, the partition [5,4,1] corrsponds to:
+ --
+ -- In standard English notation:
+--- 
++--
+ -- >  @@@@@
+ -- >  @@@@
+ -- >  @
+@@ -341,7 +341,7 @@ superPartitions d (Partition_ ps) = map toPartitionUnsafe (_superPartitions d ps
+ --
+ -- In English notation rotated by 90 degrees counter-clockwise:
+ --
+--- > @  
++-- > @
+ -- > @@
+ -- > @@
+ -- > @@
+@@ -350,7 +350,7 @@ superPartitions d (Partition_ ps) = map toPartitionUnsafe (_superPartitions d ps
+ --
+ -- And in French notation:
+ --
+--- 
++--
+ -- >  @
+ -- >  @@@@
+ -- >  @@@@@
+@@ -373,7 +373,7 @@ asciiFerrersDiagram = asciiFerrersDiagram' EnglishNotation '@'
+ 
+ asciiFerrersDiagram' :: PartitionConvention -> Char -> Partition -> ASCII
+ asciiFerrersDiagram' conv ch part = ASCII.asciiFromLines (map f ys) where
+-  f n = replicate n ch 
++  f n = replicate n ch
+   ys  = case conv of
+           EnglishNotation    -> fromPartition part
+           EnglishNotationCCW -> reverse $ fromPartition $ dualPartition part
+diff --git a/Math/Combinat/Partitions/Integer/Count.hs b/Math/Combinat/Partitions/Integer/Count.hs
+index fe5b56c..a8d66cd 100644
+--- a/Math/Combinat/Partitions/Integer/Count.hs
++++ b/Math/Combinat/Partitions/Integer/Count.hs
+@@ -6,7 +6,7 @@ module Math.Combinat.Partitions.Integer.Count where
+ 
+ --------------------------------------------------------------------------------
+ 
+-import Data.List
++import Data.List (foldl')
+ import Control.Monad ( liftM , replicateM )
+ 
+ -- import Data.Map (Map)
+@@ -27,7 +27,7 @@ import System.Random
+ newtype TableOfIntegers = TableOfIntegers [Array Int Integer]
+ 
+ lookupInteger :: TableOfIntegers -> Int -> Integer
+-lookupInteger (TableOfIntegers table) !n 
++lookupInteger (TableOfIntegers table) !n
+   | n >= 0  = (table !! k) ! r
+   | n <  0  = 0
+   where
+@@ -40,10 +40,10 @@ makeTableOfIntegers user = table where
+   calc  = user lkp
+   lkp   = lookupInteger table
+   table = TableOfIntegers
+-    [ listArray (0,1023) (map calc [a..b]) 
+-    | k<-[0..] 
+-    , let a = 1024*k 
+-    , let b = 1024*(k+1) - 1 
++    [ listArray (0,1023) (map calc [a..b])
++    | k<-[0..]
++    , let a = 1024*k
++    , let b = 1024*(k+1) - 1
+     ]
+ 
+ --------------------------------------------------------------------------------
+@@ -51,7 +51,7 @@ makeTableOfIntegers user = table where
+ 
+ -- | Number of partitions of @n@ (looking up a table built using Euler's algorithm)
+ countPartitions :: Int -> Integer
+-countPartitions = lookupInteger partitionCountTable 
++countPartitions = lookupInteger partitionCountTable
+ 
+ -- | This uses the power series expansion of the infinite product. It is slower than the above.
+ countPartitionsInfiniteProduct :: Int -> Integer
+@@ -75,9 +75,9 @@ partitionCountTable = table where
+ 
+   table = makeTableOfIntegers fun
+ 
+-  fun lkp !n 
+-    | n >  1 = foldl' (+) 0 
+-             [ (if even k then negate else id) 
++  fun lkp !n
++    | n >  1 = foldl' (+) 0
++             [ (if even k then negate else id)
+                  ( lkp (n - div (k*(3*k+1)) 2)
+                  + lkp (n - div (k*(3*k-1)) 2)
+                  )
+@@ -99,7 +99,7 @@ partitionCountList = map countPartitions [0..]
+ 
+ -- | Infinite list of number of partitions of @0,1,2,...@
+ --
+--- This uses the infinite product formula the generating function of partitions, 
++-- This uses the infinite product formula the generating function of partitions,
+ -- recursively expanding it; it is reasonably fast for small numbers.
+ --
+ -- > partitionCountListInfiniteProduct == map countPartitions [0..]
+@@ -107,13 +107,13 @@ partitionCountList = map countPartitions [0..]
+ partitionCountListInfiniteProduct :: [Integer]
+ partitionCountListInfiniteProduct = final where
+ 
+-  final = go 1 (1:repeat 0) 
++  final = go 1 (1:repeat 0)
+ 
+   go !k (x:xs) = x : go (k+1) ys where
+     ys = zipWith (+) xs (take k final ++ ys)
+     -- explanation:
+     --   xs == drop k $ f (k-1)
+-    --   ys == drop k $ f (k  )  
++    --   ys == drop k $ f (k  )
+ 
+ {-
+ 
+@@ -127,12 +127,12 @@ f 1 = [1,1,1,1,1,1,1,1...]
+ f 2 = [1,1,2,2,3,3,4,4...]
+ f 3 = [1,1,2,3,4,5,7,8...]
+ 
+-observe: 
++observe:
+ 
+ * take (k+1) (f k) == take (k+1) partitionCountList
+ * f (k+1) == zipWith (+) (f k) (replicate (k+1) 0 ++ f (k+1))
+ 
+-now apply (drop (k+1)) to the second one : 
++now apply (drop (k+1)) to the second one :
+ 
+ * drop (k+1) (f (k+1)) == zipWith (+) (drop (k+1) $ f k) (f (k+1))
+ * f (k+1) = take (k+1) final ++ drop (k+1) (f (k+1))
+@@ -159,7 +159,7 @@ countAllPartitions d = sum' [ countPartitions i | i <- [0..d] ]
+ -- | Count all partitions fitting into a rectangle.
+ -- # = \\binom { h+w } { h }
+ countAllPartitions' :: (Int,Int) -> Integer
+-countAllPartitions' (h,w) = 
++countAllPartitions' (h,w) =
+   binomial (h+w) (min h w)
+   --sum [ countPartitions' (h,w) i | i <- [0..d] ] where d = h*w
+ 
+@@ -172,7 +172,7 @@ countPartitions' _ 0 = 1
+ countPartitions' (0,_) d = if d==0 then 1 else 0
+ countPartitions' (_,0) d = if d==0 then 1 else 0
+ countPartitions' (h,w) d = sum
+-  [ countPartitions' (i,w-1) (d-i) | i <- [1..min d h] ] 
++  [ countPartitions' (i,w-1) (d-i) | i <- [1..min d h] ]
+ 
+ --------------------------------------------------------------------------------
+ -- * Partitions with given number of parts
+@@ -181,12 +181,12 @@ countPartitions' (h,w) d = sum
+ --
+ -- Naive recursive algorithm.
+ --
+-countPartitionsWithKParts 
++countPartitionsWithKParts
+   :: Int    -- ^ @k@ = number of parts
+   -> Int    -- ^ @n@ = the integer we partition
+   -> Integer
+ countPartitionsWithKParts k n = go n k n where
+-  go !h !k !n 
++  go !h !k !n
+     | k <  0     = 0
+     | k == 0     = if h>=0 && n==0 then 1 else 0
+     | k == 1     = if h>=n && n>=1 then 1 else 0
+diff --git a/Math/Combinat/Partitions/Integer/IntList.hs b/Math/Combinat/Partitions/Integer/IntList.hs
+index 0da13ac..fbb6c6c 100644
+--- a/Math/Combinat/Partitions/Integer/IntList.hs
++++ b/Math/Combinat/Partitions/Integer/IntList.hs
+@@ -1,6 +1,6 @@
+ 
+ -- | Partition functions working on lists of integers.
+--- 
++--
+ -- It's not recommended to use this module directly.
+ 
+ {-# LANGUAGE CPP, BangPatterns, ScopedTypeVariables #-}
+@@ -8,7 +8,7 @@ module Math.Combinat.Partitions.Integer.IntList where
+ 
+ --------------------------------------------------------------------------------
+ 
+-import Data.List
++import Data.List (group, sortBy)
+ import Control.Monad ( liftM , replicateM )
+ 
+ import Math.Combinat.Numbers ( factorial , binomial , multinomial )
+@@ -25,8 +25,8 @@ import Math.Combinat.Partitions.Integer.Count ( countPartitions )
+ -- | Sorts the input, and cuts the nonpositive elements.
+ _mkPartition :: [Int] -> [Int]
+ _mkPartition xs = sortBy (reverseCompare) $ filter (>0) xs
+- 
+--- | This returns @True@ if the input is non-increasing sequence of 
++
++-- | This returns @True@ if the input is non-increasing sequence of
+ -- /positive/ integers (possibly empty); @False@ otherwise.
+ --
+ _isPartition :: [Int] -> Bool
+@@ -39,7 +39,7 @@ _dualPartition :: [Int] -> [Int]
+ _dualPartition [] = []
+ _dualPartition xs = go 0 (_diffSequence xs) [] where
+   go !i (d:ds) acc = go (i+1) ds (d:acc)
+-  go n  []     acc = finish n acc 
++  go n  []     acc = finish n acc
+   finish !j (k:ks) = replicate k j ++ finish (j-1) ks
+   finish _  []     = []
+ 
+@@ -70,7 +70,7 @@ _dualPartitionNaive xs@(k:_) = [ length $ filter (>=i) xs | i <- [1..k] ]
+ -- @[a1-a2,a2-a3,...,an-0]@
+ _diffSequence :: [Int] -> [Int]
+ _diffSequence = go where
+-  go (x:ys@(y:_)) = (x-y) : go ys 
++  go (x:ys@(y:_)) = (x-y) : go ys
+   go [x] = [x]
+   go []  = []
+ 
+@@ -84,7 +84,7 @@ _diffSequence = go where
+ --
+ 
+ _elements :: [Int] -> [(Int,Int)]
+-_elements shape = [ (i,j) | (i,l) <- zip [1..] shape, j<-[1..l] ] 
++_elements shape = [ (i,j) | (i,l) <- zip [1..] shape, j<-[1..l] ]
+ 
+ ---------------------------------------------------------------------------------
+ -- * Exponential form
+@@ -100,7 +100,7 @@ _toExponentialForm = reverse . map (\xs -> (head xs,length xs)) . group
+ _fromExponentialForm :: [(Int,Int)] -> [Int]
+ _fromExponentialForm = sortBy reverseCompare . go where
+   go ((j,e):rest) = replicate e j ++ go rest
+-  go []           = []   
++  go []           = []
+ 
+ ---------------------------------------------------------------------------------
+ -- * Generating partitions
+@@ -123,20 +123,20 @@ _allPartitionsGrouped d = [ _partitions i | i <- [0..d] ]
+ ---------------------------------------------------------------------------------
+ 
+ -- | Integer partitions of @d@, fitting into a given rectangle, as lists.
+-_partitions' 
++_partitions'
+   :: (Int,Int)     -- ^ (height,width)
+   -> Int           -- ^ d
+-  -> [[Int]]        
+-_partitions' _ 0 = [[]] 
++  -> [[Int]]
++_partitions' _ 0 = [[]]
+ _partitions' ( 0 , _) d = if d==0 then [[]] else []
+ _partitions' ( _ , 0) d = if d==0 then [[]] else []
+-_partitions' (!h ,!w) d = 
++_partitions' (!h ,!w) d =
+   [ i:xs | i <- [1..min d h] , xs <- _partitions' (i,w-1) (d-i) ]
+ 
+ ---------------------------------------------------------------------------------
+ -- * Random partitions
+ 
+--- | Uniformly random partition of the given weight. 
++-- | Uniformly random partition of the given weight.
+ --
+ -- NOTE: This algorithm is effective for small @n@-s (say @n@ up to a few hundred \/ one thousand it should work nicely),
+ -- and the first time it is executed may be slower (as it needs to build the table 'partitionCountList' first)
+@@ -154,19 +154,19 @@ _randomPartition n g = (p, g') where
+ -- | Generates several uniformly random partitions of @n@ at the same time.
+ -- Should be a little bit faster then generating them individually.
+ --
+-_randomPartitions 
+-  :: forall g. RandomGen g 
++_randomPartitions
++  :: forall g. RandomGen g
+   => Int   -- ^ number of partitions to generate
+   -> Int   -- ^ the weight of the partitions
+   -> g -> ([[Int]], g)
+ _randomPartitions howmany n = runRand $ replicateM howmany (worker n []) where
+ 
+   cnt = countPartitions
+- 
++
+   finish :: [(Int,Int)] -> [Int]
+   finish = _mkPartition . concatMap f where f (j,d) = replicate j d
+ 
+-  fi :: Int -> Integer 
++  fi :: Int -> Integer
+   fi = fromIntegral
+ 
+   find_jd :: Int -> Integer -> (Int,Int)
+@@ -174,9 +174,9 @@ _randomPartitions howmany n = runRand $ replicateM howmany (worker n []) where
+     go :: Integer -> [(Int,Int)] -> (Int,Int)
+     go !s []   = (1,1)       -- ??
+     go !s [jd] = jd          -- ??
+-    go !s (jd@(j,d):rest) = 
+-      if s' > capm 
+-        then jd 
++    go !s (jd@(j,d):rest) =
++      if s' > capm
++        then jd
+         else go s' rest
+       where
+         s' = s + fi d * cnt (m - j*d)
+@@ -190,7 +190,7 @@ _randomPartitions howmany n = runRand $ replicateM howmany (worker n []) where
+ 
+ 
+ ---------------------------------------------------------------------------------
+--- * Dominance order 
++-- * Dominance order
+ 
+ -- | @q \`dominates\` p@ returns @True@ if @q >= p@ in the dominance order of partitions
+ -- (this is partial ordering on the set of partitions of @n@).
+@@ -207,7 +207,7 @@ _dominates qs ps
+ -- (that is, all partial sums are less or equal):
+ --
+ -- > dominatedPartitions lam == [ mu | mu <- partitions (weight lam), lam `dominates` mu ]
+--- 
++--
+ _dominatedPartitions :: [Int] -> [[Int]]
+ _dominatedPartitions []     = [[]]
+ _dominatedPartitions lambda = go (head lambda) w dsums 0 where
+@@ -217,8 +217,8 @@ _dominatedPartitions lambda = go (head lambda) w dsums 0 where
+   dsums = scanl1 (+) (lambda ++ repeat 0)
+ 
+   go _   0 _       _  = [[]]
+-  go !h !w (!d:ds) !e  
+-    | w >  0  = [ (a:as) | a <- [1..min h (d-e)] , as <- go a (w-a) ds (e+a) ] 
++  go !h !w (!d:ds) !e
++    | w >  0  = [ (a:as) | a <- [1..min h (d-e)] , as <- go a (w-a) ds (e+a) ]
+     | w == 0  = [[]]
+     | w <  0  = error "_dominatedPartitions: fatal error; shouldn't happen"
+ 
+@@ -226,7 +226,7 @@ _dominatedPartitions lambda = go (head lambda) w dsums 0 where
+ -- (that is, all partial sums are greater or equal):
+ --
+ -- > dominatingPartitions mu == [ lam | lam <- partitions (weight mu), lam `dominates` mu ]
+--- 
++--
+ _dominatingPartitions :: [Int] -> [[Int]]
+ _dominatingPartitions []     = [[]]
+ _dominatingPartitions mu     = go w w dsums 0 where
+@@ -236,8 +236,8 @@ _dominatingPartitions mu     = go w w dsums 0 where
+   dsums = scanl1 (+) (mu ++ repeat 0)
+ 
+   go _   0 _       _  = [[]]
+-  go !h !w (!d:ds) !e  
+-    | w >  0  = [ (a:as) | a <- [max 0 (d-e)..min h w] , as <- go a (w-a) ds (e+a) ] 
++  go !h !w (!d:ds) !e
++    | w >  0  = [ (a:as) | a <- [max 0 (d-e)..min h w] , as <- go a (w-a) ds (e+a) ]
+     | w == 0  = [[]]
+     | w <  0  = error "_dominatingPartitions: fatal error; shouldn't happen"
+ 
+@@ -250,7 +250,7 @@ _dominatingPartitions mu     = go w w dsums 0 where
+ --
+ -- Naive recursive algorithm.
+ --
+-_partitionsWithKParts 
++_partitionsWithKParts
+   :: Int    -- ^ @k@ = number of parts
+   -> Int    -- ^ @n@ = the integer we partition
+   -> [[Int]]
+@@ -260,7 +260,7 @@ _partitionsWithKParts k n = go n k n where
+   k = number of parts
+   n = integer
+ -}
+-  go !h !k !n 
++  go !h !k !n
+     | k <  0     = []
+     | k == 0     = if h>=0 && n==0 then [[] ] else []
+     | k == 1     = if h>=n && n>=1 then [[n]] else []
+@@ -287,7 +287,7 @@ _partitionsWithEvenParts d = (go d d) where
+ -}
+ 
+ -- | Partitions of @n@ with distinct parts.
+--- 
++--
+ -- Note:
+ --
+ -- > length (partitionsWithDistinctParts d) == length (partitionsWithOddParts d)
+@@ -326,7 +326,7 @@ _subPartitions d big
+   where
+     go :: Int -> Int -> [Int] -> [[Int]]
+     go !k !h []      = if k==0 then [[]] else []
+-    go !k !h (b:bs) 
++    go !k !h (b:bs)
+       | k<0 || h<0   = []
+       | k==0         = [[]]
+       | h==0         = []
+@@ -336,12 +336,12 @@ _subPartitions d big
+ 
+ -- | All sub-partitions of a given partition
+ _allSubPartitions :: [Int] -> [[Int]]
+-_allSubPartitions big 
++_allSubPartitions big
+   | null big   = [[]]
+   | otherwise  = go (head big) big
+   where
+     go _  [] = [[]]
+-    go !h (b:bs) 
++    go !h (b:bs)
+       | h==0         = []
+       | otherwise    = [] : [ this:rest | this <- [1..min h b] , rest <- go this bs ]
+ 
+@@ -362,11 +362,11 @@ _superPartitions dd small
+     -- d = remaining weight of the outer partition we are constructing
+     -- w = remaining weight of the inner partition (we need to reserve at least this amount)
+     -- h = max height (decreasing)
+-    go !d !w !h (!a:as@(b:_)) 
++    go !d !w !h (!a:as@(b:_))
+       | d < 0     = []
+       | d == 0    = if a == 0 then [[]] else []
+       | otherwise = [ this:rest | this <- [max 1 a .. min h (d-w)] , rest <- go (d-this) (w-b) this as ]
+-    
++
+ --------------------------------------------------------------------------------
+ -- * The Pieri rule
+ 
+@@ -374,25 +374,25 @@ _superPartitions dd small
+ --
+ -- See for example <http://en.wikipedia.org/wiki/Pieri's_formula>
+ --
+--- | We assume here that @lambda@ is a partition (non-increasing sequence of /positive/ integers)! 
+-_pieriRule :: [Int] -> Int -> [[Int]] 
++-- | We assume here that @lambda@ is a partition (non-increasing sequence of /positive/ integers)!
++_pieriRule :: [Int] -> Int -> [[Int]]
+ _pieriRule lambda n
+     | n == 0     = [lambda]
+-    | n <  0     = [] 
+-    | otherwise  = go n diffs dsums (lambda++[0]) 
++    | n <  0     = []
++    | otherwise  = go n diffs dsums (lambda++[0])
+     where
+       diffs = n : _diffSequence lambda                 -- maximum we can add to a given row
+       dsums = reverse $ scanl1 (+) (reverse diffs)    -- partial sums of remaining total we can add
+-      go !k (d:ds) (p:ps@(q:_)) (l:ls) 
++      go !k (d:ds) (p:ps@(q:_)) (l:ls)
+         | k > p     = []
+         | otherwise = [ h:tl | a <- [ max 0 (k-q) .. min d k ] , let h = l+a , tl <- go (k-a) ds ps ls ]
+-      go !k [d]    _      [l]    = if k <= d 
++      go !k [d]    _      [l]    = if k <= d
+                                      then if l+k>0 then [[l+k]] else [[]]
+                                      else []
+       go !k []     _      _      = if k==0 then [[]] else []
+ 
+ -- | The dual Pieri rule computes @s[lambda]*e[n]@ as a sum of @s[mu]@-s (each with coefficient 1)
+-_dualPieriRule :: [Int] -> Int -> [[Int]] 
++_dualPieriRule :: [Int] -> Int -> [[Int]]
+ _dualPieriRule lam n = map _dualPartition $ _pieriRule (_dualPartition lam) n
+ 
+ --------------------------------------------------------------------------------
+diff --git a/Math/Combinat/Partitions/Integer/Naive.hs b/Math/Combinat/Partitions/Integer/Naive.hs
+index 55b9466..113e9ae 100644
+--- a/Math/Combinat/Partitions/Integer/Naive.hs
++++ b/Math/Combinat/Partitions/Integer/Naive.hs
+@@ -5,14 +5,13 @@
+ --
+ -- This is an internal module, you are not supposed to import it directly.
+ --
+- 
++
+ 
+ {-# LANGUAGE CPP, BangPatterns, ScopedTypeVariables, PatternSynonyms, ViewPatterns #-}
+ module Math.Combinat.Partitions.Integer.Naive where
+ 
+ --------------------------------------------------------------------------------
+ 
+-import Data.List 
+ import Control.Monad ( liftM , replicateM )
+ 
+ -- import Data.Map (Map)
+@@ -32,7 +31,7 @@ import Math.Combinat.Partitions.Integer.Count ( countPartitions )
+ --------------------------------------------------------------------------------
+ -- * Type and basic stuff
+ 
+--- | A partition of an integer. The additional invariant enforced here is that partitions 
++-- | A partition of an integer. The additional invariant enforced here is that partitions
+ -- are monotone decreasing sequences of /positive/ integers. The @Ord@ instance is lexicographical.
+ newtype Partition = Partition [Int] deriving (Eq,Ord,Show,Read)
+ 
+@@ -56,33 +55,33 @@ partitionHeight :: Partition -> Int
+ partitionHeight (Partition part) = case part of
+   (p:_) -> p
+   []    -> 0
+-  
++
+ -- | The length of the sequence (that is, the number of parts).
+ partitionWidth :: Partition -> Int
+ partitionWidth (Partition part) = length part
+ 
+ instance HasHeight Partition where
+   height = partitionHeight
+- 
++
+ instance HasWidth Partition where
+   width = partitionWidth
+ 
+ heightWidth :: Partition -> (Int,Int)
+ heightWidth part = (height part, width part)
+ 
+--- | The weight of the partition 
++-- | The weight of the partition
+ --   (that is, the sum of the corresponding sequence).
+ partitionWeight :: Partition -> Int
+ partitionWeight (Partition part) = sum' part
+ 
+-instance HasWeight Partition where 
++instance HasWeight Partition where
+   weight = partitionWeight
+ 
+ -- | The dual (or conjugate) partition.
+ dualPartition :: Partition -> Partition
+ dualPartition (Partition part) = Partition (_dualPartition part)
+ 
+-instance HasDuality Partition where 
++instance HasDuality Partition where
+   dual = dualPartition
+ 
+ -- | Example:
+@@ -97,7 +96,7 @@ elements :: Partition -> [(Int,Int)]
+ elements (Partition part) = _elements part
+ 
+ --------------------------------------------------------------------------------
+--- * Pattern synonyms 
++-- * Pattern synonyms
+ 
+ -- | Pattern sysnonyms allows us to use existing code with minimal modifications
+ pattern Nil :: Partition
+@@ -108,19 +107,19 @@ pattern Cons :: Int -> Partition -> Partition
+ pattern Cons x xs  <- (unconsPartition -> Just (x,xs)) where
+         Cons x (Partition xs) = Partition (x:xs)
+ 
+--- | Simulated newtype constructor 
++-- | Simulated newtype constructor
+ pattern Partition_ :: [Int] -> Partition
+ pattern Partition_ xs = Partition xs
+ 
+-pattern Head :: Int -> Partition 
++pattern Head :: Int -> Partition
+ pattern Head h <- (head . toDescList -> h)
+ 
+ pattern Tail :: Partition -> Partition
+ pattern Tail xs <- (Partition . tail . toDescList -> xs)
+ 
+-pattern Length :: Int -> Partition 
+-pattern Length n <- (partitionWidth -> n)        
+- 
++pattern Length :: Int -> Partition
++pattern Length n <- (partitionWidth -> n)
++
+ ---------------------------------------------------------------------------------
+ -- * Exponential form
+ 
+@@ -142,7 +141,7 @@ fromExponentialForm = Partition . _fromExponentialForm where
+ -- @[a1-a2,a2-a3,...,an-0]@
+ diffSequence :: Partition -> [Int]
+ diffSequence = go . toDescList where
+-  go (x:ys@(y:_)) = (x-y) : go ys 
++  go (x:ys@(y:_)) = (x-y) : go ys
+   go [x] = [x]
+   go []  = []
+ 
+@@ -155,7 +154,7 @@ toDescList :: Partition -> [Int]
+ toDescList (Partition xs) = xs
+ 
+ ---------------------------------------------------------------------------------
+--- * Dominance order 
++-- * Dominance order
+ 
+ -- | @q \`dominates\` p@ returns @True@ if @q >= p@ in the dominance order of partitions
+ -- (this is partial ordering on the set of partitions of @n@).
+@@ -163,7 +162,7 @@ toDescList (Partition xs) = xs
+ -- See <http://en.wikipedia.org/wiki/Dominance_order>
+ --
+ dominates :: Partition -> Partition -> Bool
+-dominates (Partition qs) (Partition ps) 
++dominates (Partition qs) (Partition ps)
+   = and $ zipWith (>=) (sums (qs ++ repeat 0)) (sums ps)
+   where
+     sums = scanl (+) 0
+@@ -182,7 +181,7 @@ isSubPartitionOf (Partition ps) (Partition qs) = and $ zipWith (<=) ps (qs ++ re
+ --
+ isSuperPartitionOf :: Partition -> Partition -> Bool
+ isSuperPartitionOf (Partition qs) (Partition ps) = and $ zipWith (<=) ps (qs ++ repeat 0)
+-    
++
+ --------------------------------------------------------------------------------
+ -- * The Pieri rule
+ 
+@@ -190,11 +189,11 @@ isSuperPartitionOf (Partition qs) (Partition ps) = and $ zipWith (<=) ps (qs ++
+ --
+ -- See for example <http://en.wikipedia.org/wiki/Pieri's_formula>
+ --
+-pieriRule :: Partition -> Int -> [Partition] 
++pieriRule :: Partition -> Int -> [Partition]
+ pieriRule (Partition lambda) n = map Partition (_pieriRule lambda n) where
+ 
+ -- | The dual Pieri rule computes @s[lambda]*e[n]@ as a sum of @s[mu]@-s (each with coefficient 1)
+-dualPieriRule :: Partition -> Int -> [Partition] 
++dualPieriRule :: Partition -> Int -> [Partition]
+ dualPieriRule lam n = map dualPartition $ pieriRule (dualPartition lam) n
+ 
+ --------------------------------------------------------------------------------
+diff --git a/Math/Combinat/Partitions/Multiset.hs b/Math/Combinat/Partitions/Multiset.hs
+index 74f1ef2..f257919 100644
+--- a/Math/Combinat/Partitions/Multiset.hs
++++ b/Math/Combinat/Partitions/Multiset.hs
+@@ -5,12 +5,12 @@ module Math.Combinat.Partitions.Multiset where
+ --------------------------------------------------------------------------------
+ 
+ import Data.Array.Unboxed
+-import Data.List
++import Data.List (group, sort)
+ 
+ import Math.Combinat.Partitions.Vector
+ 
+ --------------------------------------------------------------------------------
+-                              
++
+ -- | Partitions of a multiset. Internally, this uses the vector partition algorithm
+ partitionMultiset :: (Eq a, Ord a) => [a] -> [[[a]]]
+ partitionMultiset xs = parts where
+@@ -18,7 +18,7 @@ partitionMultiset xs = parts where
+   f ns = concat (zipWith replicate ns zs)
+   temp = fasc3B_algorithm_M counts
+   counts = map length ys
+-  ys = group (sort xs) 
++  ys = group (sort xs)
+   zs = map head ys
+ 
+ --------------------------------------------------------------------------------
+diff --git a/Math/Combinat/Partitions/NonCrossing.hs b/Math/Combinat/Partitions/NonCrossing.hs
+index 4d5b541..e30808a 100644
+--- a/Math/Combinat/Partitions/NonCrossing.hs
++++ b/Math/Combinat/Partitions/NonCrossing.hs
+@@ -21,7 +21,7 @@ module Math.Combinat.Partitions.NonCrossing where
+ 
+ import Control.Applicative
+ 
+-import Data.List
++import Data.List (sortBy)
+ import Data.Ord
+ 
+ import System.Random
+@@ -35,13 +35,13 @@ import Math.Combinat.Classes
+ --------------------------------------------------------------------------------
+ -- * The type of non-crossing partitions
+ 
+--- | A non-crossing partition of the set @[1..n]@ in standard form: 
++-- | A non-crossing partition of the set @[1..n]@ in standard form:
+ -- entries decreasing in each block  and blocks listed in increasing order of their first entries.
+ newtype NonCrossing = NonCrossing [[Int]] deriving (Eq,Ord,Show,Read)
+ 
+ -- | Checks whether a set partition is noncrossing.
+ --
+--- Implementation method: we convert to a Dyck path and then back again, and finally compare. 
++-- Implementation method: we convert to a Dyck path and then back again, and finally compare.
+ -- Probably not very efficient, but should be better than a naive check for crosses...)
+ --
+ _isNonCrossing :: [[Int]] -> Bool
+@@ -49,14 +49,14 @@ _isNonCrossing zzs0 = _isNonCrossingUnsafe (_standardizeNonCrossing zzs0)
+ 
+ -- | Warning: This function assumes the standard ordering!
+ _isNonCrossingUnsafe :: [[Int]] -> Bool
+-_isNonCrossingUnsafe zzs = 
++_isNonCrossingUnsafe zzs =
+   case _nonCrossingPartitionToDyckPathMaybe zzs of
+     Nothing   -> False
+     Just dyck -> case dyckPathToNonCrossingPartitionMaybe dyck of
+       Nothing                -> False
+       Just (NonCrossing yys) -> yys == zzs
+ 
+--- | Convert to standard form: entries decreasing in each block 
++-- | Convert to standard form: entries decreasing in each block
+ -- and blocks listed in increasing order of their first entries.
+ _standardizeNonCrossing :: [[Int]] -> [[Int]]
+ _standardizeNonCrossing = sortBy (comparing myhead) . map reverseSort where
+@@ -77,11 +77,11 @@ toNonCrossing xxs = case toNonCrossingMaybe xxs of
+   Nothing -> error "toNonCrossing: not a non-crossing partition"
+ 
+ toNonCrossingMaybe :: [[Int]] -> Maybe NonCrossing
+-toNonCrossingMaybe xxs0 = 
++toNonCrossingMaybe xxs0 =
+   if _isNonCrossingUnsafe xxs
+     then Just $ NonCrossing xxs
+     else Nothing
+-  where 
++  where
+     xxs = _standardizeNonCrossing xxs0
+ 
+ -- | If a set partition is actually non-crossing, then we can convert it
+@@ -106,13 +106,13 @@ instance HasNumberOfParts NonCrossing where
+ -- Fails if the input is not a Dyck path.
+ dyckPathToNonCrossingPartition :: LatticePath -> NonCrossing
+ dyckPathToNonCrossingPartition = NonCrossing . go 0 [] [] [] where
+-  go :: Int -> [Int] -> [Int] -> [[Int]] -> LatticePath -> [[Int]] 
++  go :: Int -> [Int] -> [Int] -> [[Int]] -> LatticePath -> [[Int]]
+   go !cnt stack small big path =
+     case path of
+-      (x:xs) -> case x of 
++      (x:xs) -> case x of
+         UpStep   -> let cnt' = cnt + 1 in case xs of
+           (y:ys)   -> case y of
+-            UpStep   -> go cnt' (cnt':stack) small                  big  xs  
++            UpStep   -> go cnt' (cnt':stack) small                  big  xs
+             DownStep -> go cnt' (cnt':stack) []    (reverse small : big) xs
+           []       -> error "dyckPathToNonCrossingPartition: last step is an UpStep (thus input was not a Dyck path)"
+         DownStep -> case stack of
+@@ -123,13 +123,13 @@ dyckPathToNonCrossingPartition = NonCrossing . go 0 [] [] [] where
+ -- | Safe version of 'dyckPathToNonCrossingPartition'
+ dyckPathToNonCrossingPartitionMaybe :: LatticePath -> Maybe NonCrossing
+ dyckPathToNonCrossingPartitionMaybe = fmap NonCrossing . go 0 [] [] [] where
+-  go :: Int -> [Int] -> [Int] -> [[Int]] -> LatticePath -> Maybe [[Int]] 
++  go :: Int -> [Int] -> [Int] -> [[Int]] -> LatticePath -> Maybe [[Int]]
+   go !cnt stack small big path =
+     case path of
+-      (x:xs) -> case x of 
++      (x:xs) -> case x of
+         UpStep   -> let cnt' = cnt + 1 in case xs of
+           (y:ys)   -> case y of
+-            UpStep   -> go cnt' (cnt':stack) small                  big  xs  
++            UpStep   -> go cnt' (cnt':stack) small                  big  xs
+             DownStep -> go cnt' (cnt':stack) []    (reverse small : big) xs
+           []       -> Nothing
+         DownStep -> case stack of
+@@ -153,7 +153,7 @@ _nonCrossingPartitionToDyckPathMaybe = go 0 where
+ 
+ --------------------------------------------------------------------------------
+ 
+-{- 
++{-
+ -- this should be mapped to NonCrossing [[3],[5,4,2],[7,6,1],[9,8]]
+ testpath = [u,u,u,d,u,u,d,d,d,u,u,d,d,d,u,u,d,d] where
+   u = UpStep
+@@ -178,8 +178,8 @@ nonCrossingPartitions = map dyckPathToNonCrossingPartition . dyckPaths
+ --
+ -- > sort (nonCrossingPartitionsWithKParts k n) == sort [ p | p <- nonCrossingPartitions n , numberOfParts p == k ]
+ --
+-nonCrossingPartitionsWithKParts 
+-  :: Int   -- ^ @k@ = number of parts 
++nonCrossingPartitionsWithKParts
++  :: Int   -- ^ @k@ = number of parts
+   -> Int   -- ^ @n@ = size of the set
+   -> [NonCrossing]
+ nonCrossingPartitionsWithKParts k n = map dyckPathToNonCrossingPartition $ peakingDyckPaths k n
+@@ -189,8 +189,8 @@ countNonCrossingPartitions :: Int -> Integer
+ countNonCrossingPartitions = countDyckPaths
+ 
+ -- | Non-crossing partitions with @k@ parts are counted by the Naranaya numbers
+-countNonCrossingPartitionsWithKParts 
+-  :: Int   -- ^ @k@ = number of parts 
++countNonCrossingPartitionsWithKParts
++  :: Int   -- ^ @k@ = number of parts
+   -> Int   -- ^ @n@ = size of the set
+   -> Integer
+ countNonCrossingPartitionsWithKParts = countPeakingDyckPaths
+diff --git a/Math/Combinat/Partitions/Plane.hs b/Math/Combinat/Partitions/Plane.hs
+index 0973c51..56d94d1 100644
+--- a/Math/Combinat/Partitions/Plane.hs
++++ b/Math/Combinat/Partitions/Plane.hs
+@@ -1,9 +1,9 @@
+ 
+ -- | Plane partitions. See eg. <http://en.wikipedia.org/wiki/Plane_partition>
+ --
+--- Plane partitions are encoded as lists of lists of Z heights. For example the plane 
++-- Plane partitions are encoded as lists of lists of Z heights. For example the plane
+ -- partition in the picture
+--- 
++--
+ -- <<svg/plane_partition.svg>>
+ --
+ -- is encoded as
+@@ -15,13 +15,12 @@
+ -- >           , [1]
+ -- >           , [1]
+ -- >           ]
+--- 
++--
+ {-# LANGUAGE BangPatterns #-}
+ module Math.Combinat.Partitions.Plane where
+ 
+ --------------------------------------------------------------------------------
+ 
+-import Data.List
+ import Data.Array
+ 
+ import Math.Combinat.Classes
+@@ -39,10 +38,10 @@ fromPlanePart :: PlanePart -> [[Int]]
+ fromPlanePart (PlanePart xs) = xs
+ 
+ isValidPlanePart :: [[Int]] -> Bool
+-isValidPlanePart pps = 
++isValidPlanePart pps =
+   and [ table!(i,j) >= table!(i  ,j+1) &&
+         table!(i,j) >= table!(i+1,j  )
+-      | i<-[0..y-1] , j<-[0..x-1] 
++      | i<-[0..y-1] , j<-[0..x-1]
+       ]
+   where
+     table :: Array (Int,Int) Int
+@@ -66,7 +65,7 @@ planePartShape = Tableaux.tableauShape . fromPlanePart
+ 
+ -- | The Z height of a plane partition
+ planePartZHeight :: PlanePart -> Int
+-planePartZHeight (PlanePart xs) = 
++planePartZHeight (PlanePart xs) =
+   case xs of
+     ((h:_):_) -> h
+     _         -> 0
+@@ -81,7 +80,7 @@ instance HasWeight PlanePart where
+ -- * constructing plane partitions
+ 
+ singleLayer :: Partition -> PlanePart
+-singleLayer = PlanePart . map (\k -> replicate k 1) . fromPartition 
++singleLayer = PlanePart . map (\k -> replicate k 1) . fromPartition
+ 
+ -- |  Stacks layers of partitions into a plane partition.
+ -- Throws an exception if they do not form a plane partition.
+@@ -96,12 +95,12 @@ unsafeStackLayers :: [Partition] -> PlanePart
+ unsafeStackLayers []            = PlanePart []
+ unsafeStackLayers (bottom:rest) = PlanePart $ foldl addLayer (fromPlanePart $ singleLayer bottom) rest where
+   addLayer :: [[Int]] -> Partition -> [[Int]]
+-  addLayer xxs (Partition ps) = [ zipWith (+) xs (replicate p 1 ++ repeat 0) | (xs,p) <- zip xxs (ps ++ repeat 0) ] 
++  addLayer xxs (Partition ps) = [ zipWith (+) xs (replicate p 1 ++ repeat 0) | (xs,p) <- zip xxs (ps ++ repeat 0) ]
+ 
+ -- | The \"layers\" of a plane partition (in direction @Z@). We should have
+ --
+ -- > unsafeStackLayers (planePartLayers pp) == pp
+--- 
++--
+ planePartLayers :: PlanePart -> [Partition]
+ planePartLayers pp@(PlanePart xs) = [ layer h | h<-[1..planePartZHeight pp] ] where
+   layer h = Partition $ filter (>0) $ map sum' $ (map . map) (f h) xs
+@@ -112,7 +111,7 @@ planePartLayers pp@(PlanePart xs) = [ layer h | h<-[1..planePartZHeight pp] ] wh
+ 
+ -- | Plane partitions of a given weight
+ planePartitions :: Int -> [PlanePart]
+-planePartitions d 
++planePartitions d
+   | d <  0     = []
+   | d == 0     = [PlanePart []]
+   | otherwise  = concat [ go (d-n) [p] | n<-[1..d] , p<-partitions n ]
+diff --git a/Math/Combinat/Partitions/Set.hs b/Math/Combinat/Partitions/Set.hs
+index 1f1b14f..b8843e3 100644
+--- a/Math/Combinat/Partitions/Set.hs
++++ b/Math/Combinat/Partitions/Set.hs
+@@ -2,14 +2,14 @@
+ -- | Set partitions.
+ --
+ -- See eg. <http://en.wikipedia.org/wiki/Partition_of_a_set>
+--- 
++--
+ 
+ {-# LANGUAGE BangPatterns #-}
+ module Math.Combinat.Partitions.Set where
+ 
+ --------------------------------------------------------------------------------
+ 
+-import Data.List
++import Data.List ((\\), sort, sortBy)
+ import Data.Ord
+ 
+ import System.Random
+@@ -44,7 +44,7 @@ toSetPartition zzs = if _isSetPartition zzs
+   else error "toSetPartition: not a set partition"
+ 
+ _isSetPartition :: [[Int]] -> Bool
+-_isSetPartition zzs = sort (concat zzs) == [1..n] where 
++_isSetPartition zzs = sort (concat zzs) == [1..n] where
+   n = sum' (map length zzs)
+ 
+ instance HasNumberOfParts SetPartition where
+@@ -69,8 +69,8 @@ setPartitions = setPartitionsNaive
+ -- | Synonym for 'setPartitionsWithKPartsNaive'
+ --
+ -- > sort (setPartitionsWithKParts k n) == sort [ p | p <- setPartitions n , numberOfParts p == k ]
+--- 
+-setPartitionsWithKParts   
++--
++setPartitionsWithKParts
+   :: Int    -- ^ @k@ = number of parts
+   -> Int    -- ^ @n@ = size of the set
+   -> [SetPartition]
+@@ -84,7 +84,7 @@ setPartitionsNaive n = map (SetPartition . _standardizeSetPartition) $ go [1..n]
+   go (z:zs) = [ s : rest | k <- [1..n] , s0 <- choose (k-1) zs , let s = z:s0 , rest <- go (zs \\ s) ]
+ 
+ -- | Set partitions of the set @[1..n]@ into @k@ parts
+-setPartitionsWithKPartsNaive 
++setPartitionsWithKPartsNaive
+   :: Int    -- ^ @k@ = number of parts
+   -> Int    -- ^ @n@ = size of the set
+   -> [SetPartition]
+@@ -97,10 +97,10 @@ setPartitionsWithKPartsNaive k n = map (SetPartition . _standardizeSetPartition)
+ 
+ -- | Set partitions are counted by the Bell numbers
+ countSetPartitions :: Int -> Integer
+-countSetPartitions = bellNumber 
++countSetPartitions = bellNumber
+ 
+ -- | Set partitions of size @k@ are counted by the Stirling numbers of second kind
+-countSetPartitionsWithKParts 
++countSetPartitionsWithKParts
+   :: Int    -- ^ @k@ = number of parts
+   -> Int    -- ^ @n@ = size of the set
+   -> Integer
+diff --git a/Math/Combinat/Partitions/Skew.hs b/Math/Combinat/Partitions/Skew.hs
+index c96393a..48fe726 100644
+--- a/Math/Combinat/Partitions/Skew.hs
++++ b/Math/Combinat/Partitions/Skew.hs
+@@ -17,7 +17,7 @@ module Math.Combinat.Partitions.Skew where
+ 
+ --------------------------------------------------------------------------------
+ 
+-import Data.List
++import Data.List (foldl', transpose)
+ 
+ import Math.Combinat.Classes
+ import Math.Combinat.Partitions.Integer
+@@ -32,13 +32,13 @@ newtype SkewPartition = SkewPartition [(Int,Int)] deriving (Eq,Ord,Show)
+ -- | @mkSkewPartition (lambda,mu)@ creates the skew partition @lambda/mu@.
+ -- Throws an error if @mu@ is not a sub-partition of @lambda@.
+ mkSkewPartition :: (Partition,Partition) -> SkewPartition
+-mkSkewPartition ( lam@(Partition bs) , mu@(Partition as)) = if mu `isSubPartitionOf` lam 
++mkSkewPartition ( lam@(Partition bs) , mu@(Partition as)) = if mu `isSubPartitionOf` lam
+   then SkewPartition $ zipWith (\b a -> (a,b-a)) bs (as ++ repeat 0)
+-  else error "mkSkewPartition: mu should be a subpartition of lambda!" 
++  else error "mkSkewPartition: mu should be a subpartition of lambda!"
+ 
+ -- | Returns 'Nothing' if @mu@ is not a sub-partition of @lambda@.
+ safeSkewPartition :: (Partition,Partition) -> Maybe SkewPartition
+-safeSkewPartition ( lam@(Partition bs) , mu@(Partition as)) = if mu `isSubPartitionOf` lam 
++safeSkewPartition ( lam@(Partition bs) , mu@(Partition as)) = if mu `isSubPartitionOf` lam
+   then Just $ SkewPartition $ zipWith (\b a -> (a,b-a)) bs (as ++ repeat 0)
+   else Nothing
+ 
+@@ -57,7 +57,7 @@ normalizeSkewPartition (SkewPartition abs) = SkewPartition abs' where
+   a0 = minimum as
+   k  = length (takeWhile (==0) bs)
+   abs' = zip [ a-a0 | a <- drop k as ] (drop k bs)
+-   
++
+ -- | Returns the outer and inner partition of a skew partition, respectively:
+ --
+ -- > mkSkewPartition . fromSkewPartition == id
+@@ -67,12 +67,12 @@ fromSkewPartition (SkewPartition list) = (toPartition (zipWith (+) as bs) , toPa
+   (as,bs) = unzip list
+ 
+ -- | The @lambda@ part of @lambda/mu@
+-outerPartition :: SkewPartition -> Partition  
+-outerPartition = fst . fromSkewPartition 
++outerPartition :: SkewPartition -> Partition
++outerPartition = fst . fromSkewPartition
+ 
+ -- | The @mu@ part of @lambda/mu@
+-innerPartition :: SkewPartition -> Partition  
+-innerPartition = snd . fromSkewPartition 
++innerPartition :: SkewPartition -> Partition
++innerPartition = snd . fromSkewPartition
+ 
+ -- | The dual skew partition (that is, the mirror image to the main diagonal)
+ dualSkewPartition :: SkewPartition -> SkewPartition
+@@ -94,28 +94,28 @@ skewPartitionElements (SkewPartition abs) = concat
+ 
+ -- | Lists all skew partitions with the given outer shape and given (skew) weight
+ skewPartitionsWithOuterShape :: Partition -> Int -> [SkewPartition]
+-skewPartitionsWithOuterShape outer skewWeight 
++skewPartitionsWithOuterShape outer skewWeight
+   | innerWeight < 0 || innerWeight > outerWeight = []
+   | otherwise = [ mkSkewPartition (outer,inner) | inner <- subPartitions innerWeight outer ]
+   where
+     outerWeight = weight outer
+-    innerWeight = outerWeight - skewWeight 
++    innerWeight = outerWeight - skewWeight
+ 
+ -- | Lists all skew partitions with the given outer shape and any (skew) weight
+ allSkewPartitionsWithOuterShape :: Partition -> [SkewPartition]
+-allSkewPartitionsWithOuterShape outer 
++allSkewPartitionsWithOuterShape outer
+   = concat [ skewPartitionsWithOuterShape outer w | w<-[0..outerWeight] ]
+   where
+     outerWeight = weight outer
+ 
+ -- | Lists all skew partitions with the given inner shape and given (skew) weight
+ skewPartitionsWithInnerShape :: Partition -> Int -> [SkewPartition]
+-skewPartitionsWithInnerShape inner skewWeight 
++skewPartitionsWithInnerShape inner skewWeight
+   | innerWeight > outerWeight = []
+   | otherwise = [ mkSkewPartition (outer,inner) | outer <- superPartitions outerWeight inner ]
+   where
+-    outerWeight = innerWeight + skewWeight 
+-    innerWeight = weight inner 
++    outerWeight = innerWeight + skewWeight
++    innerWeight = weight inner
+ 
+ --------------------------------------------------------------------------------
+ -- connected components
+@@ -134,10 +134,10 @@ isConnectedSkewPartition skewp = length (connectedComponents skewp) == 1
+ asciiSkewFerrersDiagram :: SkewPartition -> ASCII
+ asciiSkewFerrersDiagram = asciiSkewFerrersDiagram' ('@','.') EnglishNotation
+ 
+-asciiSkewFerrersDiagram' 
+-  :: (Char,Char)       
++asciiSkewFerrersDiagram'
++  :: (Char,Char)
+   -> PartitionConvention -- Orientation
+-  -> SkewPartition 
++  -> SkewPartition
+   -> ASCII
+ asciiSkewFerrersDiagram' (outer,inner) orient (SkewPartition abs) = asciiFromLines stuff where
+   stuff = case orient of
+@@ -147,7 +147,7 @@ asciiSkewFerrersDiagram' (outer,inner) orient (SkewPartition abs) = asciiFromLin
+   ls = [ replicate a inner ++ replicate b outer | (a,b) <- abs ]
+ 
+ instance DrawASCII SkewPartition where
+-  ascii = asciiSkewFerrersDiagram     
++  ascii = asciiSkewFerrersDiagram
+ 
+ --------------------------------------------------------------------------------
+ 
+diff --git a/Math/Combinat/Partitions/Skew/Ribbon.hs b/Math/Combinat/Partitions/Skew/Ribbon.hs
+index 6ca2295..3aaaf5f 100644
+--- a/Math/Combinat/Partitions/Skew/Ribbon.hs
++++ b/Math/Combinat/Partitions/Skew/Ribbon.hs
+@@ -14,7 +14,7 @@ module Math.Combinat.Partitions.Skew.Ribbon where
+ --------------------------------------------------------------------------------
+ 
+ import Data.Array
+-import Data.List
++import Data.List (group, sort)
+ import Data.Maybe
+ 
+ import qualified Data.Map as Map
+@@ -31,7 +31,7 @@ import Math.Combinat.Helper
+ --------------------------------------------------------------------------------
+ -- * Corners (TODO: move to Partitions - but we also want to refactor that)
+ 
+--- | The coordinates of the outer corners 
++-- | The coordinates of the outer corners
+ outerCorners :: Partition -> [(Int,Int)]
+ outerCorners = outerCornerBoxes
+ 
+@@ -40,7 +40,7 @@ outerCorners = outerCornerBoxes
+ extendedInnerCorners:: Partition -> [(Int,Int)]
+ extendedInnerCorners (Partition_ ps) = (0, head ps') : catMaybes mbCorners where
+   ps' = ps ++ [0]
+-  mbCorners = zipWith3 f [1..] (tail ps') (_diffSequence ps') 
++  mbCorners = zipWith3 f [1..] (tail ps') (_diffSequence ps')
+   f !y !x !k = if k > 0 then Just (y,x) else Nothing
+ 
+ -- | Sequence of all the (extended) corners
+@@ -60,12 +60,12 @@ extendedCornerSequence (Partition_ ps) = {- if null ps then [(0,0)] else -} inte
+ -- > innerCornerBoxes lambda == (tail $ init $ extendedInnerCorners lambda)
+ --
+ innerCornerBoxes :: Partition -> [(Int,Int)]
+-innerCornerBoxes (Partition_ ps) = 
++innerCornerBoxes (Partition_ ps) =
+   case ps of
+     []  -> []
+-    _   -> catMaybes mbCorners 
++    _   -> catMaybes mbCorners
+   where
+-    mbCorners = zipWith3 f [1..] (tail ps) (_diffSequence ps) 
++    mbCorners = zipWith3 f [1..] (tail ps) (_diffSequence ps)
+     f !y !x !k = if k > 0 then Just (y,x) else Nothing
+ 
+ -- | The outer corner /boxes/ of the partition. Coordinates are counted from 1
+@@ -75,10 +75,10 @@ innerCornerBoxes (Partition_ ps) =
+ -- For the partition @[5,4,1]@ the result should be @[(1,5),(2,4),(3,1)]@
+ outerCornerBoxes :: Partition -> [(Int,Int)]
+ outerCornerBoxes (Partition_ ps) = catMaybes mbCorners where
+-  mbCorners = zipWith3 f [1..] ps (_diffSequence ps) 
++  mbCorners = zipWith3 f [1..] ps (_diffSequence ps)
+   f !y !x !k = if k > 0 then Just (y,x) else Nothing
+ 
+--- | The outer and inner corner boxes interleaved, so together they form 
++-- | The outer and inner corner boxes interleaved, so together they form
+ -- the turning points of the full border strip
+ cornerBoxSequence :: Partition -> [(Int,Int)]
+ cornerBoxSequence (Partition_ ps) = if null ps then [] else interleave outer inner where
+@@ -112,11 +112,11 @@ outerCornerBoxesNaive part = filter f boxes where
+ -- to the diagonals the result is an interval.
+ isRibbon :: SkewPartition -> Bool
+ isRibbon skewp = go Nothing proj where
+-  proj = Map.toList 
++  proj = Map.toList
+        $ Map.fromListWith (+) [ (x-y , 1) | (y,x) <- skewPartitionElements skewp ]
+   go Nothing   []            = False
+   go (Just _)  []            = True
+-  go Nothing   ((a,h):rest)  = (h == 1) &&               go (Just a) rest  
++  go Nothing   ((a,h):rest)  = (h == 1) &&               go (Just a) rest
+   go (Just b)  ((a,h):rest)  = (h == 1) && (a == b+1) && go (Just a) rest
+ 
+ {-
+@@ -124,19 +124,19 @@ isRibbon skewp = go Nothing proj where
+ isRibbonNaive :: SkewPartition -> Bool
+ isRibbonNaive skewp = isConnectedSkewPartition skewp && no2x2 where
+   boxes = skewPartitionElements skewp
+-  no2x2 = and 
+-    [ not ( elem (y+1,x  ) boxes &&             
+-            elem (y  ,x+1) boxes &&  
+-            elem (y+1,x+1) boxes )        -- no 2x2 blocks 
+-    | (y,x) <- boxes 
++  no2x2 = and
++    [ not ( elem (y+1,x  ) boxes &&
++            elem (y  ,x+1) boxes &&
++            elem (y+1,x+1) boxes )        -- no 2x2 blocks
++    | (y,x) <- boxes
+     ]
+ -}
+ 
+ toRibbon :: SkewPartition -> Maybe Ribbon
+-toRibbon skew = 
++toRibbon skew =
+   if not (isRibbon skew)
+     then Nothing
+-    else Just ribbon 
++    else Just ribbon
+   where
+     ribbon =  Ribbon
+       { rbShape  = skew
+@@ -148,12 +148,12 @@ toRibbon skew =
+     height = (length $ group $ sort $ map fst elems) - 1    -- TODO: optimize these
+     width  = (length $ group $ sort $ map snd elems) - 1
+ 
+--- | Border strips (or ribbons) are defined to be skew partitions which are 
++-- | Border strips (or ribbons) are defined to be skew partitions which are
+ -- connected and do not contain 2x2 blocks.
+--- 
++--
+ -- The /length/ of a border strip is the number of boxes it contains,
+ -- and its /height/ is defined to be one less than the number of rows
+--- (in English notation) it occupies. The /width/ is defined symmetrically to 
++-- (in English notation) it occupies. The /width/ is defined symmetrically to
+ -- be one less than the number of columns it occupies.
+ --
+ data Ribbon = Ribbon
+@@ -167,13 +167,13 @@ data Ribbon = Ribbon
+ --------------------------------------------------------------------------------
+ -- * Inner border strips
+ 
+--- | Ribbons (or border strips) are defined to be skew partitions which are 
++-- | Ribbons (or border strips) are defined to be skew partitions which are
+ -- connected and do not contain 2x2 blocks. This function returns the
+ -- border strips whose outer partition is the given one.
+ innerRibbons :: Partition -> [Ribbon]
+ innerRibbons part@(Partition ps) = if null ps then [] else strips where
+ 
+-  strips  = [ mkStrip i j 
++  strips  = [ mkStrip i j
+             | i<-[1..n] , _canStartStrip (annArr!i)
+             , j<-[i..n] , _canEndStrip   (annArr!j)
+             ]
+@@ -184,8 +184,8 @@ innerRibbons part@(Partition ps) = if null ps then [] else strips where
+ 
+   mkStrip !i1 !i2 = Ribbon shape len height width where
+     ps'   = ps ++ [0]
+-    shape = SkewPartition [ (p-k,k) | (i,p,q) <- zip3 [1..] ps (tail ps') , let k = indent i p q ] 
+-    indent !i !p !q 
++    shape = SkewPartition [ (p-k,k) | (i,p,q) <- zip3 [1..] ps (tail ps') , let k = indent i p q ]
++    indent !i !p !q
+       | i <  y1    = 0
+       | i >  y2    = 0
+       | i == y2    = p - x2 + 1     -- the order is important here !!!
+@@ -201,7 +201,7 @@ innerRibbons part@(Partition ps) = if null ps then [] else strips where
+ innerRibbonsOfLength :: Partition -> Int -> [Ribbon]
+ innerRibbonsOfLength part@(Partition ps) givenLength = if null ps then [] else strips where
+ 
+-  strips  = [ mkStrip i j 
++  strips  = [ mkStrip i j
+             | i<-[1..n] , _canStartStrip (annArr!i)
+             , j<-[i..n] , _canEndStrip   (annArr!j)
+             , j-i+1 == givenLength
+@@ -213,8 +213,8 @@ innerRibbonsOfLength part@(Partition ps) givenLength = if null ps then [] else s
+ 
+   mkStrip !i1 !i2 = Ribbon shape givenLength height width where
+     ps'   = ps ++ [0]
+-    shape = SkewPartition [ (p-k,k) | (i,p,q) <- zip3 [1..] ps (tail ps') , let k = indent i p q ] 
+-    indent !i !p !q 
++    shape = SkewPartition [ (p-k,k) | (i,p,q) <- zip3 [1..] ps (tail ps') , let k = indent i p q ]
++    indent !i !p !q
+       | i <  y1    = 0
+       | i >  y2    = 0
+       | i == y2    = p - x2 + 1     -- the order is important here !!!
+@@ -239,41 +239,41 @@ listHooks n = [ Partition (k : replicate (n-k) 1) | k<-[1..n] ]
+ outerRibbonsOfLength :: Partition -> Int -> [Ribbon]
+ outerRibbonsOfLength part@(Partition ps) givenLength = result where
+ 
+-  result = if null ps 
++  result = if null ps
+     then [ Ribbon shape givenLength ht wd
+          | p <- listHooks givenLength
+          , let shape = mkSkewPartition (p,part)
+          , let ht = partitionWidth  p - 1        -- pretty inconsistent names here :(((
+          , let wd = partitionHeight p - 1
+          ]
+-    else strips 
++    else strips
+ 
+-  strips  = [ mkStrip i j 
++  strips  = [ mkStrip i j
+             | i<-[1..n] , _canStartStrip (annArr!i)
+             , j<-[i..n] , _canEndStrip   (annArr!j)
+             , j-i+1 == givenLength
+             ]
+- 
++
+   ysize = partitionWidth  part
+   xsize = partitionHeight part
+- 
++
+   annList  =  [ BorderBox True False 1 x | x <- reverse [xsize+2 .. xsize+givenLength ] ]
+-           ++ annList0 
++           ++ annList0
+            ++ [ BorderBox False True y 1 | y <-         [ysize+2 .. ysize+givenLength ] ]
+- 
++
+   n        = length annList
+   annList0 = annotatedOuterBorderStrip part
+   annArr   = listArray (1,n) annList
+ 
+   mkStrip !i1 !i2 = Ribbon shape len height width where
+     ps'   = (-666) : ps ++ replicate (givenLength) 0
+-    shape = SkewPartition [ (p,k) | (i,p,q) <- zip3 [1..max ysize y2] (tail ps') ps' , let k = indent i p q ] 
+-    indent !i !p !q 
++    shape = SkewPartition [ (p,k) | (i,p,q) <- zip3 [1..max ysize y2] (tail ps') ps' , let k = indent i p q ]
++    indent !i !p !q
+       | i <  y1    = 0
+       | i >  y2    = 0
+       | i == y1    = x1 - p    -- the order is important here !!!
+---      | i == y2    = x2 - p     
+-      | otherwise  = q - p  + 1   
++--      | i == y2    = x2 - p
++      | otherwise  = q - p  + 1
+ 
+     len    = i2 - i1 + 1
+     height = y2 - y1
+@@ -331,30 +331,30 @@ data BorderBox = BorderBox
+   , _xCoord :: !Int
+   }
+   deriving Show
+- 
+--- | The boxes of the full inner border strip, annotated with whether a border strip 
++
++-- | The boxes of the full inner border strip, annotated with whether a border strip
+ -- can start or end there.
+ annotatedInnerBorderStrip :: Partition -> [BorderBox]
+ annotatedInnerBorderStrip partition = if isEmptyPartition partition then [] else list where
+-  list    = goVert (head corners) (tail corners) 
+-  corners = extendedCornerSequence partition  
++  list    = goVert (head corners) (tail corners)
++  corners = extendedCornerSequence partition
+ 
+   goVert  (y1,x ) ((y2,_ ):rest) = [ BorderBox True (y==y2) y x | y<-[y1+1..y2] ] ++ goHoriz (y2,x) rest
+-  goVert  _       []             = [] 
++  goVert  _       []             = []
+ 
+   goHoriz (y ,x1) ((_, x2):rest) = case rest of
+     [] -> [ BorderBox False True    y x | x<-[x1-1,x1-2..x2+1] ]
+     _  -> [ BorderBox False (x/=x2) y x | x<-[x1-1,x1-2..x2  ] ] ++ goVert (y,x2) rest
+ 
+--- | The boxes of the full outer border strip, annotated with whether a border strip 
++-- | The boxes of the full outer border strip, annotated with whether a border strip
+ -- can start or end there.
+ annotatedOuterBorderStrip :: Partition -> [BorderBox]
+ annotatedOuterBorderStrip partition = if isEmptyPartition partition then [] else list where
+-  list    = goVert (head corners) (tail corners) 
+-  corners = extendedCornerSequence partition  
++  list    = goVert (head corners) (tail corners)
++  corners = extendedCornerSequence partition
+ 
+   goVert  (y1,x ) ((y2,_ ):rest) = [ BorderBox (y==y1) (y/=y2) (y+1) (x+1) | y<-[y1..y2] ] ++ goHoriz (y2,x) rest
+-  goVert  _       []             = [] 
++  goVert  _       []             = []
+ 
+   goHoriz (y ,x1) ((_, x2):rest) = case rest of
+     [] -> [ BorderBox True (x==0) (y+1) (x+1) | x<-[x1-1,x1-2..x2  ] ]
+diff --git a/Math/Combinat/Partitions/Vector.hs b/Math/Combinat/Partitions/Vector.hs
+index 2715f31..60081c4 100644
+--- a/Math/Combinat/Partitions/Vector.hs
++++ b/Math/Combinat/Partitions/Vector.hs
+@@ -10,7 +10,6 @@ module Math.Combinat.Partitions.Vector where
+ --------------------------------------------------------------------------------
+ 
+ import Data.Array.Unboxed
+-import Data.List
+ 
+ --------------------------------------------------------------------------------
+ 
+@@ -24,57 +23,57 @@ vectorPartitions = fasc3B_algorithm_M . elems
+ _vectorPartitions :: [Int] -> [[[Int]]]
+ _vectorPartitions = map (map elems) . fasc3B_algorithm_M
+ 
+--- | Generates all vector partitions 
+---   (\"algorithm M\" in Knuth). 
+---   The order is decreasing lexicographic.  
+-fasc3B_algorithm_M :: [Int] -> [[IntVector]] 
++-- | Generates all vector partitions
++--   (\"algorithm M\" in Knuth).
++--   The order is decreasing lexicographic.
++fasc3B_algorithm_M :: [Int] -> [[IntVector]]
+ {- note to self: Knuth's descriptions of algorithms are still totally unreadable -}
+ fasc3B_algorithm_M xs = worker [start] where
+ 
+   -- n = sum xs
+   m = length xs
+ 
+-  start = [ (j,x,x) | (j,x) <- zip [1..] xs ]  
+-  
+-  worker stack@(last:_) = 
++  start = [ (j,x,x) | (j,x) <- zip [1..] xs ]
++
++  worker stack@(last:_) =
+     case decrease stack' of
+       Nothing -> [visited]
+       Just stack'' -> visited : worker stack''
+     where
+       stack'  = subtract_rec stack
+       visited = map to_vector stack'
+-      
+-  decrease (last:rest) = 
++
++  decrease (last:rest) =
+     case span (\(_,_,v) -> v==0) (reverse last) of
+       ( _ , [(_,_,1)] ) -> case rest of
+         [] -> Nothing
+         _  -> decrease rest
+-      ( second , (c,u,v):first ) -> Just (modified:rest) where 
+-        modified =   
+-          reverse first ++ 
+-          (c,u,v-1) :  
+-          [ (c,u,u) | (c,u,_) <- reverse second ] 
++      ( second , (c,u,v):first ) -> Just (modified:rest) where
++        modified =
++          reverse first ++
++          (c,u,v-1) :
++          [ (c,u,u) | (c,u,_) <- reverse second ]
+       _ -> error "fasc3B_algorithm_M: should not happen"
+-        
+-  to_vector cuvs = 
++
++  to_vector cuvs =
+     accumArray (flip const) 0 (1,m)
+-      [ (c,v) | (c,_,v) <- cuvs ] 
++      [ (c,v) | (c,_,v) <- cuvs ]
+ 
+-  subtract_rec all@(last:_) = 
+-    case subtract last of 
++  subtract_rec all@(last:_) =
++    case subtract last of
+       []  -> all
+-      new -> subtract_rec (new:all) 
++      new -> subtract_rec (new:all)
+ 
+   subtract [] = []
+-  subtract full@((c,u,v):rest) = 
+-    if w >= v 
++  subtract full@((c,u,v):rest) =
++    if w >= v
+       then (c,w,v) : subtract   rest
+       else           subtract_b full
+     where w = u - v
+-    
++
+   subtract_b [] = []
+-  subtract_b ((c,u,v):rest) = 
+-    if w /= 0 
++  subtract_b ((c,u,v):rest) =
++    if w /= 0
+       then (c,w,w) : subtract_b rest
+       else           subtract_b rest
+     where w = u - v
+diff --git a/Math/Combinat/Permutations.hs b/Math/Combinat/Permutations.hs
+index 0d615b8..2f37437 100644
+--- a/Math/Combinat/Permutations.hs
++++ b/Math/Combinat/Permutations.hs
+@@ -1,5 +1,5 @@
+ 
+--- | Permutations. 
++-- | Permutations.
+ --
+ -- See eg.:
+ -- Donald E. Knuth: The Art of Computer Programming, vol 4, pre-fascicle 2B.
+@@ -9,7 +9,7 @@
+ --
+ 
+ {-# LANGUAGE CPP, BangPatterns, ScopedTypeVariables, GeneralizedNewtypeDeriving, FlexibleContexts #-}
+-module Math.Combinat.Permutations 
++module Math.Combinat.Permutations
+   ( -- * The Permutation type
+     Permutation (..)
+   , fromPermutation
+@@ -34,8 +34,8 @@ module Math.Combinat.Permutations
+   , isReversePermutation
+   , isEvenPermutation
+   , isOddPermutation
+-  , signOfPermutation  
+-  , signValueOfPermutation  
++  , signOfPermutation
++  , signValueOfPermutation
+   , module Math.Combinat.Sign   --  , Sign(..)
+   , isCyclicPermutation
+     -- * Some concrete permutations
+@@ -57,20 +57,20 @@ module Math.Combinat.Permutations
+   , identity
+   , inverse
+   , multiply
+-  , multiplyMany 
++  , multiplyMany
+   , multiplyMany'
+     -- * Action of the permutation group
+-  , permute 
++  , permute
+   , permuteList
+   , permuteLeft , permuteRight
+   , permuteLeftList , permuteRightList
+     -- * Sorting
+-  , sortingPermutationAsc 
++  , sortingPermutationAsc
+   , sortingPermutationDesc
+     -- * ASCII drawing
+   , asciiPermutation
+   , asciiDisjointCycles
+-  , twoLineNotation 
++  , twoLineNotation
+   , inverseTwoLineNotation
+   , genericTwoLineNotation
+     -- * List of permutations
+@@ -90,7 +90,7 @@ module Math.Combinat.Permutations
+   , permuteMultiset
+   , countPermuteMultiset
+   , fasc2B_algorithm_L
+-  ) 
++  )
+   where
+ 
+ --------------------------------------------------------------------------------
+@@ -98,7 +98,7 @@ module Math.Combinat.Permutations
+ import Control.Monad
+ import Control.Monad.ST
+ 
+-import Data.List hiding ( permutations )
++import Data.List (foldl1', group, intercalate, sort, sortBy)
+ import Data.Ord ( comparing )
+ 
+ import Data.Array (Array)
+@@ -119,10 +119,10 @@ import System.Random
+ --------------------------------------------------------------------------------
+ -- * Types
+ 
+--- | A permutation. Internally it is an (unboxed) array of the integers @[1..n]@, with 
+--- indexing range also being @(1,n)@. 
++-- | A permutation. Internally it is an (unboxed) array of the integers @[1..n]@, with
++-- indexing range also being @(1,n)@.
+ --
+--- If this array of integers is @[p1,p2,...,pn]@, then in two-line 
++-- If this array of integers is @[p1,p2,...,pn]@, then in two-line
+ -- notations, that represents the permutation
+ --
+ -- > ( 1  2  3  ... n  )
+@@ -131,7 +131,7 @@ import System.Random
+ -- That is, it is the permutation @sigma@ whose (right) action on the set @[1..n]@ is
+ --
+ -- > sigma(1) = p1
+--- > sigma(2) = p2 
++-- > sigma(2) = p2
+ -- > ...
+ --
+ -- (NOTE: this changed at version 0.2.8.0!)
+@@ -139,16 +139,16 @@ import System.Random
+ newtype Permutation = Permutation (UArray Int Int) deriving (Eq,Ord) -- ,Show,Read)
+ 
+ instance Show Permutation where
+-  showsPrec d (Permutation arr) 
+-    = showParen (d > 10)  
++  showsPrec d (Permutation arr)
++    = showParen (d > 10)
+     $ showString "toPermutation " . showsPrec 11 (elems arr)       -- app_prec = 10
+ 
+ instance Read Permutation where
+   readsPrec d r = readParen (d > 10) fun r where
+-    fun r = [ (toPermutation p,t) 
++    fun r = [ (toPermutation p,t)
+             | ("toPermutation",s) <- lex r
+             , (p,t) <- readsPrec 11 s                              -- app_prec = 10
+-            ] 
++            ]
+ 
+ instance DrawASCII Permutation where
+   ascii = asciiPermutation
+@@ -201,15 +201,15 @@ maybePermutation input = runST action where
+   action = do
+     ar <- newArray (1,n) 0 :: ST s (STUArray s Int Int)
+     let go []     = return $ Just (Permutation $ listArray (1,n) input)
+-        go (j:js) = if j<1 || j>n 
++        go (j:js) = if j<1 || j>n
+           then return Nothing
+           else do
+             z <- readArray ar j
+             writeArray ar j (z+1)
+             if z==0 then go js
+-                    else return Nothing               
++                    else return Nothing
+     go input
+-    
++
+ -- | Checks the input.
+ toPermutation :: [Int] -> Permutation
+ toPermutation xs = case maybePermutation xs of
+@@ -234,7 +234,7 @@ isIdentityPermutation (Permutation ar) = (elems ar == [1..n]) where
+ --
+ -- > permuteList p1 xs ++ permuteList p2 ys == permuteList (concatPermutations p1 p2) (xs++ys)
+ --
+-concatPermutations :: Permutation -> Permutation -> Permutation 
++concatPermutations :: Permutation -> Permutation -> Permutation
+ concatPermutations perm1 perm2 = toPermutationUnsafe list where
+   n    = permutationSize perm1
+   list = fromPermutation perm1 ++ map (+n) (fromPermutation perm2)
+@@ -244,11 +244,11 @@ concatPermutations perm1 perm2 = toPermutationUnsafe list where
+ 
+ -- | Synonym for 'twoLineNotation'
+ asciiPermutation :: Permutation -> ASCII
+-asciiPermutation = twoLineNotation 
++asciiPermutation = twoLineNotation
+ 
+ asciiDisjointCycles :: DisjointCycles -> ASCII
+ asciiDisjointCycles (DisjointCycles cycles) = final where
+-  final = hCatWith VTop (HSepSpaces 1) boxes 
++  final = hCatWith VTop (HSepSpaces 1) boxes
+   boxes = [ genericTwoLineNotation (f cyc) | cyc <- cycles ]
+   f cyc = pairs (cyc ++ [head cyc])
+ 
+@@ -257,16 +257,16 @@ asciiDisjointCycles (DisjointCycles cycles) = final where
+ twoLineNotation :: Permutation -> ASCII
+ twoLineNotation (Permutation arr) = genericTwoLineNotation $ zip [1..] (elems arr)
+ 
+--- | The inverse two-line notation, where the it\'s the bottom line 
++-- | The inverse two-line notation, where the it\'s the bottom line
+ -- which is in standard order. The columns of this are a permutation
+ -- of the columns 'twoLineNotation'.
+ --
+--- Remark: the top row of @inverseTwoLineNotation perm@ is the same 
++-- Remark: the top row of @inverseTwoLineNotation perm@ is the same
+ -- as the bottom row of @twoLineNotation (inverse perm)@.
+ --
+ inverseTwoLineNotation :: Permutation -> ASCII
+ inverseTwoLineNotation (Permutation arr) =
+-  genericTwoLineNotation $ sortBy (comparing snd) $ zip [1..] (elems arr) 
++  genericTwoLineNotation $ sortBy (comparing snd) $ zip [1..] (elems arr)
+ 
+ -- | Two-line notation for any set of numbers
+ genericTwoLineNotation :: [(Int,Int)] -> ASCII
+@@ -274,9 +274,9 @@ genericTwoLineNotation xys = asciiFromLines [ topLine, botLine ] where
+   topLine = "( " ++ intercalate " " us ++ " )"
+   botLine = "( " ++ intercalate " " vs ++ " )"
+   pairs   = [ (show x, show y) | (x,y) <- xys ]
+-  (us,vs) = unzip (map f pairs) 
++  (us,vs) = unzip (map f pairs)
+   f (s,t) = (s',t') where
+-    a = length s 
++    a = length s
+     b = length t
+     c = max a b
+     s' = replicate (c-a) ' ' ++ s
+@@ -288,7 +288,7 @@ genericTwoLineNotation xys = asciiFromLines [ topLine, botLine ] where
+ fromDisjointCycles :: DisjointCycles -> [[Int]]
+ fromDisjointCycles (DisjointCycles cycles) = cycles
+ 
+-disjointCyclesUnsafe :: [[Int]] -> DisjointCycles 
++disjointCyclesUnsafe :: [[Int]] -> DisjointCycles
+ disjointCyclesUnsafe = DisjointCycles
+ 
+ instance DrawASCII DisjointCycles where
+@@ -299,33 +299,33 @@ instance HasNumberOfCycles DisjointCycles where
+ 
+ instance HasNumberOfCycles Permutation where
+   numberOfCycles = numberOfCycles . permutationToDisjointCycles
+-  
++
+ disjointCyclesToPermutation :: Int -> DisjointCycles -> Permutation
+ disjointCyclesToPermutation n (DisjointCycles cycles) = Permutation perm where
+ 
+   pairs :: [Int] -> [(Int,Int)]
+   pairs xs@(x:_) = worker (xs++[x]) where
+     worker (x:xs@(y:_)) = (x,y):worker xs
+-    worker _ = [] 
++    worker _ = []
+   pairs [] = error "disjointCyclesToPermutation: empty cycle"
+ 
+   perm = runSTUArray $ do
+     ar <- newArray_ (1,n) :: ST s (STUArray s Int Int)
+-    forM_ [1..n] $ \i -> writeArray ar i i 
++    forM_ [1..n] $ \i -> writeArray ar i i
+     forM_ cycles $ \cyc -> forM_ (pairs cyc) $ \(i,j) -> writeArray ar i j
+     return ar -- freeze ar
+-  
++
+ -- | Convert to disjoint cycle notation.
+ --
+--- This is compatible with Maple's @convert(perm,\'disjcyc\')@ 
++-- This is compatible with Maple's @convert(perm,\'disjcyc\')@
+ -- and also with Mathematica's @PermutationCycles[perm]@
+ --
+--- Note however, that for example Mathematica uses the 
++-- Note however, that for example Mathematica uses the
+ -- /top row/ to represent a permutation, while we use the
+ -- /bottom row/ - thus even though this function looks
+ -- identical, the /meaning/ of both the input and output
+ -- is different!
+--- 
++--
+ permutationToDisjointCycles :: Permutation -> DisjointCycles
+ permutationToDisjointCycles (Permutation perm) = res where
+ 
+@@ -335,62 +335,62 @@ permutationToDisjointCycles (Permutation perm) = res where
+   f :: [Int] -> Bool
+   f [_] = False
+   f _ = True
+-  
++
+   res = runST $ do
+-    tag <- newArray (1,n) False 
+-    cycles <- unfoldM (step tag) 1 
++    tag <- newArray (1,n) False
++    cycles <- unfoldM (step tag) 1
+     return (DisjointCycles $ filter f cycles)
+-    
++
+   step :: STUArray s Int Bool -> Int -> ST s ([Int],Maybe Int)
+   step tag k = do
+-    cyc <- worker tag k k [k] 
++    cyc <- worker tag k k [k]
+     m <- next tag (k+1)
+-    return (reverse cyc, m) 
+-    
++    return (reverse cyc, m)
++
+   next :: STUArray s Int Bool -> Int -> ST s (Maybe Int)
+   next tag k = if k > n
+     then return Nothing
+-    else readArray tag k >>= \b -> if b 
+-      then next tag (k+1)  
++    else readArray tag k >>= \b -> if b
++      then next tag (k+1)
+       else return (Just k)
+-       
++
+   worker :: STUArray s Int Bool -> Int -> Int -> [Int] -> ST s [Int]
+   worker tag k l cyc = do
+     writeArray tag l True
+     let m = perm ! l
+-    if m == k 
++    if m == k
+       then return cyc
+-      else worker tag k m (m:cyc)      
++      else worker tag k m (m:cyc)
+ 
+ isEvenPermutation :: Permutation -> Bool
+ isEvenPermutation (Permutation perm) = res where
+ 
+   (1,n) = bounds perm
+   res = runST $ do
+-    tag <- newArray (1,n) False 
+-    cycles <- unfoldM (step tag) 1 
++    tag <- newArray (1,n) False
++    cycles <- unfoldM (step tag) 1
+     return $ even (sum cycles)
+-    
++
+   step :: STUArray s Int Bool -> Int -> ST s (Int,Maybe Int)
+   step tag k = do
+     cyclen <- worker tag k k 0
+     m <- next tag (k+1)
+     return (cyclen,m)
+-    
++
+   next :: STUArray s Int Bool -> Int -> ST s (Maybe Int)
+   next tag k = if k > n
+     then return Nothing
+-    else readArray tag k >>= \b -> if b 
+-      then next tag (k+1)  
++    else readArray tag k >>= \b -> if b
++      then next tag (k+1)
+       else return (Just k)
+-      
++
+   worker :: STUArray s Int Bool -> Int -> Int -> Int -> ST s Int
+   worker tag k l cyclen = do
+     writeArray tag l True
+     let m = perm ! l
+-    if m == k 
++    if m == k
+       then return cyclen
+-      else worker tag k m (1+cyclen)      
++      else worker tag k m (1+cyclen)
+ 
+ isOddPermutation :: Permutation -> Bool
+ isOddPermutation = not . isEvenPermutation
+@@ -405,14 +405,14 @@ signOfPermutation perm = case isEvenPermutation perm of
+ {-# SPECIALIZE signValueOfPermutation :: Permutation -> Integer #-}
+ signValueOfPermutation :: Num a => Permutation -> a
+ signValueOfPermutation = signValue . signOfPermutation
+-  
++
+ isCyclicPermutation :: Permutation -> Bool
+-isCyclicPermutation perm = 
++isCyclicPermutation perm =
+   case cycles of
+     []    -> True
+     [cyc] -> (length cyc == n)
+     _     -> False
+-  where 
++  where
+     n = permutationSize perm
+     DisjointCycles cycles = permutationToDisjointCycles perm
+ 
+@@ -444,7 +444,7 @@ numberOfInversions = numberOfInversionsMerge
+ numberOfInversionsMerge :: Permutation -> Int
+ numberOfInversionsMerge (Permutation arr) = fst (sortCnt n $ elems arr) where
+   (_,n) = bounds arr
+-                                        
++
+   -- | First argument is length of the list.
+   -- Returns also the inversion count.
+   sortCnt :: Int -> [Int] -> (Int,[Int])
+@@ -453,13 +453,13 @@ numberOfInversionsMerge (Permutation arr) = fst (sortCnt n $ elems arr) where
+   sortCnt 2 [x,y] = if x>y then (1,[y,x]) else (0,[x,y])
+   sortCnt n xs    = mergeCnt (sortCnt k us) (sortCnt l vs) where
+     k = div n 2
+-    l = n - k 
++    l = n - k
+     (us,vs) = splitAt k xs
+ 
+   mergeCnt :: (Int,[Int]) -> (Int,[Int]) -> (Int,[Int])
+   mergeCnt (!c,us) (!d,vs) = (c+d+e,ws) where
+ 
+-    (e,ws) = go 0 us vs 
++    (e,ws) = go 0 us vs
+ 
+     go !k xs [] = ( k*length xs , xs )
+     go _  [] ys = ( 0 , ys)
+@@ -478,7 +478,7 @@ numberOfInversionsNaive (Permutation arr) = length list where
+ --
+ -- > multiplyMany' n (map (transposition n) $ bubbleSort2 perm) == perm
+ --
+--- Note that while this is not unique, the number of transpositions 
++-- Note that while this is not unique, the number of transpositions
+ -- equals the number of inversions.
+ --
+ bubbleSort2 :: Permutation -> [(Int,Int)]
+@@ -504,7 +504,7 @@ bubbleSort perm@(Permutation tgt) = runST action where
+ 
+       let k = tgt ! x        -- we take the number which will be at the @x@-th position at the end
+       i <- readArray inv k   -- number @k@ is at the moment at position @i@
+-      let j = x              -- but the final place is at @x@      
++      let j = x              -- but the final place is at @x@
+ 
+       let swaps = move i j
+       forM_ swaps $ \y -> do
+@@ -520,7 +520,7 @@ bubbleSort perm@(Permutation tgt) = runST action where
+         writeArray inv a v
+ 
+       return swaps
+-  
++
+     return (concat list)
+ 
+   move :: Int -> Int -> [Int]
+@@ -540,13 +540,13 @@ reversePermutation n = Permutation $ listArray (1,n) [n,n-1..1]
+ isReversePermutation :: Permutation -> Bool
+ isReversePermutation (Permutation arr) = elems arr == [n,n-1..1] where (1,n) = bounds arr
+ 
+--- | A transposition (swapping two elements). 
++-- | A transposition (swapping two elements).
+ --
+ -- @transposition n (i,j)@ is the permutation of size @n@ which swaps @i@\'th and @j@'th elements.
+ --
+ transposition :: Int -> (Int,Int) -> Permutation
+-transposition n (i,j) = 
+-  if i>=1 && j>=1 && i<=n && j<=n 
++transposition n (i,j) =
++  if i>=1 && j>=1 && i<=n && j<=n
+     then Permutation $ listArray (1,n) [ f k | k<-[1..n] ]
+     else error "transposition: index out of range"
+   where
+@@ -563,19 +563,19 @@ transpositions n list = Permutation (runSTUArray action) where
+ 
+   action :: ST s (STUArray s Int Int)
+   action = do
+-    arr <- newArray_ (1,n) 
+-    forM_ [1..n] $ \i -> writeArray arr i i    
++    arr <- newArray_ (1,n)
++    forM_ [1..n] $ \i -> writeArray arr i i
+     let doSwap (i,j) = do
+           u <- readArray arr i
+           v <- readArray arr j
+           writeArray arr i v
+-          writeArray arr j u          
++          writeArray arr j u
+     mapM_ doSwap list
+     return arr
+ 
+ -- | @adjacentTransposition n k@ swaps the elements @k@ and @(k+1)@.
+ adjacentTransposition :: Int -> Int -> Permutation
+-adjacentTransposition n k 
++adjacentTransposition n k
+   | k>0 && k<n  = transposition n (k,k+1)
+   | otherwise   = error "adjacentTransposition: index out of range"
+ 
+@@ -588,42 +588,42 @@ adjacentTranspositions n list = Permutation (runSTUArray action) where
+ 
+   action :: ST s (STUArray s Int Int)
+   action = do
+-    arr <- newArray_ (1,n) 
+-    forM_ [1..n] $ \i -> writeArray arr i i    
++    arr <- newArray_ (1,n)
++    forM_ [1..n] $ \i -> writeArray arr i i
+     let doSwap i
+           | i<0 || i>=n  = error "adjacentTranspositions: index out of range"
+           | otherwise    = do
+               u <- readArray arr  i
+               v <- readArray arr (i+1)
+               writeArray arr  i    v
+-              writeArray arr (i+1) u          
++              writeArray arr (i+1) u
+     mapM_ doSwap list
+     return arr
+ 
+ -- | The permutation which cycles a list left by one step:
+--- 
++--
+ -- > permuteList (cycleLeft 5) "abcde" == "bcdea"
+ --
+ -- Or in two-line notation:
+ --
+ -- > ( 1 2 3 4 5 )
+ -- > ( 2 3 4 5 1 )
+--- 
++--
+ cycleLeft :: Int -> Permutation
+ cycleLeft n = Permutation $ listArray (1,n) $ [2..n] ++ [1]
+ 
+ -- | The permutation which cycles a list right by one step:
+--- 
++--
+ -- > permuteList (cycleRight 5) "abcde" == "eabcd"
+ --
+ -- Or in two-line notation:
+ --
+ -- > ( 1 2 3 4 5 )
+ -- > ( 5 1 2 3 4 )
+--- 
++--
+ cycleRight :: Int -> Permutation
+ cycleRight n = Permutation $ listArray (1,n) $ n : [1..n-1]
+-   
++
+ --------------------------------------------------------------------------------
+ -- * Permutation groups
+ 
+@@ -631,55 +631,55 @@ cycleRight n = Permutation $ listArray (1,n) $ n : [1..n-1]
+ -- means the permutation when we first apply @p@, and then @q@
+ -- (that is, the natural action is the /right/ action)
+ --
+--- See also 'permute' for our conventions.  
++-- See also 'permute' for our conventions.
+ --
+ multiply :: Permutation -> Permutation -> Permutation
+-multiply pi1@(Permutation perm1) pi2@(Permutation perm2) = 
+-  if (n==m) 
++multiply pi1@(Permutation perm1) pi2@(Permutation perm2) =
++  if (n==m)
+     then Permutation result
+-    else error "multiply: permutations of different sets"  
++    else error "multiply: permutations of different sets"
+   where
+     (_,n) = bounds perm1
+-    (_,m) = bounds perm2    
++    (_,m) = bounds perm2
+     result = permute pi2 perm1
+-  
+-infixr 7 `multiply`  
++
++infixr 7 `multiply`
+ 
+ -- | The inverse permutation.
+-inverse :: Permutation -> Permutation    
++inverse :: Permutation -> Permutation
+ inverse (Permutation perm1) = Permutation result
+   where
+     result = array (1,n) $ map swap $ assocs perm1
+     (_,n) = bounds perm1
+-    
++
+ -- | The identity (or trivial) permutation.
+-identity :: Int -> Permutation 
++identity :: Int -> Permutation
+ identity n = Permutation $ listArray (1,n) [1..n]
+ 
+ -- | Multiply together a /non-empty/ list of permutations (the reason for requiring the list to
+ -- be non-empty is that we don\'t know the size of the result). See also 'multiplyMany''.
+-multiplyMany :: [Permutation] -> Permutation 
++multiplyMany :: [Permutation] -> Permutation
+ multiplyMany [] = error "multiplyMany: empty list, we don't know size of the result"
+-multiplyMany ps = foldl1' multiply ps    
++multiplyMany ps = foldl1' multiply ps
+ 
+ -- | Multiply together a (possibly empty) list of permutations, all of which has size @n@
+-multiplyMany' :: Int -> [Permutation] -> Permutation 
++multiplyMany' :: Int -> [Permutation] -> Permutation
+ multiplyMany' n []       = identity n
+-multiplyMany' n ps@(p:_) = if n == permutationSize p 
+-  then foldl1' multiply ps    
++multiplyMany' n ps@(p:_) = if n == permutationSize p
++  then foldl1' multiply ps
+   else error "multiplyMany': incompatible permutation size(s)"
+ 
+ --------------------------------------------------------------------------------
+ -- * Action of the permutation group
+ 
+--- | /Right/ action of a permutation on a set. If our permutation is 
++-- | /Right/ action of a permutation on a set. If our permutation is
+ -- encoded with the sequence @[p1,p2,...,pn]@, then in the
+ -- two-line notation we have
+ --
+ -- > ( 1  2  3  ... n  )
+ -- > ( p1 p2 p3 ... pn )
+ --
+--- We adopt the convention that permutations act /on the right/ 
++-- We adopt the convention that permutations act /on the right/
+ -- (as in Knuth):
+ --
+ -- > permute pi2 (permute pi1 set) == permute (pi1 `multiply` pi2) set
+@@ -688,37 +688,37 @@ multiplyMany' n ps@(p:_) = if n == permutationSize p
+ --
+ {-# SPECIALIZE permute :: Permutation -> Array  Int b   -> Array  Int b   #-}
+ {-# SPECIALIZE permute :: Permutation -> UArray Int Int -> UArray Int Int #-}
+-permute :: IArray arr b => Permutation -> arr Int b -> arr Int b    
++permute :: IArray arr b => Permutation -> arr Int b -> arr Int b
+ permute = permuteRight
+ 
+ -- | Right action on lists. Synonym to 'permuteListRight'
+ --
+ permuteList :: Permutation -> [a] -> [a]
+ permuteList = permuteRightList
+-    
+--- | The right (standard) action of permutations on sets. 
+--- 
++
++-- | The right (standard) action of permutations on sets.
++--
+ -- > permuteRight pi2 (permuteRight pi1 set) == permuteRight (pi1 `multiply` pi2) set
+---   
++--
+ -- The second argument should be an array with bounds @(1,n)@.
+ -- The function checks the array bounds.
+ --
+ {-# SPECIALIZE permuteRight :: Permutation -> Array  Int b   -> Array  Int b   #-}
+ {-# SPECIALIZE permuteRight :: Permutation -> UArray Int Int -> UArray Int Int #-}
+-permuteRight :: IArray arr b => Permutation -> arr Int b -> arr Int b    
+-permuteRight pi@(Permutation perm) ar = 
+-  if (a==1) && (b==n) 
+-    then listArray (1,n) [ ar!(perm!i) | i <- [1..n] ] 
++permuteRight :: IArray arr b => Permutation -> arr Int b -> arr Int b
++permuteRight pi@(Permutation perm) ar =
++  if (a==1) && (b==n)
++    then listArray (1,n) [ ar!(perm!i) | i <- [1..n] ]
+     else error "permuteRight: array bounds do not match"
+   where
+-    (_,n) = bounds perm  
+-    (a,b) = bounds ar   
++    (_,n) = bounds perm
++    (a,b) = bounds ar
+ 
+ -- | The right (standard) action on a list. The list should be of length @n@.
+ --
+ -- > fromPermutation perm == permuteRightList perm [1..n]
+--- 
+-permuteRightList :: forall a . Permutation -> [a] -> [a]    
++--
++permuteRightList :: forall a . Permutation -> [a] -> [a]
+ permuteRightList perm xs = elems $ permuteRight perm $ arr where
+   arr = listArray (1,n) xs :: Array Int a
+   n   = permutationSize perm
+@@ -734,22 +734,22 @@ permuteRightList perm xs = elems $ permuteRight perm $ arr where
+ --
+ {-# SPECIALIZE permuteLeft :: Permutation -> Array  Int b   -> Array  Int b   #-}
+ {-# SPECIALIZE permuteLeft :: Permutation -> UArray Int Int -> UArray Int Int #-}
+-permuteLeft :: IArray arr b => Permutation -> arr Int b -> arr Int b    
+-permuteLeft pi@(Permutation perm) ar =    
++permuteLeft :: IArray arr b => Permutation -> arr Int b -> arr Int b
++permuteLeft pi@(Permutation perm) ar =
+   -- permuteRight (inverse pi) ar
+-  if (a==1) && (b==n) 
+-    then array (1,n) [ ( perm!i , ar!i ) | i <- [1..n] ] 
++  if (a==1) && (b==n)
++    then array (1,n) [ ( perm!i , ar!i ) | i <- [1..n] ]
+     else error "permuteLeft: array bounds do not match"
+   where
+-    (_,n) = bounds perm  
+-    (a,b) = bounds ar   
++    (_,n) = bounds perm
++    (a,b) = bounds ar
+ 
+ -- | The left (opposite) action on a list. The list should be of length @n@.
+ --
+ -- > permuteLeftList perm set == permuteList (inverse perm) set
+ -- > fromPermutation (inverse perm) == permuteLeftList perm [1..n]
+ --
+-permuteLeftList :: forall a. Permutation -> [a] -> [a]    
++permuteLeftList :: forall a. Permutation -> [a] -> [a]
+ permuteLeftList perm xs = elems $ permuteLeft perm $ arr where
+   arr = listArray (1,n) xs :: Array Int a
+   n   = permutationSize perm
+@@ -792,9 +792,9 @@ _permutations = _permutationsNaive
+ 
+ -- | All permutations of @[1..n]@ in lexicographic order, naive algorithm.
+ permutationsNaive :: Int -> [Permutation]
+-permutationsNaive n = map toPermutationUnsafe $ _permutations n 
++permutationsNaive n = map toPermutationUnsafe $ _permutations n
+ 
+-_permutationsNaive :: Int -> [[Int]]  
++_permutationsNaive :: Int -> [[Int]]
+ _permutationsNaive 0 = [[]]
+ _permutationsNaive 1 = [[1]]
+ _permutationsNaive n = helper [1..n] where
+@@ -802,7 +802,7 @@ _permutationsNaive n = helper [1..n] where
+   helper xs = [ i : ys | i <- xs , ys <- helper (xs `minus` i) ]
+   minus [] _ = []
+   minus (x:xs) i = if x < i then x : minus xs i else xs
+-          
++
+ -- | # = n!
+ countPermutations :: Int -> Integer
+ countPermutations = factorial
+@@ -816,7 +816,7 @@ randomPermutation = randomPermutationDurstenfeld
+ 
+ _randomPermutation :: RandomGen g => Int -> g -> ([Int],g)
+ _randomPermutation n rndgen = (fromPermutation perm, rndgen') where
+-  (perm, rndgen') = randomPermutationDurstenfeld n rndgen 
++  (perm, rndgen') = randomPermutationDurstenfeld n rndgen
+ 
+ -- | A synonym for 'randomCyclicPermutationSattolo'.
+ randomCyclicPermutation :: RandomGen g => Int -> g -> (Permutation,g)
+@@ -824,7 +824,7 @@ randomCyclicPermutation = randomCyclicPermutationSattolo
+ 
+ _randomCyclicPermutation :: RandomGen g => Int -> g -> ([Int],g)
+ _randomCyclicPermutation n rndgen = (fromPermutation perm, rndgen') where
+-  (perm, rndgen') = randomCyclicPermutationSattolo n rndgen 
++  (perm, rndgen') = randomCyclicPermutationSattolo n rndgen
+ 
+ -- | Generates a uniformly random permutation of @[1..n]@.
+ -- Durstenfeld's algorithm (see <http://en.wikipedia.org/wiki/Knuth_shuffle>).
+@@ -839,65 +839,65 @@ randomCyclicPermutationSattolo = randomPermutationDurstenfeldSattolo True
+ randomPermutationDurstenfeldSattolo :: RandomGen g => Bool -> Int -> g -> (Permutation,g)
+ randomPermutationDurstenfeldSattolo isSattolo n rnd = res where
+   res = runST $ do
+-    ar <- newArray_ (1,n) 
++    ar <- newArray_ (1,n)
+     forM_ [1..n] $ \i -> writeArray ar i i
+-    rnd' <- worker n (if isSattolo then n-1 else n) rnd ar 
++    rnd' <- worker n (if isSattolo then n-1 else n) rnd ar
+     perm <- Data.Array.Unsafe.unsafeFreeze ar
+     return (Permutation perm, rnd')
+-  worker :: RandomGen g => Int -> Int -> g -> STUArray s Int Int -> ST s g 
+-  worker n m rnd ar = 
+-    if n==1 
+-      then return rnd 
++  worker :: RandomGen g => Int -> Int -> g -> STUArray s Int Int -> ST s g
++  worker n m rnd ar =
++    if n==1
++      then return rnd
+       else do
+         let (k,rnd') = randomR (1,m) rnd
+         when (k /= n) $ do
+-          y <- readArray ar k 
++          y <- readArray ar k
+           z <- readArray ar n
+           writeArray ar n y
+           writeArray ar k z
+-        worker (n-1) (m-1) rnd' ar 
++        worker (n-1) (m-1) rnd' ar
+ 
+ --------------------------------------------------------------------------------
+ -- * Permutations of a multiset
+ 
+--- | Generates all permutations of a multiset.  
++-- | Generates all permutations of a multiset.
+ --   The order is lexicographic. A synonym for 'fasc2B_algorithm_L'
+-permuteMultiset :: (Eq a, Ord a) => [a] -> [[a]] 
++permuteMultiset :: (Eq a, Ord a) => [a] -> [[a]]
+ permuteMultiset = fasc2B_algorithm_L
+ 
+--- | # = \\frac { (\sum_i n_i) ! } { \\prod_i (n_i !) }    
++-- | # = \\frac { (\sum_i n_i) ! } { \\prod_i (n_i !) }
+ countPermuteMultiset :: (Eq a, Ord a) => [a] -> Integer
+-countPermuteMultiset xs = factorial n `div` product [ factorial (length z) | z <- group ys ] 
++countPermuteMultiset xs = factorial n `div` product [ factorial (length z) | z <- group ys ]
+   where
+     ys = sort xs
+     n = length xs
+-  
+--- | Generates all permutations of a multiset 
+---   (based on \"algorithm L\" in Knuth; somewhat less efficient). 
+---   The order is lexicographic.  
+-fasc2B_algorithm_L :: (Eq a, Ord a) => [a] -> [[a]] 
++
++-- | Generates all permutations of a multiset
++--   (based on \"algorithm L\" in Knuth; somewhat less efficient).
++--   The order is lexicographic.
++fasc2B_algorithm_L :: (Eq a, Ord a) => [a] -> [[a]]
+ fasc2B_algorithm_L xs = unfold1 next (sort xs) where
+ 
+   -- next :: [a] -> Maybe [a]
+-  next xs = case findj (reverse xs,[]) of 
++  next xs = case findj (reverse xs,[]) of
+     Nothing -> Nothing
+-    Just ( (l:ls) , rs) -> Just $ inc l ls (reverse rs,[]) 
++    Just ( (l:ls) , rs) -> Just $ inc l ls (reverse rs,[])
+     Just ( [] , _ ) -> error "permute: should not happen"
+ 
+   -- we use simple list zippers: (left,right)
+-  -- findj :: ([a],[a]) -> Maybe ([a],[a])   
+-  findj ( xxs@(x:xs) , yys@(y:_) ) = if x >= y 
++  -- findj :: ([a],[a]) -> Maybe ([a],[a])
++  findj ( xxs@(x:xs) , yys@(y:_) ) = if x >= y
+     then findj ( xs , x : yys )
+     else Just ( xxs , yys )
+-  findj ( x:xs , [] ) = findj ( xs , [x] )  
++  findj ( x:xs , [] ) = findj ( xs , [x] )
+   findj ( [] , _ ) = Nothing
+-  
++
+   -- inc :: a -> [a] -> ([a],[a]) -> [a]
+   inc !u us ( (x:xs) , yys ) = if u >= x
+-    then inc u us ( xs , x : yys ) 
++    then inc u us ( xs , x : yys )
+     else reverse (x:us)  ++ reverse (u:yys) ++ xs
+   inc _ _ ( [] , _ ) = error "permute: should not happen"
+-      
++
+ --------------------------------------------------------------------------------
+ 
+ 
+diff --git a/Math/Combinat/Sets/VennDiagrams.hs b/Math/Combinat/Sets/VennDiagrams.hs
+index ca53acf..af56d9e 100644
+--- a/Math/Combinat/Sets/VennDiagrams.hs
++++ b/Math/Combinat/Sets/VennDiagrams.hs
+@@ -9,7 +9,7 @@ module Math.Combinat.Sets.VennDiagrams where
+ 
+ --------------------------------------------------------------------------------
+ 
+-import Data.List
++import Data.List (foldl')
+ 
+ import GHC.TypeLits
+ import Data.Proxy
+@@ -26,7 +26,7 @@ import Math.Combinat.ASCII
+ -- of type @a@. A typical use case is to annotate with the cardinality of the
+ -- given zone.
+ --
+--- Internally this is representated by a map from @[Bool]@, where @True@ means element 
++-- Internally this is representated by a map from @[Bool]@, where @True@ means element
+ -- of the set, @False@ means not.
+ --
+ -- TODO: write a more efficient implementation (for example an array of size 2^n)
+@@ -108,7 +108,7 @@ vennDiagramSetCardinalities (VennDiagram table) = go n list where
+ -- > autoTabulate RowMajor (Right 6) $ map ascii $ enumerateVennDiagrams [2,3,3]
+ --
+ enumerateVennDiagrams :: [Int] -> [VennDiagram Int]
+-enumerateVennDiagrams dims = 
++enumerateVennDiagrams dims =
+   case dims of
+     []     -> []
+     [d]    -> venns1 d
+@@ -121,8 +121,8 @@ enumerateVennDiagrams dims =
+       falses = replicate n False
+ 
+       comps k = compositions' (map snd list) k
+-      result = 
+-        [ unsafeMakeVennDiagram $ 
++      result =
++        [ unsafeMakeVennDiagram $
+             [ (False:tfs    , m-c) | ((tfs,m),c) <- zip list comp ] ++
+             [ (True :tfs    ,   c) | ((tfs,m),c) <- zip list comp ] ++
+             [ (True :falses , d-k) ]
+@@ -131,8 +131,8 @@ enumerateVennDiagrams dims =
+         ]
+ 
+     venns1 :: Int -> [VennDiagram Int]
+-    venns1 p = [ theVenn ] where 
+-      theVenn = unsafeMakeVennDiagram [ ([True],p) ] 
++    venns1 p = [ theVenn ] where
++      theVenn = unsafeMakeVennDiagram [ ([True],p) ]
+ 
+ --------------------------------------------------------------------------------
+ 
+@@ -140,9 +140,9 @@ enumerateVennDiagrams dims =
+ 
+ -- | for testing only
+ venns2 :: Int -> Int -> [Venn Int]
+-venns2 p q = 
++venns2 p q =
+   [ mkVenn [ ([t,f],p-k) , ([f,t],q-k) , ([t,t],k) ]
+-  | k <- [0..min p q] 
++  | k <- [0..min p q]
+   ]
+   where
+     t = True
+diff --git a/Math/Combinat/Tableaux.hs b/Math/Combinat/Tableaux.hs
+index 9e8fd0b..ea6e82a 100644
+--- a/Math/Combinat/Tableaux.hs
++++ b/Math/Combinat/Tableaux.hs
+@@ -1,14 +1,14 @@
+ 
+--- | Young tableaux and similar gadgets. 
++-- | Young tableaux and similar gadgets.
+ --
+---   See e.g. William Fulton: Young Tableaux, with Applications to 
++--   See e.g. William Fulton: Young Tableaux, with Applications to
+ --   Representation theory and Geometry (CUP 1997).
+--- 
+---   The convention is that we use 
++--
++--   The convention is that we use
+ --   the English notation, and we store the tableaux as lists of the rows.
+--- 
++--
+ --   That is, the following standard Young tableau of shape [5,4,1]
+--- 
++--
+ -- >  1  3  4  6  7
+ -- >  2  5  8 10
+ -- >  9
+@@ -16,7 +16,7 @@
+ -- <<svg/young_tableau.svg>>
+ --
+ --   is encoded conveniently as
+--- 
++--
+ -- > [ [ 1 , 3 , 4 , 6 , 7 ]
+ -- > , [ 2 , 5 , 8 ,10 ]
+ -- > , [ 9 ]
+@@ -28,7 +28,7 @@ module Math.Combinat.Tableaux where
+ 
+ --------------------------------------------------------------------------------
+ 
+-import Data.List
++import Data.List (sort, transpose)
+ 
+ import Math.Combinat.Classes
+ import Math.Combinat.Numbers ( factorial , binomial )
+@@ -48,7 +48,7 @@ type Tableau a = [[a]]
+ 
+ -- | ASCII diagram of a tableau
+ asciiTableau :: Show a => Tableau a -> ASCII
+-asciiTableau t = tabulate (HRight,VTop) (HSepSpaces 1, VSepEmpty) 
++asciiTableau t = tabulate (HRight,VTop) (HSepSpaces 1, VSepEmpty)
+            $ (map . map) asciiShow
+            $ t
+ 
+@@ -56,11 +56,11 @@ instance CanBeEmpty (Tableau a) where
+   empty   = []
+   isEmpty = null
+ 
+-instance Show a => DrawASCII (Tableau a) where 
++instance Show a => DrawASCII (Tableau a) where
+   ascii = asciiTableau
+ 
+ _tableauShape :: Tableau a -> [Int]
+-_tableauShape t = map length t 
++_tableauShape t = map length t
+ 
+ -- | The shape of a tableau
+ tableauShape :: Tableau a -> Partition
+@@ -90,7 +90,7 @@ tableauContent = concat
+ 
+ -- | An element @(i,j)@ of the resulting tableau (which has shape of the
+ -- given partition) means that the vertical part of the hook has length @i@,
+--- and the horizontal part @j@. The /hook length/ is thus @i+j-1@. 
++-- and the horizontal part @j@. The /hook length/ is thus @i+j-1@.
+ --
+ -- Example:
+ --
+@@ -100,13 +100,13 @@ tableauContent = concat
+ -- > [(1,1)]
+ --
+ hooks :: Partition -> Tableau (Int,Int)
+-hooks part = zipWith f p [1..] where 
++hooks part = zipWith f p [1..] where
+   p = fromPartition part
+   q = _dualPartition p
+-  f l i = zipWith (\x y -> (x-i+1,y)) q [l,l-1..1] 
++  f l i = zipWith (\x y -> (x-i+1,y)) q [l,l-1..1]
+ 
+ hookLengths :: Partition -> Tableau Int
+-hookLengths part = (map . map) (\(i,j) -> i+j-1) (hooks part) 
++hookLengths part = (map . map) (\(i,j) -> i+j-1) (hooks part)
+ 
+ --------------------------------------------------------------------------------
+ -- * Row and column words
+@@ -134,7 +134,7 @@ columnWord = rowWord . transpose
+ columnWordToTableau :: Ord a => [a] -> Tableau a
+ columnWordToTableau = transpose . rowWordToTableau
+ 
+--- | Checks whether a sequence of positive integers is a /lattice word/, 
++-- | Checks whether a sequence of positive integers is a /lattice word/,
+ -- which means that in every initial part of the sequence any number @i@
+ -- occurs at least as often as the number @i+1@
+ --
+@@ -163,16 +163,16 @@ isSemiStandardTableau t = weak && strict where
+   weak   = and [ isWeaklyIncreasing   xs | xs <- t  ]
+   strict = and [ isStrictlyIncreasing ys | ys <- dt ]
+   dt     = dualTableau t
+-   
+--- | Semistandard Young tableaux of given shape, \"naive\" algorithm    
++
++-- | Semistandard Young tableaux of given shape, \"naive\" algorithm
+ semiStandardYoungTableaux :: Int -> Partition -> [Tableau Int]
+ semiStandardYoungTableaux n part = worker (repeat 0) shape where
+   shape = fromPartition part
+-  worker _ [] = [[]] 
+-  worker prevRow (s:ss) 
++  worker _ [] = [[]]
++  worker prevRow (s:ss)
+     = [ (r:rs) | r <- row n s 1 prevRow, rs <- worker (map (+1) r) ss ]
+ 
+-  -- weekly increasing lists of length @len@, pointwise at least @xs@, 
++  -- weekly increasing lists of length @len@, pointwise at least @xs@,
+   -- maximum value @n@, minimum value @prev@.
+   row :: Int -> Int -> Int -> [Int] -> [[Int]]
+   row _ 0   _    _      = [[]]
+@@ -181,10 +181,10 @@ semiStandardYoungTableaux n part = worker (repeat 0) shape where
+ -- | Stanley's hook formula (cf. Fulton page 55)
+ countSemiStandardYoungTableaux :: Int -> Partition -> Integer
+ countSemiStandardYoungTableaux n shape = k `div` h where
+-  h = product $ map fromIntegral $ concat $ hookLengths shape 
++  h = product $ map fromIntegral $ concat $ hookLengths shape
+   k = product [ fromIntegral (n+j-i) | (i,j) <- elements shape ]
+ 
+-   
++
+ --------------------------------------------------------------------------------
+ -- * Standard Young tableaux
+ 
+@@ -195,14 +195,14 @@ isStandardTableau t = isSemiStandardTableau t && sort (concat t) == [1..n] where
+   n = sum [ length xs | xs <- t ]
+ 
+ -- | Standard Young tableaux of a given shape.
+---   Adapted from John Stembridge, 
++--   Adapted from John Stembridge,
+ --   <http://www.math.lsa.umich.edu/~jrs/software/SFexamples/tableaux>.
+ standardYoungTableaux :: Partition -> [Tableau Int]
+ standardYoungTableaux shape' = map rev $ tableaux shape where
+   shape = fromPartition shape'
+   rev = reverse . map reverse
+   tableaux :: [Int] -> [Tableau Int]
+-  tableaux p = 
++  tableaux p =
+     case p of
+       []  -> [[]]
+       [n] -> [[[n,n-1..1]]]
+@@ -213,15 +213,15 @@ standardYoungTableaux shape' = map rev $ tableaux shape where
+   worker :: (Int,Int) -> Int -> [Int] -> [Int] -> [Tableau Int]
+   worker _ _ _ [] = []
+   worker nk i ls (x:rs) = case rs of
+-    (y:_) -> if x==y 
++    (y:_) -> if x==y
+       then worker nk (i+1) (x:ls) rs
+       else worker2 nk i ls x rs
+     [] ->  worker2 nk i ls x rs
+   worker2 :: (Int,Int) -> Int -> [Int] -> Int -> [Int] -> [Tableau Int]
+   worker2 nk@(n,k) i ls x rs = new ++ worker nk (i+1) (x:ls) rs where
+-    old = if x>1 
++    old = if x>1
+       then             tableaux $ reverse ls ++ (x-1) : rs
+-      else map ([]:) $ tableaux $ reverse ls ++ rs   
++      else map ([]:) $ tableaux $ reverse ls ++ rs
+     a = k-1-i
+     new = {- debug ( i , a , head old , f a (head old) ) $ -}
+       map (f a) old
+@@ -229,14 +229,14 @@ standardYoungTableaux shape' = map rev $ tableaux shape where
+     f _ [] = []
+     f 0 (t:ts) = (n:t) : f (-1) ts
+     f j (t:ts) = t : f (j-1) ts
+-  
++
+ -- | hook-length formula
+ countStandardYoungTableaux :: Partition -> Integer
+ countStandardYoungTableaux part = {- debug (hookLengths part) $ -}
+   factorial n `div` h where
+-    h = product $ map fromIntegral $ concat $ hookLengths part 
++    h = product $ map fromIntegral $ concat $ hookLengths part
+     n = weight part
+ 
+ --------------------------------------------------------------------------------
+-        
+-    
+\ No newline at end of file
++
++
+diff --git a/Math/Combinat/Tableaux/GelfandTsetlin.hs b/Math/Combinat/Tableaux/GelfandTsetlin.hs
+index a3686e2..f01fb65 100644
+--- a/Math/Combinat/Tableaux/GelfandTsetlin.hs
++++ b/Math/Combinat/Tableaux/GelfandTsetlin.hs
+@@ -12,10 +12,10 @@
+ -- Note: these are in bijection with the semi-standard Young tableaux.
+ --
+ -- If we add the further restriction that
+--- the top diagonal reads @lambda@, 
++-- the top diagonal reads @lambda@,
+ -- and the diagonal sums are partial sums of @mu@, where @lambda@ and @mu@ are two
+--- partitions (in this case @lambda=[3,2]@ and @mu=[2,1,1,1]@), 
+--- then the number of the resulting patterns 
++-- partitions (in this case @lambda=[3,2]@ and @mu=[2,1,1,1]@),
++-- then the number of the resulting patterns
+ -- or tableaux is the Kostka number @K(lambda,mu)@.
+ -- Actually @mu@ doesn't even need to the be non-increasing.
+ --
+@@ -25,7 +25,7 @@ module Math.Combinat.Tableaux.GelfandTsetlin where
+ 
+ --------------------------------------------------------------------------------
+ 
+-import Data.List
++import Data.List (foldl', group, sort)
+ import Data.Maybe
+ import Data.Monoid
+ import Data.Ord
+@@ -58,7 +58,7 @@ kostkaNumberReferenceNaive :: Partition -> Partition -> Int
+ kostkaNumberReferenceNaive plambda pmu@(Partition mu) = length stuff where
+   stuff  = [ (1::Int) | t <- semiStandardYoungTableaux k plambda , cond t ]
+   k      = length mu
+-  cond t = [ (head xs, length xs) | xs <- group (sort $ concat t) ] == zip [1..] mu 
++  cond t = [ (head xs, length xs) | xs <- group (sort $ concat t) ] == zip [1..] mu
+ 
+ --------------------------------------------------------------------------------
+ 
+@@ -84,8 +84,8 @@ kostkaNumbersWithGivenLambda plambda@(Partition lam) = evalState (worker lam) Ma
+         Nothing  -> do
+           let s = foldl' (+) 0 unlam
+           subsols <- forM (prevLambdas0 unlam) $ \p -> do
+-            sub <- worker p 
+-            let t = s - foldl' (+) 0 p              
++            sub <- worker p
++            let t = s - foldl' (+) 0 p
+                 f (Partition xs , c) = case xs of
+                   (y:_) -> if t >= y then Just (Partition (t:xs) , c) else Nothing
+                   []    -> if t >  0 then Just (Partition [t]    , c) else Nothing
+@@ -121,7 +121,7 @@ kostkaNumbersWithGivenMu (Partition mu) = iteratedPieriRule (reverse mu)
+ type GT = [[Int]]
+ 
+ asciiGT :: GT -> ASCII
+-asciiGT gt = tabulate (HRight,VTop) (HSepSpaces 1, VSepEmpty) 
++asciiGT gt = tabulate (HRight,VTop) (HSepSpaces 1, VSepEmpty)
+            $ (map . map) asciiShow
+            $ gt
+ 
+@@ -165,11 +165,11 @@ kostkaGelfandTsetlinPatterns' plam@(Partition lambda0) mu0
+     wmu  = sum' mu
+     wlam = sum' lambda
+ 
+-    list = worker 
+-             revlam 
+-             (scanl1 (+) mu) 
+-             (replicate (n-1) 0) 
+-             (replicate (n  ) 0) 
++    list = worker
++             revlam
++             (scanl1 (+) mu)
++             (replicate (n-1) 0)
++             (replicate (n  ) 0)
+              []
+ 
+     worker
+@@ -178,16 +178,16 @@ kostkaGelfandTsetlinPatterns' plam@(Partition lambda0) mu0
+       -> [Int]       -- sums of the tails of previous rows
+       -> [Int]       -- last row
+       -> [[Int]]     -- the lower part of GT tableau we accumulated so far (this is not needed if we only want to count)
+-      -> [GT]   
++      -> [GT]
+ 
+-    worker (rl:rls) (smu:smus) (a:acc) (lastx0:lastrowt) table = stuff 
++    worker (rl:rls) (smu:smus) (a:acc) (lastx0:lastrowt) table = stuff
+       where
+         x0 = smu - a
+-        stuff = concat 
++        stuff = concat
+           [ worker rls smus (zipWith (+) acc (tail row)) (init row) (row:table)
+           | row <- boundedNonIncrSeqs' x0 (map (max rl) (max lastx0 x0 : lastrowt)) lambda
+           ]
+-    worker [rl] _ _ _ table = [ [rl]:table ] 
++    worker [rl] _ _ _ table = [ [rl]:table ]
+     worker []   _ _ _ _     = [ []         ]
+ 
+     boundedNonIncrSeqs' :: Int -> [Int] -> [Int] -> [[Int]]
+@@ -201,9 +201,9 @@ kostkaGelfandTsetlinPatterns' plam@(Partition lambda0) mu0
+ -- | This returns the corresponding Kostka number:
+ --
+ -- > countKostkaGelfandTsetlinPatterns lambda mu == length (kostkaGelfandTsetlinPatterns lambda mu)
+--- 
++--
+ countKostkaGelfandTsetlinPatterns :: Partition -> Partition -> Int
+-countKostkaGelfandTsetlinPatterns plam@(Partition lambda0) pmu@(Partition mu0) 
++countKostkaGelfandTsetlinPatterns plam@(Partition lambda0) pmu@(Partition mu0)
+   | wlam == 0                             = if wmu == 0 then 1 else 0
+   | wmu  == wlam && plam `dominates` pmu  = cnt
+   | otherwise                             = 0
+@@ -222,11 +222,11 @@ countKostkaGelfandTsetlinPatterns plam@(Partition lambda0) pmu@(Partition mu0)
+     wmu  = sum' mu
+     wlam = sum' lambda
+ 
+-    cnt = worker 
+-            revlam 
+-            (scanl1 (+) mu) 
+-            (replicate (n-1) 0) 
+-            (replicate (n  ) 0) 
++    cnt = worker
++            revlam
++            (scanl1 (+) mu)
++            (replicate (n-1) 0)
++            (replicate (n  ) 0)
+ 
+     worker
+       :: [Int]       -- lambda_i in reverse order
+@@ -235,14 +235,14 @@ countKostkaGelfandTsetlinPatterns plam@(Partition lambda0) pmu@(Partition mu0)
+       -> [Int]       -- last row
+       -> Int
+ 
+-    worker (rl:rls) (smu:smus) (a:acc) (lastx0:lastrowt) = stuff 
++    worker (rl:rls) (smu:smus) (a:acc) (lastx0:lastrowt) = stuff
+       where
+         x0 = smu - a
+         stuff = sum'
+-          [ worker rls smus (zipWith (+) acc (tail row)) (init row) 
++          [ worker rls smus (zipWith (+) acc (tail row)) (init row)
+           | row <- boundedNonIncrSeqs' x0 (map (max rl) (max lastx0 x0 : lastrowt)) lambda
+           ]
+-    worker [rl] _ _ _ = 1 
++    worker [rl] _ _ _ = 1
+     worker []   _ _ _ = 1
+ 
+     boundedNonIncrSeqs' :: Int -> [Int] -> [Int] -> [[Int]]
+@@ -257,7 +257,7 @@ countKostkaGelfandTsetlinPatterns plam@(Partition lambda0) pmu@(Partition mu0)
+ 
+ -- | All non-increasing sentences between a lower and an upper bound
+ boundedNonIncrSeqs :: [Int] -> [Int] -> [[Int]]
+-boundedNonIncrSeqs as bs = case bs of  
++boundedNonIncrSeqs as bs = case bs of
+   (h0:_) -> boundedNonIncrSeqs' h0 as bs
+   []     -> [[]]
+ 
+@@ -282,13 +282,13 @@ boundedNonDecrSeqs' h0 = go (max 0 h0) where
+ -}
+ 
+ --------------------------------------------------------------------------------
+--- * The iterated Pieri rule 
++-- * The iterated Pieri rule
+ 
+ -- | Computes the Schur expansion of @h[n1]*h[n2]*h[n3]*...*h[nk]@ via iterating the Pieri rule.
+ -- Note: the coefficients are actually the Kostka numbers; the following is true:
+ --
+ -- > Map.toList (iteratedPieriRule (fromPartition mu))  ==  [ (lam, kostkaNumber lam mu) | lam <- dominatingPartitions mu ]
+--- 
++--
+ -- This should be faster than individually computing all these Kostka numbers.
+ --
+ iteratedPieriRule :: Num coeff => [Int] -> Map Partition coeff
+@@ -305,18 +305,18 @@ iteratedPieriRule'' :: Num coeff => (Partition,coeff) -> [Int] -> Map Partition
+ iteratedPieriRule'' (plambda,coeff0) ns = worker (Map.singleton plambda coeff0) ns where
+   worker old []     = old
+   worker old (n:ns) = worker new ns where
+-    stuff = [ (coeff, pieriRule lam n) | (lam,coeff) <- Map.toList old ] 
+-    new   = foldl' f Map.empty stuff 
+-    f t0 (c,ps) = foldl' (\t p -> Map.insertWith (+) p c t) t0 ps  
++    stuff = [ (coeff, pieriRule lam n) | (lam,coeff) <- Map.toList old ]
++    new   = foldl' f Map.empty stuff
++    f t0 (c,ps) = foldl' (\t p -> Map.insertWith (+) p c t) t0 ps
+ 
+ --------------------------------------------------------------------------------
+ 
+ -- | Computes the Schur expansion of @e[n1]*e[n2]*e[n3]*...*e[nk]@ via iterating the Pieri rule.
+ -- Note: the coefficients are actually the Kostka numbers; the following is true:
+ --
+--- > Map.toList (iteratedDualPieriRule (fromPartition mu))  ==  
++-- > Map.toList (iteratedDualPieriRule (fromPartition mu))  ==
+ -- >   [ (dualPartition lam, kostkaNumber lam mu) | lam <- dominatingPartitions mu ]
+--- 
++--
+ -- This should be faster than individually computing all these Kostka numbers.
+ -- It is a tiny bit slower than 'iteratedPieriRule'.
+ --
+@@ -334,8 +334,8 @@ iteratedDualPieriRule'' :: Num coeff => (Partition,coeff) -> [Int] -> Map Partit
+ iteratedDualPieriRule'' (plambda,coeff0) ns = worker (Map.singleton plambda coeff0) ns where
+   worker old []     = old
+   worker old (n:ns) = worker new ns where
+-    stuff = [ (coeff, dualPieriRule lam n) | (lam,coeff) <- Map.toList old ] 
+-    new   = foldl' f Map.empty stuff 
+-    f t0 (c,ps) = foldl' (\t p -> Map.insertWith (+) p c t) t0 ps  
++    stuff = [ (coeff, dualPieriRule lam n) | (lam,coeff) <- Map.toList old ]
++    new   = foldl' f Map.empty stuff
++    f t0 (c,ps) = foldl' (\t p -> Map.insertWith (+) p c t) t0 ps
+ 
+ --------------------------------------------------------------------------------
+diff --git a/Math/Combinat/Tableaux/GelfandTsetlin/Cone.hs b/Math/Combinat/Tableaux/GelfandTsetlin/Cone.hs
+index efc51f8..7f91afc 100644
+--- a/Math/Combinat/Tableaux/GelfandTsetlin/Cone.hs
++++ b/Math/Combinat/Tableaux/GelfandTsetlin/Cone.hs
+@@ -1,55 +1,55 @@
+ 
+ -- TODO: better name?
+ 
+--- | This module contains a function to generate (equivalence classes of) 
+--- triangular tableaux of size /k/, strictly increasing to the right and 
++-- | This module contains a function to generate (equivalence classes of)
++-- triangular tableaux of size /k/, strictly increasing to the right and
+ -- to the bottom. For example
+--- 
+--- >  1  
+--- >  2  4  
+--- >  3  5  8  
+--- >  6  7  9  10 
++--
++-- >  1
++-- >  2  4
++-- >  3  5  8
++-- >  6  7  9  10
+ --
+ -- is such a tableau of size 4.
+ -- The numbers filling a tableau always consist of an interval @[1..c]@;
+ -- @c@ is called the /content/ of the tableaux. There is a unique tableau
+ -- of minimal content @2k-1@:
+ --
+--- >  1  
+--- >  2  3  
+--- >  3  4  5 
+--- >  4  5  6  7 
+--- 
++-- >  1
++-- >  2  3
++-- >  3  4  5
++-- >  4  5  6  7
++--
+ -- Let us call the tableaux with maximal content (that is, @m = binomial (k+1) 2@)
+ -- /standard/. The number of such standard tableaux are
+ --
+ -- > 1, 1, 2, 12, 286, 33592, 23178480, ...
+ --
+--- OEIS:A003121, \"Strict sense ballot numbers\", 
++-- OEIS:A003121, \"Strict sense ballot numbers\",
+ -- <https://oeis.org/A003121>.
+ --
+--- See 
++-- See
+ -- R. M. Thrall, A combinatorial problem, Michigan Math. J. 1, (1952), 81-88.
+--- 
++--
+ -- The number of tableaux with content @c=m-d@ are
+--- 
++--
+ -- >  d=  |     0      1      2      3    ...
+ -- > -----+----------------------------------------------
+ -- >  k=2 |     1
+ -- >  k=3 |     2      1
+ -- >  k=4 |    12     18      8      1
+ -- >  k=5 |   286    858   1001    572    165     22     1
+--- >  k=6 | 33592 167960 361114 436696 326196 155584 47320 8892 962 52 1 
++-- >  k=6 | 33592 167960 361114 436696 326196 155584 47320 8892 962 52 1
+ --
+ -- We call these \"GT simplex tableaux\" (in the lack of a better name), since
+--- they are in bijection with the simplicial cones in a canonical simplicial 
++-- they are in bijection with the simplicial cones in a canonical simplicial
+ -- decompositions of the Gelfand-Tsetlin cones (the content corresponds
+ -- to the dimension), which encode the combinatorics of Kostka numbers.
+ --
+ 
+ {-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
+ module Math.Combinat.Tableaux.GelfandTsetlin.Cone
+-  ( 
++  (
+     -- * Types
+     Tableau
+   , Tri(..)
+@@ -68,14 +68,14 @@ module Math.Combinat.Tableaux.GelfandTsetlin.Cone
+   , gtSimplexTableaux
+   , _gtSimplexTableaux
+   , countGTSimplexTableaux
+-  ) 
++  )
+   where
+ 
+ --------------------------------------------------------------------------------
+ 
+ import Data.Ix
+ import Data.Ord
+-import Data.List
++import Data.List (groupBy)
+ 
+ import Control.Monad
+ import Control.Monad.ST
+@@ -101,23 +101,23 @@ binom2 n = (n*(n-1)) `div` 2
+ index' :: Tri -> Int
+ index' (Tri (i,j)) = binom2 i + j - 1
+ 
+--- it should be (1+8*m), 
++-- it should be (1+8*m),
+ -- the 2 is a hack to be safe with the floating point stuff
+-deIndex' :: Int -> Tri 
++deIndex' :: Int -> Tri
+ deIndex' m = Tri ( i+1 , m - binom2 (i+1) + 1 ) where
+-  i = ( (floor.sqrt.(fromIntegral::Int->Double)) (2+8*m) - 1 ) `div` 2  
++  i = ( (floor.sqrt.(fromIntegral::Int->Double)) (2+8*m) - 1 ) `div` 2
+ 
+ instance Ix Tri where
+-  index   (a,b) x = index' x - index' a 
++  index   (a,b) x = index' x - index' a
+   inRange (a,b) x = (u<=j && j<=v) where
+-    u = index' a 
++    u = index' a
+     v = index' b
+     j = index' x
+-  range     (a,b) = map deIndex' [ index' a .. index' b ] 
+-  rangeSize (a,b) = index' b - index' a + 1 
++  range     (a,b) = map deIndex' [ index' a .. index' b ]
++  rangeSize (a,b) = index' b - index' a + 1
+ 
+ triangularArrayUnsafe :: Tableau a -> TriangularArray a
+-triangularArrayUnsafe tableau = listArray (Tri (1,1),Tri (k,k)) (concat tableau) 
++triangularArrayUnsafe tableau = listArray (Tri (1,1),Tri (k,k)) (concat tableau)
+   where k = length tableau
+ 
+ fromTriangularArray :: TriangularArray a -> Tableau a
+@@ -130,7 +130,7 @@ asciiTriangularArray :: Show a => TriangularArray a -> ASCII
+ asciiTriangularArray = asciiTableau . fromTriangularArray
+ 
+ asciiTableau :: Show a => Tableau a -> ASCII
+-asciiTableau xxs = tabulate (HRight,VTop) (HSepSpaces 1, VSepEmpty) 
++asciiTableau xxs = tabulate (HRight,VTop) (HSepSpaces 1, VSepEmpty)
+                  $ (map . map) asciiShow
+                  $ xxs
+ 
+@@ -145,8 +145,8 @@ instance Show a => DrawASCII (TriangularArray a) where
+ -- "fractional fillings"
+ data Hole = Hole Int Int deriving (Eq,Ord,Show)
+ 
+-type ReverseTableau      = [[Int ]] 
+-type ReverseHoleTableau  = [[Hole]]      
++type ReverseTableau      = [[Int ]]
++type ReverseHoleTableau  = [[Hole]]
+ 
+ toHole :: Int -> Hole
+ toHole k = Hole k 0
+@@ -164,26 +164,26 @@ gtSimplexContent arr = max (arr ! (fst (bounds arr))) (arr ! (snd (bounds arr)))
+ 
+ _gtSimplexContent :: Tableau Int -> Int
+ _gtSimplexContent t = max (head $ head t) (last $ last t)   -- we also handle inverted tableau
+- 
+-normalize :: ReverseHoleTableau -> TriangularArray Int 
++
++normalize :: ReverseHoleTableau -> TriangularArray Int
+ normalize = snd . normalize'
+ 
+ -- returns ( content , tableau )
+-normalize' :: ReverseHoleTableau -> ( Int , TriangularArray Int )   
++normalize' :: ReverseHoleTableau -> ( Int , TriangularArray Int )
+ normalize' holes = ( c , array (Tri (1,1), Tri (k,k)) xys ) where
+   k = length holes
+   c = length sorted
+   xys = concat $ zipWith hs [1..] sorted
+   hs a xs     = map (h a) xs
+-  h  a (ij,_) = (Tri ij , a)  
++  h  a (ij,_) = (Tri ij , a)
+   sorted = groupSortBy snd (concat withPos)
+-  withPos = zipWith f [1..] (reverseTableau holes) 
+-  f i xs = zipWith (g i) [1..] xs 
+-  g i j hole = ((i,j),hole) 
++  withPos = zipWith f [1..] (reverseTableau holes)
++  f i xs = zipWith (g i) [1..] xs
++  g i j hole = ((i,j),hole)
+ 
+ --------------------------------------------------------------------------------
+ 
+-startHole :: [Hole] -> [Int] -> Hole 
++startHole :: [Hole] -> [Int] -> Hole
+ startHole (t:ts) (p:ps) = max t (toHole p)
+ startHole (t:ts) []     = t
+ startHole []     (p:ps) = toHole p
+@@ -191,17 +191,17 @@ startHole []     []     = error "startHole"
+ 
+ -- c is the "content" of the small tableau
+ enumHoles :: Int -> Hole -> [Hole]
+-enumHoles c start@(Hole k l) 
+-  = nextHole start 
++enumHoles c start@(Hole k l)
++  = nextHole start
+   : [ Hole i 0 | i <- [k+1..c] ] ++ [ Hole i 1 | i <- [k+1..c] ]
+ 
+ helper :: Int -> [Int] -> [Hole] -> [[Hole]]
+-helper c [] this = [[]] 
+-helper c prev@(p:ps) this = 
++helper c [] this = [[]]
++helper c prev@(p:ps) this =
+   [ t:rest | t <- enumHoles c (startHole this prev), rest <- helper c ps (t:this) ]
+ 
+ newLines' :: Int -> [Int] -> [[Hole]]
+-newLines' c lastReversed = helper c last []  
++newLines' c lastReversed = helper c last []
+   where
+     top  = head lastReversed
+     last = reverse (top : lastReversed)
+@@ -230,32 +230,32 @@ countGTSimplexTableaux :: Int -> [Int]
+ countGTSimplexTableaux = elems . sizes'
+ 
+ sizes' :: Int -> UArray Int Int
+-sizes' k = 
++sizes' k =
+   runSTUArray $ do
+     let (a,b) = ( 2*k-1 , binom2 (k+1) )
+-    ar <- newArray (a,b) 0 :: ST s (STUArray s Int Int)   
+-    mapM_ (worker ar) $ gtSimplexTableaux k 
++    ar <- newArray (a,b) 0 :: ST s (STUArray s Int Int)
++    mapM_ (worker ar) $ gtSimplexTableaux k
+     return ar
+   where
+     worker :: STUArray s Int Int -> TriangularArray Int -> ST s ()
+     worker ar t = do
+-      let c = gtSimplexContent t 
+-      n <- readArray ar c  
++      let c = gtSimplexContent t
++      n <- readArray ar c
+       writeArray ar c (n+1)
+-     
++
+ --------------------------------------------------------------------------------
+ 
+ -- | We can flip the numbers in the tableau so that the interval @[1..c]@ becomes
+ -- @[c..1]@. This way we a get a maybe more familiar form, when each row and each
+ -- column is strictly /decreasing/ (to the right and to the bottom).
+-invertGTSimplexTableau :: TriangularArray Int -> TriangularArray Int 
++invertGTSimplexTableau :: TriangularArray Int -> TriangularArray Int
+ invertGTSimplexTableau t = amap f t where
+-  c = gtSimplexContent t 
+-  f x = c+1-x  
++  c = gtSimplexContent t
++  f x = c+1-x
+ 
+ _invertGTSimplexTableau :: [[Int]] -> [[Int]]
+ _invertGTSimplexTableau t = (map . map) f t where
+-  c = _gtSimplexContent t  
++  c = _gtSimplexContent t
+   f x = c+1-x
+ 
+ --------------------------------------------------------------------------------
+diff --git a/Math/Combinat/Tableaux/LittlewoodRichardson.hs b/Math/Combinat/Tableaux/LittlewoodRichardson.hs
+index a6a58e3..d5489ce 100644
+--- a/Math/Combinat/Tableaux/LittlewoodRichardson.hs
++++ b/Math/Combinat/Tableaux/LittlewoodRichardson.hs
+@@ -1,17 +1,17 @@
+ 
+ -- | The Littlewood-Richardson rule
+ 
+-module Math.Combinat.Tableaux.LittlewoodRichardson 
++module Math.Combinat.Tableaux.LittlewoodRichardson
+   ( lrCoeff , lrCoeff'
+   , lrMult
+   , lrRule  , _lrRule , lrRuleNaive
+   , lrScalar , _lrScalar
+-  ) 
++  )
+   where
+ 
+ --------------------------------------------------------------------------------
+ 
+-import Data.List
++import Data.List (findIndex, foldl')
+ import Data.Maybe
+ 
+ import Math.Combinat.Partitions.Integer
+@@ -25,32 +25,32 @@ import qualified Data.Map.Strict as Map
+ 
+ --------------------------------------------------------------------------------
+ 
+--- | Naive (very slow) reference implementation of the Littlewood-Richardson rule, based 
++-- | Naive (very slow) reference implementation of the Littlewood-Richardson rule, based
+ -- on the definition "count the semistandard skew tableaux whose row content is a lattice word"
+ --
+ lrRuleNaive :: SkewPartition -> Map Partition Int
+ lrRuleNaive skew = final where
+   n     = skewPartitionWeight skew
+-  ssst  = semiStandardSkewTableaux n skew 
++  ssst  = semiStandardSkewTableaux n skew
+   final = foldl' f Map.empty $ catMaybes [ skewTableauRowContent skew | skew <- ssst  ]
+   f old nu = Map.insertWith (+) nu 1 old
+ 
+ --------------------------------------------------------------------------------
+ -- SKEW EXPANSION
+ 
+--- | @lrRule@ computes the expansion of a skew Schur function 
++-- | @lrRule@ computes the expansion of a skew Schur function
+ -- @s[lambda\/mu]@ via the Littlewood-Richardson rule.
+ --
+--- Adapted from John Stembridge's Maple code: 
++-- Adapted from John Stembridge's Maple code:
+ -- <http://www.math.lsa.umich.edu/~jrs/software/SFexamples/LR_rule>
+ --
+ -- > lrRule (mkSkewPartition (lambda,nu)) == Map.fromList list where
+ -- >   muw  = weight lambda - weight nu
+--- >   list = [ (mu, coeff) 
+--- >          | mu <- partitions muw 
++-- >   list = [ (mu, coeff)
++-- >          | mu <- partitions muw
+ -- >          , let coeff = lrCoeff lambda (mu,nu)
+ -- >          , coeff /= 0
+--- >          ] 
++-- >          ]
+ --
+ lrRule :: SkewPartition -> Map Partition Int
+ lrRule skew = _lrRule lam mu where
+@@ -60,13 +60,13 @@ lrRule skew = _lrRule lam mu where
+ -- Schur function @s[lambda\/mu]@ via the Littlewood-Richardson rule.
+ --
+ _lrRule :: Partition -> Partition -> Map Partition Int
+-_lrRule plam@(Partition lam) pmu@(Partition mu0) = 
+-  if not (pmu `isSubPartitionOf` plam) 
++_lrRule plam@(Partition lam) pmu@(Partition mu0) =
++  if not (pmu `isSubPartitionOf` plam)
+     then Map.empty
+     else foldl' f Map.empty [ nu | (nu,_) <- fillings n diagram ]
+   where
+     f old nu = Map.insertWith (+) (Partition nu) 1 old
+-    diagram  = [ (i,j) | (i,a,b) <- reverse (zip3 [1..] lam mu) , j <- [b+1..a] ]    
++    diagram  = [ (i,j) | (i,a,b) <- reverse (zip3 [1..] lam mu) , j <- [b+1..a] ]
+     mu       = mu0 ++ repeat 0
+     n        = sum' $ zipWith (-) lam mu    -- n == length diagram
+ 
+@@ -125,24 +125,24 @@ end:
+ 
+ nextLetter :: Int -> Int -> Filling -> [Filling]
+ nextLetter lower upper (nu,lpart) = stuff where
+-  stuff = [ ( incr i shape , lpart++[i] ) | i<-nlist ] 
+-  shape = nu ++ [0] 
++  stuff = [ ( incr i shape , lpart++[i] ) | i<-nlist ]
++  shape = nu ++ [0]
+   lb = if lower>0
+     then lpart !! (lower-1)
+     else 0
+-  ub = if upper>0 
+-    then min (length shape) (lpart !! (upper-1))  
++  ub = if upper>0
++    then min (length shape) (lpart !! (upper-1))
+     else      length shape
+ 
+-  nlist = filter (>0) $ map f [lb+1..ub] 
++  nlist = filter (>0) $ map f [lb+1..ub]
+   f j   = if j==1 || shape!!(j-2) > shape!!(j-1) then j else 0
+ 
+ {-
+   -- another nlist implementation, but doesn't seem to be faster
+   (h0:hs0) = drop lb (-666:shape)
+   nlist = go h0 hs0 [lb+1..ub] where
+-    go !lasth (h:hs) (j:js) = if j==1 || lasth > h 
+-      then j : go h hs js 
++    go !lasth (h:hs) (j:js) = if j==1 || lasth > h
++      then j : go h hs js
+       else     go h hs js
+     go _      _      []     = []
+ -}
+@@ -157,8 +157,8 @@ nextLetter lower upper (nu,lpart) = stuff where
+ 
+   -- removes tailing zeros
+   finish :: [Int] -> [Int]
+-  finish (x:xs) = if x>0 then x : finish xs else []    
+-  finish []     = [] 
++  finish (x:xs) = if x>0 then x : finish xs else []
++  finish []     = []
+ 
+ {-
+ `LR/nextletter`:=proc(T) local shape,lp,lb,ub,i,nl;
+@@ -186,7 +186,7 @@ end:
+ -- Note: This is much slower than using 'lrRule' or 'lrMult' to compute several coefficients
+ -- at the same time!
+ lrCoeff :: Partition -> (Partition,Partition) -> Int
+-lrCoeff lam (mu,nu) = 
++lrCoeff lam (mu,nu) =
+   if nu `isSubPartitionOf` lam
+     then lrScalar (mkSkewPartition (lam,nu)) (mkSkewPartition (mu,emptyPartition))
+     else 0
+@@ -198,30 +198,30 @@ lrCoeff lam (mu,nu) =
+ -- at the same time!
+ lrCoeff' :: SkewPartition -> Partition -> Int
+ lrCoeff' skew p = lrScalar skew (mkSkewPartition (p,emptyPartition))
+-  
++
+ --------------------------------------------------------------------------------
+ -- SCALAR PRODUCT
+ 
+ -- | @lrScalar (lambda\/mu) (alpha\/beta)@ computes the scalar product of the two skew
+ -- Schur functions @s[lambda\/mu]@ and @s[alpha\/beta]@ via the Littlewood-Richardson rule.
+ --
+--- Adapted from John Stembridge Maple code: 
++-- Adapted from John Stembridge Maple code:
+ -- <http://www.math.lsa.umich.edu/~jrs/software/SFexamples/LR_rule>
+ --
+ lrScalar :: SkewPartition -> SkewPartition -> Int
+ lrScalar lambdaMu alphaBeta = _lrScalar (fromSkewPartition lambdaMu) (fromSkewPartition alphaBeta)
+ 
+ _lrScalar :: (Partition,Partition) -> (Partition,Partition) -> Int
+-_lrScalar (plam  @(Partition lam  ) , pmu  @(Partition mu0)  ) 
+-         (palpha@(Partition alpha) , pbeta@(Partition beta)) = 
+-  if    not (pmu   `isSubPartitionOf` plam  ) 
+-     || not (pbeta `isSubPartitionOf` palpha) 
++_lrScalar (plam@(Partition lam  ) , pmu@(Partition mu0)  )
++         (palpha@(Partition alpha) , pbeta@(Partition beta)) =
++  if    not (pmu   `isSubPartitionOf` plam  )
++     || not (pbeta `isSubPartitionOf` palpha)
+      || (sum' lam + sum' beta) /= (sum' alpha + sum' mu0)     -- equivalent to (lambda-mu) /= (alpha-beta)
+     then 0
+-    else length $ fillings' n diagram (alpha,beta) 
++    else length $ fillings' n diagram (alpha,beta)
+   where
+     f old nu = Map.insertWith (+) (Partition nu) 1 old
+-    diagram  = [ (i,j) | (i,a,b) <- reverse (zip3 [1..] lam mu) , j <- [b+1..a] ]    
++    diagram  = [ (i,j) | (i,a,b) <- reverse (zip3 [1..] lam mu) , j <- [b+1..a] ]
+     mu       = mu0 ++ repeat 0
+     n        = sum' $ zipWith (-) lam mu    -- n == length diagram
+ 
+@@ -249,7 +249,7 @@ end;
+ fillings' :: Int -> Diagram -> ([Int],[Int]) -> [Filling]
+ fillings' _         []                     (alpha,beta) = [ (beta,[]) ]
+ fillings' n diagram@((x,y):rest) alphaBeta@(alpha,beta) = stuff where
+-  stuff = concatMap (nextLetter' lower upper alpha) (fillings' (n-1) rest alphaBeta) 
++  stuff = concatMap (nextLetter' lower upper alpha) (fillings' (n-1) rest alphaBeta)
+   upper = case findIndex (==(x  ,y+1)) diagram of { Just j -> n-j ; Nothing -> 0 }
+   lower = case findIndex (==(x-1,y  )) diagram of { Just j -> n-j ; Nothing -> 0 }
+ 
+@@ -275,19 +275,19 @@ end:
+ 
+ nextLetter' :: Int -> Int -> [Int] -> Filling -> [Filling]
+ nextLetter' lower upper alpha (nu,lpart) = stuff where
+-  stuff = [ ( incr i shape , lpart++[i] ) | i<-nlist ] 
+-  shape = nu ++ [0] 
++  stuff = [ ( incr i shape , lpart++[i] ) | i<-nlist ]
++  shape = nu ++ [0]
+   lb = if lower>0
+     then lpart !! (lower-1)
+     else 0
+-  ub1 = if upper>0 
+-    then min (length shape) (lpart !! (upper-1))  
++  ub1 = if upper>0
++    then min (length shape) (lpart !! (upper-1))
+     else      length shape
+   ub = min (length alpha) ub1
+-  nlist = filter (>0) $ map f [lb+1..ub] 
++  nlist = filter (>0) $ map f [lb+1..ub]
+   f j   = if (        shape!!(j-1) < alpha!!(j-1)) &&
+-             (j==1 || shape!!(j-2) > shape!!(j-1)) 
+-          then j 
++             (j==1 || shape!!(j-2) > shape!!(j-1))
++          then j
+           else 0
+ 
+   -- increments the i-th element (starting from 1)
+@@ -300,8 +300,8 @@ nextLetter' lower upper alpha (nu,lpart) = stuff where
+ 
+   -- removes tailing zeros
+   finish :: [Int] -> [Int]
+-  finish (x:xs) = if x>0 then x : finish xs else []    
+-  finish []     = [] 
++  finish (x:xs) = if x>0 then x : finish xs else []
++  finish []     = []
+ 
+ {-
+ `LR/nextletter`:=proc(T) local shape,lp,lb,ub,i,nl;
+@@ -332,11 +332,11 @@ type Part = [Int]
+ --
+ -- > lrMult mu nu == Map.fromList list where
+ -- >   lamw = weight nu + weight mu
+--- >   list = [ (lambda, coeff) 
+--- >          | lambda <- partitions lamw 
++-- >   list = [ (lambda, coeff)
++-- >          | lambda <- partitions lamw
+ -- >          , let coeff = lrCoeff lambda (mu,nu)
+ -- >          , coeff /= 0
+--- >          ] 
++-- >          ]
+ --
+ lrMult :: Partition -> Partition -> Map Partition Int
+ lrMult pmu@(Partition mu) pnu@(Partition nu) = result where
+@@ -362,19 +362,19 @@ addRowOf pcols part = go 0 pcols part [] where
+   go !lb []        p ncols = [(reverse ncols , p)]
+   go !lb (!ub:ubs) p ncols = concat [ go col ubs (addBox ij p) (col:ncols) | ij@(row,col) <- newBoxes (lb+1) ub p ]
+ 
+--- | Returns the (row,column) pairs of the new boxes which 
++-- | Returns the (row,column) pairs of the new boxes which
+ -- can be added to the given partition with the given column bounds
+--- and the 1-Rieri rule 
++-- and the 1-Rieri rule
+ newBoxes :: Int -> Int -> Part -> [(Int,Int)]
+ newBoxes lb ub part = reverse $ go [1..] part (headOrZero part + 1) where
+   go (!i:_ ) []      !lp
+     | lb <= 1 && 1 <= ub && lp > 0  =  [(i,1)]
+     | otherwise                     =  []
+-  go (!i:is) (!j:js) !lp 
++  go (!i:is) (!j:js) !lp
+     | j1 <  lb            =  []
+-    | j1 <= ub && lp > j  =  (i,j1) : go is js j       
++    | j1 <= ub && lp > j  =  (i,j1) : go is js j
+     | otherwise           =           go is js j
+-    where 
++    where
+       j1 = j+1
+ 
+ -- | Adds a box to a partition
+@@ -383,9 +383,9 @@ addBox (k,_) part = go 1 part where
+   go !i (p:ps) = if i==k then (p+1):ps else p : go (i+1) ps
+   go !i []     = if i==k then [1] else error "addBox: shouldn't happen"
+ 
+--- | Safe head defaulting to zero           
++-- | Safe head defaulting to zero
+ headOrZero :: [Int] -> Int
+-headOrZero xs = case xs of 
++headOrZero xs = case xs of
+   (!x:_) -> x
+   []     -> 0
+ 
+@@ -396,4 +396,4 @@ diffSeq = go where
+   go [p]          = [p]
+   go []           = []
+ 
+---------------------------------------------------------------------------------  
++--------------------------------------------------------------------------------
+diff --git a/Math/Combinat/Tableaux/Skew.hs b/Math/Combinat/Tableaux/Skew.hs
+index 3902d1b..72c22f6 100644
+--- a/Math/Combinat/Tableaux/Skew.hs
++++ b/Math/Combinat/Tableaux/Skew.hs
+@@ -12,7 +12,7 @@ module Math.Combinat.Tableaux.Skew where
+ 
+ --------------------------------------------------------------------------------
+ 
+-import Data.List
++import Data.List (sort, transpose)
+ 
+ import Math.Combinat.Classes
+ import Math.Combinat.Partitions.Integer
+@@ -36,7 +36,7 @@ newtype SkewTableau a = SkewTableau [(Int,[a])] deriving (Eq,Ord,Show)
+ instance Functor SkewTableau where
+   fmap f (SkewTableau t) = SkewTableau [ (a, map f xs) | (a,xs) <- t ]
+ 
+--- | The shape of a skew tableau 
++-- | The shape of a skew tableau
+ skewTableauShape :: SkewTableau a -> SkewPartition
+ skewTableauShape (SkewTableau list) = SkewPartition [ (o,length xs) | (o,xs) <- list ]
+ 
+@@ -56,14 +56,14 @@ instance HasWeight (SkewTableau a) where
+ dualSkewTableau :: forall a. SkewTableau a -> SkewTableau a
+ dualSkewTableau (SkewTableau axs) = SkewTableau (go axs) where
+ 
+-  go []  = []  
++  go []  = []
+   go axs = case sub 0 axs of
+     (0,[]) -> []
+     this   -> this : go (strip axs)
+ 
+   strip :: [(Int,[a])] -> [(Int,[a])]
+   strip []            = []
+-  strip ((a,xs):rest) = if a>0 
++  strip ((a,xs):rest) = if a>0
+     then (a-1,xs) : strip rest
+     else case xs of
+       []     -> []
+@@ -73,20 +73,20 @@ dualSkewTableau (SkewTableau axs) = SkewTableau (go axs) where
+ 
+   sub :: Int -> [(Int,[a])] -> (Int,[a])
+   sub !b [] = (b,[])
+-  sub !b ((a,this):rest) = if a>0 
+-    then sub (b+1) rest  
+-    else (b,ys) where      
++  sub !b ((a,this):rest) = if a>0
++    then sub (b+1) rest
++    else (b,ys) where
+       ys = map head $ takeWhile (not . null) (this : map snd rest)
+ 
+ {-
+ test_dualSkewTableau :: [SkewTableau Int]
+-test_dualSkewTableau = bad where 
++test_dualSkewTableau = bad where
+   ps = allPartitions 11
+-  bad = [ st 
+-        | p<-ps , q<-ps 
+-        , (q `isSubPartitionOf` p) 
+-        , let sp = mkSkewPartition (p,q) 
+-        , let st = fillSkewPartitionWithRowWord sp [1..] 
++  bad = [ st
++        | p<-ps , q<-ps
++        , (q `isSubPartitionOf` p)
++        , let sp = mkSkewPartition (p,q)
++        , let st = fillSkewPartitionWithRowWord sp [1..]
+         , dualSkewTableau (dualSkewTableau st) /= st
+         ]
+ -}
+@@ -110,36 +110,36 @@ isSemiStandardSkewTableau st@(SkewTableau axs) = weak && strict where
+ isStandardSkewTableau :: SkewTableau Int -> Bool
+ isStandardSkewTableau st = isSemiStandardSkewTableau st && sort (skewTableauRowWord st) == [1..n] where
+   n = skewTableauWeight st
+-  
++
+ --------------------------------------------------------------------------------
+ 
+ -- | All semi-standard skew tableaux filled with the numbers @[1..n]@
+ semiStandardSkewTableaux :: Int -> SkewPartition -> [SkewTableau Int]
+ semiStandardSkewTableaux n (SkewPartition abs) = map SkewTableau stuff where
+ 
+-  stuff = worker as bs ds (repeat 1) 
++  stuff = worker as bs ds (repeat 1)
+   (as,bs) = unzip abs
+   ds = _diffSequence as
+-  
++
+   -- | @worker inner outerMinusInner innerdiffs lowerbound
+   worker :: [Int] -> [Int] -> [Int] -> [Int] -> [[(Int,[Int])]]
+-  worker (a:as) (b:bs) (d:ds) lb = [ (a,this):rest 
+-                                   | this <- row b 1 lb 
+-                                   , let lb' = (replicate d 1 ++ map (+1) this) 
+-                                   , rest <- worker as bs ds lb' ] 
++  worker (a:as) (b:bs) (d:ds) lb = [ (a,this):rest
++                                   | this <- row b 1 lb
++                                   , let lb' = (replicate d 1 ++ map (+1) this)
++                                   , rest <- worker as bs ds lb' ]
+   worker []     _      _      _  = [ [] ]
+ 
+   -- @row length minimum lowerbound@
+   row 0  _  _       = [[]]
+   row _  _  []      = []
+-  row !k !m (!a:as) = [ x:xs | x <- [(max a m)..n] , xs <- row (k-1) x as ] 
++  row !k !m (!a:as) = [ x:xs | x <- [(max a m)..n] , xs <- row (k-1) x as ]
+ 
+ {-
+ -- | from a sequence @[a1,a2,..,an]@ computes the sequence of differences
+ -- @[a1-a2,a2-a3,...,an-0]@
+ diffSequence :: [Int] -> [Int]
+ diffSequence = go where
+-  go (x:ys@(y:_)) = (x-y) : go ys 
++  go (x:ys@(y:_)) = (x-y) : go ys
+   go [x] = [x]
+   go []  = []
+ -}
+@@ -151,11 +151,11 @@ diffSequence = go where
+ asciiSkewTableau :: Show a => SkewTableau a -> ASCII
+ asciiSkewTableau = asciiSkewTableau' "." EnglishNotation
+ 
+-asciiSkewTableau' 
++asciiSkewTableau'
+   :: Show a
+   => String               -- ^ string representing the elements of the inner (unfilled) partition
+   -> PartitionConvention  -- ^ orientation
+-  -> SkewTableau a 
++  -> SkewTableau a
+   -> ASCII
+ asciiSkewTableau' innerstr orient (SkewTableau axs) = tabulate (HRight,VTop) (HSepSpaces 1, VSepEmpty) stuff where
+   stuff = case orient of
+@@ -179,16 +179,16 @@ skewTableauRowWord (SkewTableau axs) = concatMap (reverse . snd) axs
+ skewTableauColumnWord :: SkewTableau a -> [a]
+ skewTableauColumnWord = skewTableauRowWord . dualSkewTableau
+ 
+--- | Fills a skew partition with content, in row word order 
++-- | Fills a skew partition with content, in row word order
+ fillSkewPartitionWithRowWord :: SkewPartition -> [a] -> SkewTableau a
+ fillSkewPartitionWithRowWord (SkewPartition abs) xs = SkewTableau $ go abs xs where
+   go ((b,a):rest) xs = let (ys,zs) = splitAt a xs in (b,reverse ys) : go rest zs
+   go []           xs = []
+ 
+--- | Fills a skew partition with content, in column word order 
++-- | Fills a skew partition with content, in column word order
+ fillSkewPartitionWithColumnWord :: SkewPartition -> [a] -> SkewTableau a
+-fillSkewPartitionWithColumnWord shape content 
+-  = dualSkewTableau 
++fillSkewPartitionWithColumnWord shape content
++  = dualSkewTableau
+   $ fillSkewPartitionWithRowWord (dualSkewPartition shape) content
+ 
+ --------------------------------------------------------------------------------
+@@ -202,7 +202,7 @@ skewTableauRowContent (SkewTableau axs) = go Map.empty rowword where
+   finish table = Partition (f 1) where
+     f !i = case lkp i of
+       0 -> []
+-      y -> y : f (i+1) 
++      y -> y : f (i+1)
+     lkp j = case Map.lookup j table of
+       Just k  -> k
+       Nothing -> 0
+diff --git a/Math/Combinat/Trees/Binary.hs b/Math/Combinat/Trees/Binary.hs
+index 0e4718f..bc4a8fa 100644
+--- a/Math/Combinat/Trees/Binary.hs
++++ b/Math/Combinat/Trees/Binary.hs
+@@ -8,27 +8,27 @@
+ --
+ 
+ {-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
+-module Math.Combinat.Trees.Binary 
++module Math.Combinat.Trees.Binary
+   ( -- * Types
+     BinTree(..)
+-  , leaf 
++  , leaf
+   , graft
+   , BinTree'(..)
+   , forgetNodeDecorations
+   , Paren(..)
+   , parenthesesToString
+-  , stringToParentheses  
++  , stringToParentheses
+   , numberOfNodes
+   , numberOfLeaves
+     -- * Conversion to rose trees (@Data.Tree@)
+   , toRoseTree , toRoseTree'
+-  , module Data.Tree 
++  , module Data.Tree
+     -- * Enumerate leaves
+-  , enumerateLeaves_ 
+-  , enumerateLeaves 
++  , enumerateLeaves_
++  , enumerateLeaves
+   , enumerateLeaves'
+     -- * Nested parentheses
+-  , nestedParentheses 
++  , nestedParentheses
+   , randomNestedParentheses
+   , nthNestedParentheses
+   , countNestedParentheses
+@@ -48,7 +48,7 @@ module Math.Combinat.Trees.Binary
+   , graphvizDotBinTree
+   , graphvizDotBinTree'
+   , graphvizDotForest
+-  , graphvizDotTree  
++  , graphvizDotTree
+     -- * Bijections
+   , forestToNestedParentheses
+   , forestToBinaryTree
+@@ -58,7 +58,7 @@ module Math.Combinat.Trees.Binary
+   , nestedParenthesesToBinaryTreeUnsafe
+   , binaryTreeToForest
+   , binaryTreeToNestedParentheses
+-  ) 
++  )
+   where
+ 
+ --------------------------------------------------------------------------------
+@@ -71,7 +71,6 @@ import Data.Array
+ import Data.Array.ST
+ import Data.Array.Unsafe
+ 
+-import Data.List
+ import Data.Tree (Tree(..),Forest(..))
+ 
+ import Data.Monoid
+@@ -82,10 +81,10 @@ import System.Random
+ 
+ import Math.Combinat.Numbers (factorial,binomial)
+ 
+-import Math.Combinat.Trees.Graphviz 
+-  ( Dot 
+-  , graphvizDotBinTree , graphvizDotBinTree' 
+-  , graphvizDotForest  , graphvizDotTree 
++import Math.Combinat.Trees.Graphviz
++  ( Dot
++  , graphvizDotBinTree , graphvizDotBinTree'
++  , graphvizDotForest  , graphvizDotTree
+   )
+ import Math.Combinat.Classes
+ import Math.Combinat.Helper
+@@ -107,11 +106,11 @@ leaf = Leaf ()
+ graft :: BinTree (BinTree a) -> BinTree a
+ graft = go where
+   go (Branch l r) = Branch (go l) (go r)
+-  go (Leaf   t  ) = t 
++  go (Leaf   t  ) = t
+ 
+ --------------------------------------------------------------------------------
+ 
+--- | A binary tree with leaves and internal nodes decorated 
++-- | A binary tree with leaves and internal nodes decorated
+ -- with types @a@ and @b@, respectively.
+ data BinTree' a b
+   = Branch' (BinTree' a b) b (BinTree' a b)
+@@ -121,7 +120,7 @@ data BinTree' a b
+ forgetNodeDecorations :: BinTree' a b -> BinTree a
+ forgetNodeDecorations = go where
+   go (Branch' left _ right) = Branch (go left) (go right)
+-  go (Leaf'   decor       ) = Leaf decor 
++  go (Leaf'   decor       ) = Leaf decor
+ 
+ --------------------------------------------------------------------------------
+ 
+@@ -133,7 +132,7 @@ instance HasNumberOfNodes (BinTree a) where
+ instance HasNumberOfLeaves (BinTree a) where
+   numberOfLeaves = go where
+     go (Leaf   _  ) = 1
+-    go (Branch l r) = go l + go r 
++    go (Branch l r) = go l + go r
+ 
+ 
+ instance HasNumberOfNodes (BinTree' a b) where
+@@ -144,7 +143,7 @@ instance HasNumberOfNodes (BinTree' a b) where
+ instance HasNumberOfLeaves (BinTree' a b) where
+   numberOfLeaves = go where
+     go (Leaf'   _    ) = 1
+-    go (Branch' l _ r) = go l + go r 
++    go (Branch' l _ r) = go l + go r
+ 
+ --------------------------------------------------------------------------------
+ -- * Enumerate leaves
+@@ -178,28 +177,28 @@ enumerateLeaves = snd . enumerateLeaves'
+ toRoseTree :: BinTree a -> Tree (Maybe a)
+ toRoseTree = go where
+   go (Branch t1 t2) = Node Nothing  [go t1, go t2]
+-  go (Leaf x)       = Node (Just x) [] 
++  go (Leaf x)       = Node (Just x) []
+ 
+ toRoseTree' :: BinTree' a b -> Tree (Either b a)
+ toRoseTree' = go where
+   go (Branch' t1 y t2) = Node (Left  y) [go t1, go t2]
+-  go (Leaf' x)         = Node (Right x) [] 
+-  
++  go (Leaf' x)         = Node (Right x) []
++
+ --------------------------------------------------------------------------------
+ -- instances
+-  
++
+ instance Functor BinTree where
+   fmap f = go where
+     go (Branch left right) = Branch (go left) (go right)
+     go (Leaf x) = Leaf (f x)
+-  
++
+ instance Foldable BinTree where
+   foldMap f = go where
+     go (Leaf x) = f x
+-    go (Branch left right) = (go left) `mappend` (go right)  
++    go (Branch left right) = (go left) `mappend` (go right)
+ 
+ instance Traversable BinTree where
+-  traverse f = go where 
++  traverse f = go where
+     go (Leaf x) = Leaf <$> f x
+     go (Branch left right) = Branch <$> go left <*> go right
+ 
+@@ -213,14 +212,14 @@ instance Monad BinTree where
+   return    = Leaf
+   (>>=) t f = go t where
+     go (Branch l r) = Branch (go l) (go r)
+-    go (Leaf   y  ) = f y 
++    go (Leaf   y  ) = f y
+ 
+ --------------------------------------------------------------------------------
+ -- * Nested parentheses
+ 
+-data Paren 
+-  = LeftParen 
+-  | RightParen 
++data Paren
++  = LeftParen
++  | RightParen
+   deriving (Eq,Ord,Show,Read)
+ 
+ parenToChar :: Paren -> Char
+@@ -244,29 +243,29 @@ stringToParentheses (x:xs) = p : stringToParentheses xs where
+ forestToNestedParentheses :: Forest a -> [Paren]
+ forestToNestedParentheses = forest where
+   -- forest :: Forest a -> [Paren]
+-  forest = concatMap tree 
++  forest = concatMap tree
+   -- tree :: Tree a -> [Paren]
+   tree (Node _ sf) = LeftParen : forest sf ++ [RightParen]
+ 
+ forestToBinaryTree :: Forest a -> BinTree ()
+ forestToBinaryTree = forest where
+   -- forest :: Forest a -> BinTree ()
+-  forest = foldr Branch leaf . map tree 
++  forest = foldr Branch leaf . map tree
+   -- tree :: Tree a -> BinTree ()
+   tree (Node _ sf) = case sf of
+     [] -> leaf
+-    _  -> forest sf 
+-   
++    _  -> forest sf
++
+ nestedParenthesesToForest :: [Paren] -> Maybe (Forest ())
+-nestedParenthesesToForest ps = 
+-  case parseForest ps of 
++nestedParenthesesToForest ps =
++  case parseForest ps of
+     (rest,forest) -> case rest of
+       [] -> Just forest
+       _  -> Nothing
+-  where  
++  where
+     parseForest :: [Paren] -> ( [Paren] , Forest () )
+     parseForest ps = unfoldEither parseTree ps
+-    parseTree :: [Paren] -> Either [Paren] ( [Paren] , Tree () )  
++    parseTree :: [Paren] -> Either [Paren] ( [Paren] , Tree () )
+     parseTree orig@(LeftParen:ps) = let (rest,ts) = parseForest ps in case rest of
+       (RightParen:qs) -> Right (qs, Node () ts)
+       _ -> Left orig
+@@ -276,20 +275,20 @@ nestedParenthesesToForestUnsafe :: [Paren] -> Forest ()
+ nestedParenthesesToForestUnsafe = fromJust . nestedParenthesesToForest
+ 
+ nestedParenthesesToBinaryTree :: [Paren] -> Maybe (BinTree ())
+-nestedParenthesesToBinaryTree ps = 
+-  case parseForest ps of 
++nestedParenthesesToBinaryTree ps =
++  case parseForest ps of
+     (rest,forest) -> case rest of
+       [] -> Just forest
+       _  -> Nothing
+-  where  
++  where
+     parseForest :: [Paren] -> ( [Paren] , BinTree () )
+     parseForest ps = let (rest,ts) = unfoldEither parseTree ps in (rest , foldr Branch leaf ts)
+-    parseTree :: [Paren] -> Either [Paren] ( [Paren] , BinTree () )  
++    parseTree :: [Paren] -> Either [Paren] ( [Paren] , BinTree () )
+     parseTree orig@(LeftParen:ps) = let (rest,ts) = parseForest ps in case rest of
+       (RightParen:qs) -> Right (qs, ts)
+       _ -> Left orig
+     parseTree qs = Left qs
+-    
++
+ nestedParenthesesToBinaryTreeUnsafe :: [Paren] -> BinTree ()
+ nestedParenthesesToBinaryTreeUnsafe = fromJust . nestedParenthesesToBinaryTree
+ 
+@@ -308,7 +307,7 @@ binaryTreeToForest = worker where
+ 
+ -- | Generates all sequences of nested parentheses of length @2n@ in
+ -- lexigraphic order.
+--- 
++--
+ -- Synonym for 'fasc4A_algorithm_P'.
+ --
+ nestedParentheses :: Int -> [[Paren]]
+@@ -326,80 +325,80 @@ countNestedParentheses :: Int -> Integer
+ countNestedParentheses = countBinaryTrees
+ 
+ -- | Generates all sequences of nested parentheses of length 2n.
+--- Order is lexicographical (when right parentheses are considered 
++-- Order is lexicographical (when right parentheses are considered
+ -- smaller then left ones).
+ -- Based on \"Algorithm P\" in Knuth, but less efficient because of
+ -- the \"idiomatic\" code.
+ fasc4A_algorithm_P :: Int -> [[Paren]]
+ fasc4A_algorithm_P 0 = [[]]
+ fasc4A_algorithm_P 1 = [[LeftParen,RightParen]]
+-fasc4A_algorithm_P n = unfold next ( start , [] ) where 
++fasc4A_algorithm_P n = unfold next ( start , [] ) where
+   start = concat $ replicate n [RightParen,LeftParen]  -- already reversed!
+-   
++
+   next :: ([Paren],[Paren]) -> ( [Paren] , Maybe ([Paren],[Paren]) )
+   next ( (a:b:ls) , [] ) = next ( ls , b:a:[] )
+   next ( lls@(l:ls) , rrs@(r:rs) ) = ( visit , new ) where
+     visit = reverse lls ++ rrs
+-    new = 
+-      {- debug (reverse ls,l,r,rs) $ -} 
+-      case l of 
++    new =
++      {- debug (reverse ls,l,r,rs) $ -}
++      case l of
+         RightParen -> Just ( ls , LeftParen:RightParen:rs )
+-        LeftParen  -> 
++        LeftParen  ->
+           {- debug ("---",reverse ls,l,r,rs) $ -}
+-          findj ( lls , [] ) ( reverse (RightParen:rs) , [] ) 
++          findj ( lls , [] ) ( reverse (RightParen:rs) , [] )
+   next _ = error "fasc4A_algorithm_P: fatal error shouldn't happen"
+ 
+   findj :: ([Paren],[Paren]) -> ([Paren],[Paren]) -> Maybe ([Paren],[Paren])
+   findj ( [] , _ ) _ = Nothing
+-  findj ( lls@(l:ls) , rs) ( xs , ys ) = 
++  findj ( lls@(l:ls) , rs) ( xs , ys ) =
+     {- debug ((reverse ls,l,rs),(reverse xs,ys)) $ -}
+     case l of
+       LeftParen  -> case xs of
+         (a:_:as) -> findj ( ls, RightParen:rs ) ( as , LeftParen:a:ys )
+-        _ -> findj ( lls, [] ) ( reverse rs ++ xs , ys) 
++        _ -> findj ( lls, [] ) ( reverse rs ++ xs , ys)
+       RightParen -> Just ( reverse ys ++ xs ++ reverse (LeftParen:rs) ++ ls , [] )
+   findj _ _ = error "fasc4A_algorithm_P: fatal error shouldn't happen"
+-    
+--- | Generates a uniformly random sequence of nested parentheses of length 2n.    
++
++-- | Generates a uniformly random sequence of nested parentheses of length 2n.
+ -- Based on \"Algorithm W\" in Knuth.
+ fasc4A_algorithm_W :: RandomGen g => Int -> g -> ([Paren],g)
+ fasc4A_algorithm_W n' rnd = worker (rnd,n,n,[]) where
+-  n = fromIntegral n' :: Integer  
+-  -- the numbers we use are of order n^2, so for n >> 2^16 
++  n = fromIntegral n' :: Integer
++  -- the numbers we use are of order n^2, so for n >> 2^16
+   -- on a 32 bit machine, we need big integers.
+   worker :: RandomGen g => (g,Integer,Integer,[Paren]) -> ([Paren],g)
+   worker (rnd,_,0,parens) = (parens,rnd)
+-  worker (rnd,p,q,parens) = 
+-    if x<(q+1)*(q-p) 
++  worker (rnd,p,q,parens) =
++    if x<(q+1)*(q-p)
+       then worker (rnd' , p   , q-1 , LeftParen :parens)
+       else worker (rnd' , p-1 , q   , RightParen:parens)
+-    where 
++    where
+       (x,rnd') = randomR ( 0 , (q+p)*(q-p+1)-1 ) rnd
+ 
+--- | Nth sequence of nested parentheses of length 2n. 
++-- | Nth sequence of nested parentheses of length 2n.
+ -- The order is the same as in 'fasc4A_algorithm_P'.
+ -- Based on \"Algorithm U\" in Knuth.
+-fasc4A_algorithm_U 
++fasc4A_algorithm_U
+   :: Int               -- ^ n
+-  -> Integer           -- ^ N; should satisfy 1 <= N <= C(n) 
++  -> Integer           -- ^ N; should satisfy 1 <= N <= C(n)
+   -> [Paren]
+ fasc4A_algorithm_U n' bign0 = reverse $ worker (bign0,c0,n,n,[]) where
+   n = fromIntegral n' :: Integer
+-  c0 = foldl f 1 [2..n]  
+-  f c p = ((4*p-2)*c) `div` (p+1) 
++  c0 = foldl f 1 [2..n]
++  f c p = ((4*p-2)*c) `div` (p+1)
+   worker :: (Integer,Integer,Integer,Integer,[Paren]) -> [Paren]
+   worker (_   ,_,_,0,parens) = parens
+-  worker (bign,c,p,q,parens) = 
+-    if bign <= c' 
++  worker (bign,c,p,q,parens) =
++    if bign <= c'
+       then worker (bign    , c'   , p   , q-1 , RightParen:parens)
+       else worker (bign-c' , c-c' , p-1 , q   , LeftParen :parens)
+     where
+       c' = ((q+1)*(q-p)*c) `div` ((q+p)*(q-p+1))
+-  
++
+ --------------------------------------------------------------------------------
+ -- * Generating binary trees
+ 
+--- | Generates all binary trees with @n@ nodes. 
++-- | Generates all binary trees with @n@ nodes.
+ --   At the moment just a synonym for 'binaryTreesNaive'.
+ binaryTrees :: Int -> [BinTree ()]
+ binaryTrees = binaryTreesNaive
+@@ -409,24 +408,24 @@ binaryTrees = binaryTreesNaive
+ -- This is also the counting function for forests and nested parentheses.
+ countBinaryTrees :: Int -> Integer
+ countBinaryTrees n = binomial (2*n) n `div` (1 + fromIntegral n)
+-    
++
+ -- | Generates all binary trees with n nodes. The naive algorithm.
+ binaryTreesNaive :: Int -> [BinTree ()]
+ binaryTreesNaive 0 = [ leaf ]
+-binaryTreesNaive n = 
+-  [ Branch l r 
+-  | i <- [0..n-1] 
+-  , l <- binaryTreesNaive i 
+-  , r <- binaryTreesNaive (n-1-i) 
++binaryTreesNaive n =
++  [ Branch l r
++  | i <- [0..n-1]
++  , l <- binaryTreesNaive i
++  , r <- binaryTreesNaive (n-1-i)
+   ]
+ 
+ -- | Generates an uniformly random binary tree, using 'fasc4A_algorithm_R'.
+ randomBinaryTree :: RandomGen g => Int -> g -> (BinTree (), g)
+ randomBinaryTree n rnd = (tree,rnd') where
+-  (decorated,rnd') = fasc4A_algorithm_R n rnd      
++  (decorated,rnd') = fasc4A_algorithm_R n rnd
+   tree = fmap (const ()) $ forgetNodeDecorations decorated
+ 
+--- | Grows a uniformly random binary tree. 
++-- | Grows a uniformly random binary tree.
+ -- \"Algorithm R\" (Remy's procudere) in Knuth.
+ -- Nodes are decorated with odd numbers, leaves with even numbers (from the
+ -- set @[0..2n]@). Uses mutable arrays internally.
+@@ -438,11 +437,11 @@ fasc4A_algorithm_R n0 rnd = res where
+     links <- Data.Array.Unsafe.unsafeFreeze ar
+     return (toTree links, rnd')
+   toTree links = f (links!0) where
+-    f i = if odd i 
+-      then Branch' (f $ links!i) i (f $ links!(i+1)) 
+-      else Leaf' i  
++    f i = if odd i
++      then Branch' (f $ links!i) i (f $ links!(i+1))
++      else Leaf' i
+   worker :: RandomGen g => g -> Int -> STUArray s Int Int -> ST s g
+-  worker rnd n ar = do 
++  worker rnd n ar = do
+     if n > n0
+       then return rnd
+       else do
+@@ -450,14 +449,14 @@ fasc4A_algorithm_R n0 rnd = res where
+         lk <- readArray ar k
+         writeArray ar (n2-1+b) lk
+         writeArray ar k        (n2-1)
+-        worker rnd' (n+1) ar      
+-    where  
++        worker rnd' (n+1) ar
++    where
+       n2 = n+n
+       (x,rnd') = randomR (0,4*n-3) rnd
+       (k,b) = x `divMod` 2
+-      
+---------------------------------------------------------------------------------      
+--- * ASCII drawing  
++
++--------------------------------------------------------------------------------
++-- * ASCII drawing
+ 
+ -- | Draws a binary tree in ASCII, ignoring node labels.
+ --
+@@ -480,13 +479,13 @@ asciiBinaryTree_ = ASCII.asciiFromLines . fst . go where
+     spaces = [replicate s ' ']
+     ls = hConcatLines [ ls1 , spaces , ls2 ]
+     top = [ replicate (j1+m-i) ' ' ++ "/" ++ replicate (2*(i-1)) ' ' ++ "\\" | i<-[1..m] ]
+-    new = mkLinesUniformWidth $ vConcatLines [ top , ls ] 
+-        
++    new = mkLinesUniformWidth $ vConcatLines [ top , ls ]
++
+   blockWidth ls = case ls of
+     (l:_) -> length l
+     []    -> 0
+ 
+ instance DrawASCII (BinTree ()) where
+-  ascii = asciiBinaryTree_ 
++  ascii = asciiBinaryTree_
+ 
+---------------------------------------------------------------------------------      
++--------------------------------------------------------------------------------
+diff --git a/Math/Combinat/Trees/Nary.hs b/Math/Combinat/Trees/Nary.hs
+index 6262d20..8c3ccee 100644
+--- a/Math/Combinat/Trees/Nary.hs
++++ b/Math/Combinat/Trees/Nary.hs
+@@ -2,12 +2,12 @@
+ -- | N-ary trees.
+ 
+ {-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
+-module Math.Combinat.Trees.Nary 
+-  (      
++module Math.Combinat.Trees.Nary
++  (
+     -- * Types
+     module Data.Tree
+   , Tree(..)
+-    -- * Regular trees  
++    -- * Regular trees
+   , ternaryTrees
+   , regularNaryTrees
+   , semiRegularTrees
+@@ -21,18 +21,18 @@ module Math.Combinat.Trees.Nary
+   , asciiTreeVerticalLeavesOnly
+     -- * Graphviz drawing
+   , Dot
+-  , graphvizDotTree  
++  , graphvizDotTree
+   , graphvizDotForest
+     -- * Classifying nodes
+   , classifyTreeNode
+   , isTreeLeaf  , isTreeNode
+   , isTreeLeaf_ , isTreeNode_
+-  , treeNodeNumberOfChildren 
++  , treeNodeNumberOfChildren
+     -- * Counting nodes
+   , countTreeNodes
+   , countTreeLeaves
+   , countTreeLabelsWith
+-  , countTreeNodesWith 
++  , countTreeNodesWith
+     -- * Left and right spines
+   , leftSpine  , leftSpine_
+   , rightSpine , rightSpine_
+@@ -52,14 +52,14 @@ module Math.Combinat.Trees.Nary
+   , labelNChildrenForest
+   , labelNChildrenTree_
+   , labelNChildrenForest_
+-    
++
+   ) where
+ 
+ 
+ --------------------------------------------------------------------------------
+ 
+ import Data.Tree
+-import Data.List
++import Data.List (group, sort)
+ 
+ import Control.Applicative
+ 
+@@ -82,13 +82,13 @@ import Math.Combinat.Helper
+ 
+ instance HasNumberOfNodes (Tree a) where
+   numberOfNodes = go where
+-    go (Node label subforest) = if null subforest 
+-      then 0 
++    go (Node label subforest) = if null subforest
++      then 0
+       else 1 + sum' (map go subforest)
+ 
+ instance HasNumberOfLeaves (Tree a) where
+   numberOfLeaves = go where
+-    go (Node label subforest) = if null subforest 
++    go (Node label subforest) = if null subforest
+       then 1
+       else sum' (map go subforest)
+ 
+@@ -97,32 +97,32 @@ instance HasNumberOfLeaves (Tree a) where
+ -- | @regularNaryTrees d n@ returns the list of (rooted) trees on @n@ nodes where each
+ -- node has exactly @d@ children. Note that the leaves do not count in @n@.
+ -- Naive algorithm.
+-regularNaryTrees 
++regularNaryTrees
+   :: Int         -- ^ degree = number of children of each node
+   -> Int         -- ^ number of nodes
+   -> [Tree ()]
+ regularNaryTrees d = go where
+   go 0 = [ Node () [] ]
+   go n = [ Node () cs
+-         | is <- compositions d (n-1) 
+-         , cs <- listTensor [ go i | i<-is ] 
++         | is <- compositions d (n-1)
++         , cs <- listTensor [ go i | i<-is ]
+          ]
+-  
++
+ -- | Ternary trees on @n@ nodes (synonym for @regularNaryTrees 3@)
+-ternaryTrees :: Int -> [Tree ()]  
++ternaryTrees :: Int -> [Tree ()]
+ ternaryTrees = regularNaryTrees 3
+ 
+--- | We have 
++-- | We have
+ --
+--- > length (regularNaryTrees d n) == countRegularNaryTrees d n == \frac {1} {(d-1)n+1} \binom {dn} {n} 
++-- > length (regularNaryTrees d n) == countRegularNaryTrees d n == \frac {1} {(d-1)n+1} \binom {dn} {n}
+ --
+ countRegularNaryTrees :: (Integral a, Integral b) => a -> b -> Integer
+ countRegularNaryTrees d n = binomial (dd*nn) nn `div` ((dd-1)*nn+1) where
+   dd = fromIntegral d :: Integer
+-  nn = fromIntegral n :: Integer 
++  nn = fromIntegral n :: Integer
+ 
+ -- | @\# = \\frac {1} {(2n+1} \\binom {3n} {n}@
+-countTernaryTrees :: Integral a => a -> Integer  
++countTernaryTrees :: Integral a => a -> Integer
+ countTernaryTrees = countRegularNaryTrees (3::Int)
+ 
+ --------------------------------------------------------------------------------
+@@ -130,8 +130,8 @@ countTernaryTrees = countRegularNaryTrees (3::Int)
+ -- | All trees on @n@ nodes where the number of children of all nodes is
+ -- in element of the given set. Example:
+ --
+--- > autoTabulate RowMajor (Right 5) $ map asciiTreeVertical 
+--- >                                 $ map labelNChildrenTree_ 
++-- > autoTabulate RowMajor (Right 5) $ map asciiTreeVertical
++-- >                                 $ map labelNChildrenTree_
+ -- >                                 $ semiRegularTrees [2,3] 2
+ -- >
+ -- > [ length $ semiRegularTrees [2,3] n | n<-[0..] ] == [1,2,10,66,498,4066,34970,312066,2862562,26824386,...]
+@@ -142,27 +142,27 @@ countTernaryTrees = countRegularNaryTrees (3::Int)
+ --
+ -- > semiRegularTrees [d] n == regularNaryTrees d n
+ --
+--- 
+-semiRegularTrees 
++--
++semiRegularTrees
+   :: [Int]         -- ^ set of allowed number of children
+   -> Int           -- ^ number of nodes
+   -> [Tree ()]
+ semiRegularTrees []    n = if n==0 then [Node () []] else []
+-semiRegularTrees dset_ n = 
+-  if head dset >=1 
++semiRegularTrees dset_ n =
++  if head dset >=1
+     then go n
+     else error "semiRegularTrees: expecting a list of positive integers"
+   where
+     dset = map head $ group $ sort $ dset_
+-    
++
+     go 0 = [ Node () [] ]
+     go n = [ Node () cs
+            | d <- dset
+-           , is <- compositions d (n-1) 
++           , is <- compositions d (n-1)
+            , cs <- listTensor [ go i | i<-is ]
+            ]
+-           
+-{- 
++
++{-
+ 
+ NOTES:
+ 
+@@ -177,15 +177,15 @@ A219534 = [ length $ semiRegularTrees [2,4] n | n<-[0..] ] == [1,2,12,100,968,10
+ A144097 = [ length $ semiRegularTrees [3,4] n | n<-[0..] ] == [1,2,14,134,1482,17818,226214,2984206,40503890..]
+ 
+ A107708 = [ length $ semiRegularTrees [1,2,3]   n | n<-[0..] ] == [1,3,18,144,1323,13176,138348,1507977 .. ]
+-??      = [ length $ semiRegularTrees [1,2,3,4] n | n<-[0..] ] == [1,4,40,560,9120,161856,3036800,59242240 .. ] 
++??      = [ length $ semiRegularTrees [1,2,3,4] n | n<-[0..] ] == [1,4,40,560,9120,161856,3036800,59242240 .. ]
+ 
+ -}
+-             
++
+ --------------------------------------------------------------------------------
+ 
+ -- | Vertical ASCII drawing of a tree, without labels. Example:
+ --
+--- > autoTabulate RowMajor (Right 5) $ map asciiTreeVertical_ $ regularNaryTrees 2 4 
++-- > autoTabulate RowMajor (Right 5) $ map asciiTreeVertical_ $ regularNaryTrees 2 4
+ --
+ -- Nodes are denoted by @\@@, leaves by @*@.
+ --
+@@ -195,12 +195,12 @@ asciiTreeVertical_ tree = ASCII.asciiFromLines (go tree) where
+   go (Node _ cs) = case cs of
+     [] -> ["-*"]
+     _  -> concat $ mapWithFirstLast f $ map go cs
+-    
+-  f :: Bool -> Bool -> [String] -> [String] 
++
++  f :: Bool -> Bool -> [String] -> [String]
+   f bf bl (l:ls) = let indent = if bl           then "  "  else  "| "
+                        gap    = if bl           then []    else ["| "]
+-                       branch = if bl && not bf 
+-                                  then "\\-" 
++                       branch = if bl && not bf
++                                  then "\\-"
+                                   else if bf then "@-"
+                                              else "+-"
+                    in  (branch++l) : map (indent++) ls ++ gap
+@@ -209,7 +209,7 @@ instance DrawASCII (Tree ()) where
+   ascii = asciiTreeVertical_
+ 
+ -- | Prints all labels. Example:
+--- 
++--
+ -- > asciiTreeVertical $ addUniqueLabelsTree_ $ (regularNaryTrees 3 9) !! 666
+ --
+ -- Nodes are denoted by @(label)@, leaves by @label@.
+@@ -220,16 +220,16 @@ asciiTreeVertical tree = ASCII.asciiFromLines (go tree) where
+   go (Node x cs) = case cs of
+     [] -> ["-- " ++ show x]
+     _  -> concat $ mapWithFirstLast (f (show x)) $ map go cs
+-    
+-  f :: String -> Bool -> Bool -> [String] -> [String] 
++
++  f :: String -> Bool -> Bool -> [String] -> [String]
+   f label bf bl (l:ls) =
+-        let spaces = (map (const ' ') label  ) 
+-            dashes = (map (const '-') spaces ) 
++        let spaces = (map (const ' ') label  )
++            dashes = (map (const '-') spaces )
+             indent = if bl then "  " ++spaces++"  " else  " |" ++ spaces ++ "  "
+             gap    = if bl then []                  else [" |" ++ spaces ++ "  "]
+             branch = if bl && not bf
+-                           then " \\"++dashes++"--" 
+-                           else if bf 
++                           then " \\"++dashes++"--"
++                           else if bf
+                              then "-(" ++ label  ++ ")-"
+                              else " +" ++ dashes ++ "--"
+         in  (branch++l) : map (indent++) ls ++ gap
+@@ -241,30 +241,30 @@ asciiTreeVerticalLeavesOnly tree = ASCII.asciiFromLines (go tree) where
+   go (Node x cs) = case cs of
+     [] -> ["- " ++ show x]
+     _  -> concat $ mapWithFirstLast f $ map go cs
+-    
+-  f :: Bool -> Bool -> [String] -> [String] 
++
++  f :: Bool -> Bool -> [String] -> [String]
+   f bf bl (l:ls) = let indent = if bl           then "  "  else  "| "
+                        gap    = if bl           then []    else ["| "]
+-                       branch = if bl && not bf 
+-                                  then "\\-" 
++                       branch = if bl && not bf
++                                  then "\\-"
+                                   else if bf then "@-"
+                                              else "+-"
+                    in  (branch++l) : map (indent++) ls ++ gap
+-  
++
+ --------------------------------------------------------------------------------
+-  
++
+ -- | The leftmost spine (the second element of the pair is the leaf node)
+ leftSpine  :: Tree a -> ([a],a)
+ leftSpine = go where
+   go (Node x cs) = case cs of
+     [] -> ([],x)
+-    _  -> let (xs,y) = go (head cs) in (x:xs,y) 
++    _  -> let (xs,y) = go (head cs) in (x:xs,y)
+ 
+ rightSpine  :: Tree a -> ([a],a)
+ rightSpine = go where
+   go (Node x cs) = case cs of
+     [] -> ([],x)
+-    _  -> let (xs,y) = go (last cs) in (x:xs,y) 
++    _  -> let (xs,y) = go (last cs) in (x:xs,y)
+ 
+ -- | The leftmost spine without the leaf node
+ leftSpine_  :: Tree a -> [a]
+@@ -273,23 +273,23 @@ leftSpine_ = go where
+     [] -> []
+     _  -> x : go (head cs)
+ 
+-rightSpine_ :: Tree a -> [a] 
++rightSpine_ :: Tree a -> [a]
+ rightSpine_ = go where
+   go (Node x cs) = case cs of
+     [] -> []
+-    _  -> x : go (last cs) 
++    _  -> x : go (last cs)
+ 
+--- | The length (number of edges) on the left spine 
++-- | The length (number of edges) on the left spine
+ --
+ -- > leftSpineLength tree == length (leftSpine_ tree)
+ --
+-leftSpineLength  :: Tree a -> Int  
++leftSpineLength  :: Tree a -> Int
+ leftSpineLength = go 0 where
+   go n (Node x cs) = case cs of
+     [] -> n
+     _  -> go (n+1) (head cs)
+-  
+-rightSpineLength :: Tree a -> Int  
++
++rightSpineLength :: Tree a -> Int
+ rightSpineLength = go 0 where
+   go n (Node x cs) = case cs of
+     [] -> n
+@@ -301,17 +301,17 @@ rightSpineLength = go 0 where
+ classifyTreeNode :: Tree a -> Either a a
+ classifyTreeNode (Node x cs) = case cs of { [] -> Left x ; _ -> Right x }
+ 
+-isTreeLeaf :: Tree a -> Maybe a  
+-isTreeLeaf (Node x cs) = case cs of { [] -> Just x ; _ -> Nothing }  
++isTreeLeaf :: Tree a -> Maybe a
++isTreeLeaf (Node x cs) = case cs of { [] -> Just x ; _ -> Nothing }
++
++isTreeNode :: Tree a -> Maybe a
++isTreeNode (Node x cs) = case cs of { [] -> Nothing ; _ -> Just x }
+ 
+-isTreeNode :: Tree a -> Maybe a  
+-isTreeNode (Node x cs) = case cs of { [] -> Nothing ; _ -> Just x }  
++isTreeLeaf_ :: Tree a -> Bool
++isTreeLeaf_ (Node x cs) = case cs of { [] -> True ; _ -> False }
+ 
+-isTreeLeaf_ :: Tree a -> Bool  
+-isTreeLeaf_ (Node x cs) = case cs of { [] -> True ; _ -> False }  
+-  
+-isTreeNode_ :: Tree a -> Bool  
+-isTreeNode_ (Node x cs) = case cs of { [] -> False ; _ -> True }  
++isTreeNode_ :: Tree a -> Bool
++isTreeNode_ (Node x cs) = case cs of { [] -> False ; _ -> True }
+ 
+ treeNodeNumberOfChildren :: Tree a -> Int
+ treeNodeNumberOfChildren (Node _ cs) = length cs
+@@ -342,64 +342,64 @@ countTreeNodesWith f = go where
+ --------------------------------------------------------------------------------
+ 
+ -- | Adds unique labels to the nodes (including leaves) of a 'Tree'.
+-addUniqueLabelsTree :: Tree a -> Tree (a,Int) 
++addUniqueLabelsTree :: Tree a -> Tree (a,Int)
+ addUniqueLabelsTree tree = head (addUniqueLabelsForest [tree])
+ 
+ -- | Adds unique labels to the nodes (including leaves) of a 'Forest'
+-addUniqueLabelsForest :: Forest a -> Forest (a,Int) 
++addUniqueLabelsForest :: Forest a -> Forest (a,Int)
+ addUniqueLabelsForest forest = evalState (mapM globalAction forest) 1 where
+-  globalAction tree = 
+-    unwrapMonad $ traverse localAction tree 
++  globalAction tree =
++    unwrapMonad $ traverse localAction tree
+   localAction x = WrapMonad $ do
+     i <- get
+     put (i+1)
+     return (x,i)
+ 
+ addUniqueLabelsTree_ :: Tree a -> Tree Int
+-addUniqueLabelsTree_ = fmap snd . addUniqueLabelsTree  
++addUniqueLabelsTree_ = fmap snd . addUniqueLabelsTree
+ 
+ addUniqueLabelsForest_ :: Forest a -> Forest Int
+ addUniqueLabelsForest_ = map (fmap snd) . addUniqueLabelsForest
+ 
+ --------------------------------------------------------------------------------
+-    
+--- | Attaches the depth to each node. The depth of the root is 0. 
+-labelDepthTree :: Tree a -> Tree (a,Int) 
++
++-- | Attaches the depth to each node. The depth of the root is 0.
++labelDepthTree :: Tree a -> Tree (a,Int)
+ labelDepthTree tree = worker 0 tree where
+   worker depth (Node label subtrees) = Node (label,depth) (map (worker (depth+1)) subtrees)
+ 
+-labelDepthForest :: Forest a -> Forest (a,Int) 
++labelDepthForest :: Forest a -> Forest (a,Int)
+ labelDepthForest forest = map labelDepthTree forest
+-    
++
+ labelDepthTree_ :: Tree a -> Tree Int
+ labelDepthTree_ = fmap snd . labelDepthTree
+ 
+-labelDepthForest_ :: Forest a -> Forest Int 
++labelDepthForest_ :: Forest a -> Forest Int
+ labelDepthForest_ = map (fmap snd) . labelDepthForest
+ 
+ --------------------------------------------------------------------------------
+ 
+--- | Attaches the number of children to each node. 
++-- | Attaches the number of children to each node.
+ labelNChildrenTree :: Tree a -> Tree (a,Int)
+-labelNChildrenTree (Node x subforest) = 
++labelNChildrenTree (Node x subforest) =
+   Node (x, length subforest) (map labelNChildrenTree subforest)
+-  
+-labelNChildrenForest :: Forest a -> Forest (a,Int) 
++
++labelNChildrenForest :: Forest a -> Forest (a,Int)
+ labelNChildrenForest forest = map labelNChildrenTree forest
+ 
+ labelNChildrenTree_ :: Tree a -> Tree Int
+ labelNChildrenTree_ = fmap snd . labelNChildrenTree
+ 
+-labelNChildrenForest_ :: Forest a -> Forest Int 
++labelNChildrenForest_ :: Forest a -> Forest Int
+ labelNChildrenForest_ = map (fmap snd) . labelNChildrenForest
+-    
++
+ --------------------------------------------------------------------------------
+ 
+--- | Computes the set of equivalence classes of rooted trees (in the 
+--- sense that the leaves of a node are /unordered/) 
+--- with @n = length ks@ leaves where the set of heights of 
+--- the leaves matches the given set of numbers. 
+--- The height is defined as the number of /edges/ from the leaf to the root. 
++-- | Computes the set of equivalence classes of rooted trees (in the
++-- sense that the leaves of a node are /unordered/)
++-- with @n = length ks@ leaves where the set of heights of
++-- the leaves matches the given set of numbers.
++-- The height is defined as the number of /edges/ from the leaf to the root.
+ --
+ -- TODO: better name?
+ derivTrees :: [Int] -> [Tree ()]
+@@ -407,24 +407,24 @@ derivTrees xs = derivTrees' (map (+1) xs)
+ 
+ derivTrees' :: [Int] -> [Tree ()]
+ derivTrees' [] = []
+-derivTrees' [n] = 
+-  if n>=1 
+-    then [unfoldTree f 1] 
+-    else [] 
+-  where 
++derivTrees' [n] =
++  if n>=1
++    then [unfoldTree f 1]
++    else []
++  where
+     f k = if k<n then ((),[k+1]) else ((),[])
+-derivTrees' ks = 
++derivTrees' ks =
+   if and (map (>0) ks)
+     then
+-      [ Node () sub 
++      [ Node () sub
+       | part <- parts
+       , let subtrees = map g part
+-      , sub <- listTensor subtrees 
+-      ] 
++      , sub <- listTensor subtrees
++      ]
+     else []
+   where
+     parts = partitionMultiset ks
+     g xs = derivTrees' (map (\x->x-1) xs)
+ 
+ --------------------------------------------------------------------------------
+-    
+\ No newline at end of file
++
diff --git a/patches/commonmark-extensions-0.2.0.4.patch b/patches/commonmark-extensions-0.2.0.4.patch
index b35dc6ab41b51bf7fd6e451d90eb993529d40d52..f93ce0b1311b7f1d56939a991a1c0d340017994c 100644
--- a/patches/commonmark-extensions-0.2.0.4.patch
+++ b/patches/commonmark-extensions-0.2.0.4.patch
@@ -11,7 +11,7 @@ index aa0c468..d527ac8 100644
  {-# LANGUAGE OverloadedStrings #-}
  module Commonmark.Extensions.DefinitionList
 diff --git a/src/Commonmark/Extensions/Footnote.hs b/src/Commonmark/Extensions/Footnote.hs
-index 7ef9f41..751e177 100644
+index 7ef9f41..7c2ce77 100644
 --- a/src/Commonmark/Extensions/Footnote.hs
 +++ b/src/Commonmark/Extensions/Footnote.hs
 @@ -1,4 +1,5 @@
@@ -20,6 +20,15 @@ index 7ef9f41..751e177 100644
  {-# LANGUAGE FunctionalDependencies #-}
  {-# LANGUAGE UndecidableInstances #-}
  {-# LANGUAGE MultiParamTypeClasses #-}
+@@ -20,7 +21,7 @@ import Commonmark.TokParsers
+ import Commonmark.ReferenceMap
+ import Control.Monad.Trans.Class (lift)
+ import Control.Monad (mzero)
+-import Data.List
++import Data.List (sort)
+ import Data.Maybe (fromMaybe, mapMaybe)
+ #if !MIN_VERSION_base(4,11,0)
+ import Data.Semigroup (Semigroup)
 diff --git a/src/Commonmark/Extensions/Smart.hs b/src/Commonmark/Extensions/Smart.hs
 index b1f86f1..fca077e 100644
 --- a/src/Commonmark/Extensions/Smart.hs
diff --git a/patches/cryptonite-0.28.patch b/patches/cryptonite-0.28.patch
index 0c376a918d87e4a7643e1955038b5b818d70a6b3..836f4b71a7c58559401449c0ded995b2d409a444 100644
--- a/patches/cryptonite-0.28.patch
+++ b/patches/cryptonite-0.28.patch
@@ -1,3 +1,16 @@
+diff --git a/Crypto/Cipher/Twofish/Primitive.hs b/Crypto/Cipher/Twofish/Primitive.hs
+index 30c260d..aba92da 100644
+--- a/Crypto/Cipher/Twofish/Primitive.hs
++++ b/Crypto/Cipher/Twofish/Primitive.hs
+@@ -13,7 +13,7 @@ import qualified Crypto.Internal.ByteArray as B
+ import           Crypto.Internal.WordArray
+ import           Data.Word
+ import           Data.Bits
+-import           Data.List
++import           Data.List (foldl')
+ 
+ -- Based on the Golang referance implementation
+ -- https://github.com/golang/crypto/blob/master/twofish/twofish.go
 diff --git a/Crypto/Internal/WordArray.hs b/Crypto/Internal/WordArray.hs
 index 0f3c0f6..349be6c 100644
 --- a/Crypto/Internal/WordArray.hs
diff --git a/patches/deferred-folds-0.9.17.patch b/patches/deferred-folds-0.9.17.patch
new file mode 100644
index 0000000000000000000000000000000000000000..d431acf9f40effe9e549f7cce735350bb3b4c05f
--- /dev/null
+++ b/patches/deferred-folds-0.9.17.patch
@@ -0,0 +1,22 @@
+diff --git a/library/DeferredFolds/Prelude.hs b/library/DeferredFolds/Prelude.hs
+index 095cdff..4046d16 100644
+--- a/library/DeferredFolds/Prelude.hs
++++ b/library/DeferredFolds/Prelude.hs
+@@ -32,7 +32,7 @@ import Data.Functor.Identity as Exports
+ import Data.Int as Exports
+ import Data.IORef as Exports
+ import Data.Ix as Exports
+-import Data.List as Exports hiding (sortOn, isSubsequenceOf, uncons, concat, foldr, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, find, maximumBy, minimumBy, mapAccumL, mapAccumR, foldl')
++import Data.List as Exports hiding (sortOn, isSubsequenceOf, uncons, concat, foldr, foldl1, length, maximum, minimum, null, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, find, maximumBy, minimumBy, mapAccumL, mapAccumR, foldl')
+ import Data.Maybe as Exports
+ import Data.Monoid as Exports hiding (Last(..), First(..), (<>))
+ import Data.Ord as Exports
+@@ -56,7 +56,7 @@ import GHC.Exts as Exports (lazy, inline, sortWith, groupWith, IsList(..))
+ import GHC.Generics as Exports (Generic)
+ import GHC.IO.Exception as Exports
+ import Numeric as Exports
+-import Prelude as Exports hiding (concat, foldr, mapM_, sequence_, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, mapM, sequence, id, (.))
++import Prelude as Exports hiding (concat, foldr, mapM_, sequence_, foldl1, length, maximum, minimum, null, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, mapM, sequence, id, (.))
+ import System.Environment as Exports
+ import System.Exit as Exports
+ import System.IO as Exports
diff --git a/patches/deriving-compat-0.5.10.patch b/patches/deriving-compat-0.5.10.patch
index 553c576179f37a15d46a280935db30b5bd3846d0..a282ceae66eeecbacb714d6739aae2adaabdcb90 100644
--- a/patches/deriving-compat-0.5.10.patch
+++ b/patches/deriving-compat-0.5.10.patch
@@ -1,7 +1,16 @@
 diff --git a/src/Data/Deriving/Internal.hs b/src/Data/Deriving/Internal.hs
-index 3c1e37b..2a89bbc 100644
+index 3c1e37b..ec14c9c 100644
 --- a/src/Data/Deriving/Internal.hs
 +++ b/src/Data/Deriving/Internal.hs
+@@ -35,7 +35,7 @@ import           Data.Functor.Classes (Eq1(..), Ord1(..), Read1(..), Show1(..))
+ import           Data.Functor.Classes (Eq2(..), Ord2(..), Read2(..), Show2(..))
+ # endif
+ #endif
+-import           Data.List
++import           Data.List (foldl', union)
+ import qualified Data.Map as Map
+ import           Data.Map (Map)
+ import           Data.Maybe
 @@ -2146,16 +2146,36 @@ eqWord16HashValName :: Name
  eqWord16HashValName = mkNameG_v "ghc-prim" "GHC.Prim" "eqWord16#"
  
@@ -85,9 +94,18 @@ index 49aec0c..259407a 100644
  
  deriveViaDecs :: Type       -- ^ The instance head (e.g., @Eq (Foo a)@)
 diff --git a/src/Data/Functor/Deriving/Internal.hs b/src/Data/Functor/Deriving/Internal.hs
-index 57d8f9c..e79ba2d 100644
+index 57d8f9c..5472f12 100644
 --- a/src/Data/Functor/Deriving/Internal.hs
 +++ b/src/Data/Functor/Deriving/Internal.hs
+@@ -56,7 +56,7 @@ module Data.Functor.Deriving.Internal (
+ import           Control.Monad (guard)
+ 
+ import           Data.Deriving.Internal
+-import           Data.List
++import           Data.List (foldl')
+ import qualified Data.Map as Map ((!), keys, lookup, member, singleton)
+ import           Data.Maybe
+ 
 @@ -703,7 +703,7 @@ functorFunTrivial fmapE traverseE ff z = go ff
  conWildPat :: ConstructorInfo -> Pat
  conWildPat (ConstructorInfo { constructorName = conName
@@ -127,9 +145,18 @@ index 57d8f9c..e79ba2d 100644
 +#endif
 +                         pats
 diff --git a/src/Text/Show/Deriving/Internal.hs b/src/Text/Show/Deriving/Internal.hs
-index 75e10c2..4a2a092 100644
+index 75e10c2..7110284 100644
 --- a/src/Text/Show/Deriving/Internal.hs
 +++ b/src/Text/Show/Deriving/Internal.hs
+@@ -52,7 +52,7 @@ module Text.Show.Deriving.Internal (
+     ) where
+ 
+ import           Data.Deriving.Internal
+-import           Data.List
++import           Data.List (intersperse)
+ import qualified Data.Map as Map
+ import           Data.Map (Map)
+ import           Data.Maybe (fromMaybe)
 @@ -694,22 +694,42 @@ primShowTbl = Map.fromList
      , (int8HashTypeName,   PrimShow
                               { primShowBoxer      = appE (conE iHashDataName) . appE (varE extendInt8HashValName)
diff --git a/patches/diagrams-lib-1.4.3.patch b/patches/diagrams-lib-1.4.3.patch
index f1fd6a9b5d570c8d5a608f044c824f9cb5d365ae..85a100dc4fadf190789cc42388b0109dcda4d1e7 100644
--- a/patches/diagrams-lib-1.4.3.patch
+++ b/patches/diagrams-lib-1.4.3.patch
@@ -92,6 +92,19 @@ index 82387b3..6e41fd1 100644
      deformE' env v'
          | dp > 0    = Max $ getMax (env v') + (dp * s) / quadrance v'
          | otherwise = env v'
+diff --git a/src/Diagrams/CubicSpline/Internal.hs b/src/Diagrams/CubicSpline/Internal.hs
+index 1087d4e..08c09f6 100644
+--- a/src/Diagrams/CubicSpline/Internal.hs
++++ b/src/Diagrams/CubicSpline/Internal.hs
+@@ -21,7 +21,7 @@ module Diagrams.CubicSpline.Internal
+ 
+ import           Diagrams.Solve.Tridiagonal
+ 
+-import           Data.List
++import           Data.List (zip4)
+ 
+ -- | Use the tri-diagonal solver with the appropriate parameters for an open cubic spline.
+ solveCubicSplineDerivatives :: Fractional a => [a] -> [a]
 diff --git a/src/Diagrams/Trail.hs b/src/Diagrams/Trail.hs
 index d5b152a..c65fa96 100644
 --- a/src/Diagrams/Trail.hs
@@ -154,3 +167,16 @@ index c328202..1a26b5d 100644
  
  -- | @rotationAbout p@ is a rotation about the point @p@ (instead of
  --   around the local origin).
+diff --git a/src/Diagrams/Util.hs b/src/Diagrams/Util.hs
+index 5207c72..12f4e81 100644
+--- a/src/Diagrams/Util.hs
++++ b/src/Diagrams/Util.hs
+@@ -40,7 +40,7 @@ import           Control.Monad.Catch
+ import           Control.Monad.Trans
+ import           Control.Monad.Trans.Maybe
+ import           Data.Default.Class
+-import           Data.List
++import           Data.List (find, isSuffixOf)
+ import           Data.List.Lens
+ import           Data.Maybe
+ import           Data.Monoid
diff --git a/patches/doctest-0.16.3.patch b/patches/doctest-0.16.3.patch
index 02cd32869bb890e69ae68a508067ad3f451facaf..279e7345501e9e76653b856fcfd3c766fa0e4a82 100644
--- a/patches/doctest-0.16.3.patch
+++ b/patches/doctest-0.16.3.patch
@@ -12,8 +12,21 @@ index 1b55e76..c890767 100644
    default-language: Haskell2010
  
  executable doctest
+diff --git a/ghci-wrapper/src/Language/Haskell/GhciWrapper.hs b/ghci-wrapper/src/Language/Haskell/GhciWrapper.hs
+index 0fd39da..8f10a08 100644
+--- a/ghci-wrapper/src/Language/Haskell/GhciWrapper.hs
++++ b/ghci-wrapper/src/Language/Haskell/GhciWrapper.hs
+@@ -15,7 +15,7 @@ import           System.Process
+ import           System.Exit
+ import           Control.Monad
+ import           Control.Exception
+-import           Data.List
++import           Data.List (isSuffixOf)
+ import           Data.Maybe
+ 
+ data Config = Config {
 diff --git a/src/Extract.hs b/src/Extract.hs
-index 81ed5a9..4f4f6b6 100644
+index 81ed5a9..70dabc1 100644
 --- a/src/Extract.hs
 +++ b/src/Extract.hs
 @@ -21,10 +21,20 @@ import           GHC hiding (flags, Module, Located)
@@ -66,7 +79,17 @@ index 81ed5a9..4f4f6b6 100644
  -- | A wrapper around `SomeException`, to allow for a custom `Show` instance.
  newtype ExtractError = ExtractError SomeException
    deriving Typeable
-@@ -110,7 +125,11 @@ parse args = withGhc args $ \modules_ -> withTempOutputDir $ do
+@@ -105,12 +120,20 @@ parse args = withGhc args $ \modules_ -> withTempOutputDir $ do
+   -- ignore additional object files
+   let modules = filter (not . isSuffixOf ".o") modules_
+ 
+-  mapM (`guessTarget` Nothing) modules >>= setTargets
++  mapM (\m -> guessTarget m
++#if __GLASGOW_HASKELL__ >= 903
++                Nothing
++#endif
++                Nothing) modules >>= setTargets
+   mods <- depanal [] False
  
    mods' <- if needsTemplateHaskellOrQQ mods then enableCompilation mods else return mods
  
@@ -79,7 +102,7 @@ index 81ed5a9..4f4f6b6 100644
    reverse <$> mapM (loadModPlugins >=> parseModule >=> typecheckModule >=> loadModule) sortedMods
    where
      -- copied from Haddock/Interface.hs
-@@ -121,8 +140,10 @@ parse args = withGhc args $ \modules_ -> withTempOutputDir $ do
+@@ -121,8 +144,10 @@ parse args = withGhc args $ \modules_ -> withTempOutputDir $ do
  #elif __GLASGOW_HASKELL__ < 809
        let enableComp d = let platform = targetPlatform d
                           in d { hscTarget = defaultObjectTarget platform }
@@ -91,7 +114,7 @@ index 81ed5a9..4f4f6b6 100644
  #endif
        modifySessionDynFlags enableComp
        -- We need to update the DynFlags of the ModSummaries as well.
-@@ -159,7 +180,11 @@ parse args = withGhc args $ \modules_ -> withTempOutputDir $ do
+@@ -159,7 +184,11 @@ parse args = withGhc args $ \modules_ -> withTempOutputDir $ do
      -- | A variant of 'gbracket' where the return value from the first computation
      -- is not required.
      gbracket_ :: ExceptionMonad m => m a -> m b -> m c -> m c
@@ -103,7 +126,7 @@ index 81ed5a9..4f4f6b6 100644
  
      setOutputDir f d = d {
          objectDir  = Just f
-@@ -172,8 +197,13 @@ parse args = withGhc args $ \modules_ -> withTempOutputDir $ do
+@@ -172,8 +201,13 @@ parse args = withGhc args $ \modules_ -> withTempOutputDir $ do
      -- Since GHC 8.6, plugins are initialized on a per module basis
      loadModPlugins modsum = do
        hsc_env <- getSession
@@ -117,7 +140,7 @@ index 81ed5a9..4f4f6b6 100644
  #else
      loadModPlugins = return
  #endif
-@@ -219,13 +249,15 @@ docStringsFromModule mod = map (fmap (toLocated . fmap unpackHDS)) docs
+@@ -219,13 +253,15 @@ docStringsFromModule mod = map (fmap (toLocated . fmap unpackHDS)) docs
      -- traversing the whole source in a generic way, to ensure that we get
      -- everything in source order.
      header  = [(Nothing, x) | Just x <- [hsmodHaddockModHeader source]]
@@ -136,7 +159,7 @@ index 81ed5a9..4f4f6b6 100644
      decls   = extractDocStrings (hsmodDecls source)
  
  type Selector a = a -> ([(Maybe String, LHsDocString)], Bool)
-@@ -279,15 +311,21 @@ extractDocStrings = everythingBut (++) (([], False) `mkQ` fromLHsDecl
+@@ -279,15 +315,21 @@ extractDocStrings = everythingBut (++) (([], False) `mkQ` fromLHsDecl
        -- no location information attached.  The location information is
        -- attached to HsDecl instead.
  #if __GLASGOW_HASKELL__ < 805
@@ -162,7 +185,7 @@ index 81ed5a9..4f4f6b6 100644
  
      fromLHsDocString :: Selector LHsDocString
      fromLHsDocString x = select (Nothing, x)
-@@ -302,3 +340,8 @@ extractDocStrings = everythingBut (++) (([], False) `mkQ` fromLHsDecl
+@@ -302,3 +344,8 @@ extractDocStrings = everythingBut (++) (([], False) `mkQ` fromLHsDecl
  unpackHDS :: HsDocString -> String
  unpackHDS (HsDocString s) = unpackFS s
  #endif
@@ -260,10 +283,16 @@ index e005fe5..ed73a8c 100644
 +                    -> Location (unpackFS . srcSpanFile $ sp) (srcSpanStartLine sp)
  #endif
 diff --git a/src/Options.hs b/src/Options.hs
-index a7c2758..54d3bb3 100644
+index a7c2758..3f53348 100644
 --- a/src/Options.hs
 +++ b/src/Options.hs
-@@ -23,7 +23,11 @@ import           Data.Maybe
+@@ -18,12 +18,16 @@ module Options (
+ import           Prelude ()
+ import           Prelude.Compat
+ 
+-import           Data.List.Compat
++import           Data.List.Compat (intercalate, stripPrefix)
+ import           Data.Maybe
  
  import qualified Paths_doctest
  import           Data.Version (showVersion)
@@ -275,6 +304,19 @@ index a7c2758..54d3bb3 100644
  import           Interpreter (ghc)
  
  usage :: String
+diff --git a/src/Parse.hs b/src/Parse.hs
+index 926b318..070e827 100644
+--- a/src/Parse.hs
++++ b/src/Parse.hs
+@@ -18,7 +18,7 @@ module Parse (
+ ) where
+ 
+ import           Data.Char (isSpace)
+-import           Data.List
++import           Data.List (isPrefixOf, stripPrefix)
+ import           Data.Maybe
+ import           Data.String
+ #if __GLASGOW_HASKELL__ < 710
 diff --git a/src/Run.hs b/src/Run.hs
 index 95c2c14..6f51252 100644
 --- a/src/Run.hs
@@ -291,3 +333,16 @@ index 95c2c14..6f51252 100644
  
  import           PackageDBs
  import           Parse
+diff --git a/src/Runner/Example.hs b/src/Runner/Example.hs
+index d79c9b2..7e7a360 100644
+--- a/src/Runner/Example.hs
++++ b/src/Runner/Example.hs
+@@ -4,7 +4,7 @@ module Runner.Example (
+ ) where
+ 
+ import           Data.Char
+-import           Data.List
++import           Data.List (isPrefixOf)
+ import           Util
+ 
+ import           Parse
diff --git a/patches/doctest-0.18.1.patch b/patches/doctest-0.18.1.patch
index 0cb9341f86a27ddf17538b75c841bbe71f69b6d0..19073be638eea11ac9815f6675430e1f85bd2899 100644
--- a/patches/doctest-0.18.1.patch
+++ b/patches/doctest-0.18.1.patch
@@ -1,5 +1,18 @@
+diff --git a/ghci-wrapper/src/Language/Haskell/GhciWrapper.hs b/ghci-wrapper/src/Language/Haskell/GhciWrapper.hs
+index e9b10da..0f08d47 100644
+--- a/ghci-wrapper/src/Language/Haskell/GhciWrapper.hs
++++ b/ghci-wrapper/src/Language/Haskell/GhciWrapper.hs
+@@ -15,7 +15,7 @@ import           System.Process
+ import           System.Exit
+ import           Control.Monad
+ import           Control.Exception
+-import           Data.List
++import           Data.List (isSuffixOf)
+ import           Data.Maybe
+ 
+ data Config = Config {
 diff --git a/src/Extract.hs b/src/Extract.hs
-index e419fdc..cdad6ae 100644
+index e419fdc..cb13a8e 100644
 --- a/src/Extract.hs
 +++ b/src/Extract.hs
 @@ -66,6 +66,12 @@ import           GHC.Runtime.Loader (initializePlugins)
@@ -15,7 +28,17 @@ index e419fdc..cdad6ae 100644
  -- | A wrapper around `SomeException`, to allow for a custom `Show` instance.
  newtype ExtractError = ExtractError SomeException
    deriving Typeable
-@@ -125,7 +131,11 @@ parse args = withGhc args $ \modules_ -> withTempOutputDir $ do
+@@ -120,12 +126,20 @@ parse args = withGhc args $ \modules_ -> withTempOutputDir $ do
+   -- ignore additional object files
+   let modules = filter (not . isSuffixOf ".o") modules_
+ 
+-  mapM (`guessTarget` Nothing) modules >>= setTargets
++  mapM (\m -> guessTarget m
++#if __GLASGOW_HASKELL__ >= 903
++                Nothing
++#endif
++                Nothing) modules >>= setTargets
+   mods <- depanal [] False
  
    mods' <- if needsTemplateHaskellOrQQ mods then enableCompilation mods else return mods
  
@@ -28,7 +51,7 @@ index e419fdc..cdad6ae 100644
    reverse <$> mapM (loadModPlugins >=> parseModule >=> typecheckModule >=> loadModule) sortedMods
    where
      -- copied from Haddock/Interface.hs
-@@ -136,8 +146,10 @@ parse args = withGhc args $ \modules_ -> withTempOutputDir $ do
+@@ -136,8 +150,10 @@ parse args = withGhc args $ \modules_ -> withTempOutputDir $ do
  #elif __GLASGOW_HASKELL__ < 809
        let enableComp d = let platform = targetPlatform d
                           in d { hscTarget = defaultObjectTarget platform }
@@ -40,7 +63,7 @@ index e419fdc..cdad6ae 100644
  #endif
        modifySessionDynFlags enableComp
        -- We need to update the DynFlags of the ModSummaries as well.
-@@ -191,8 +203,13 @@ parse args = withGhc args $ \modules_ -> withTempOutputDir $ do
+@@ -191,8 +207,13 @@ parse args = withGhc args $ \modules_ -> withTempOutputDir $ do
      -- Since GHC 8.6, plugins are initialized on a per module basis
      loadModPlugins modsum = do
        hsc_env <- getSession
@@ -54,7 +77,7 @@ index e419fdc..cdad6ae 100644
  #else
      loadModPlugins = return
  #endif
-@@ -238,13 +255,15 @@ docStringsFromModule mod = map (fmap (toLocated . fmap unpackHDS)) docs
+@@ -238,13 +259,15 @@ docStringsFromModule mod = map (fmap (toLocated . fmap unpackHDS)) docs
      -- traversing the whole source in a generic way, to ensure that we get
      -- everything in source order.
      header  = [(Nothing, x) | Just x <- [hsmodHaddockModHeader source]]
@@ -73,7 +96,7 @@ index e419fdc..cdad6ae 100644
      decls   = extractDocStrings (hsmodDecls source)
  
  type Selector a = a -> ([(Maybe String, LHsDocString)], Bool)
-@@ -298,15 +317,21 @@ extractDocStrings = everythingBut (++) (([], False) `mkQ` fromLHsDecl
+@@ -298,15 +321,21 @@ extractDocStrings = everythingBut (++) (([], False) `mkQ` fromLHsDecl
        -- no location information attached.  The location information is
        -- attached to HsDecl instead.
  #if __GLASGOW_HASKELL__ < 805
@@ -99,7 +122,7 @@ index e419fdc..cdad6ae 100644
  
      fromLHsDocString :: Selector LHsDocString
      fromLHsDocString x = select (Nothing, x)
-@@ -321,3 +346,8 @@ extractDocStrings = everythingBut (++) (([], False) `mkQ` fromLHsDecl
+@@ -321,3 +350,8 @@ extractDocStrings = everythingBut (++) (([], False) `mkQ` fromLHsDecl
  unpackHDS :: HsDocString -> String
  unpackHDS (HsDocString s) = unpackFS s
  #endif
@@ -139,3 +162,42 @@ index c928496..810d58a 100644
      , ghcMode   = CompManager
      , ghcLink   = NoLink
      }
+diff --git a/src/Options.hs b/src/Options.hs
+index 1ddde2d..5970a32 100644
+--- a/src/Options.hs
++++ b/src/Options.hs
+@@ -22,7 +22,7 @@ import           Control.Monad.Trans.RWS (RWS, execRWS)
+ import qualified Control.Monad.Trans.RWS as RWS
+ 
+ import           Control.Monad (when)
+-import           Data.List.Compat
++import           Data.List.Compat (intercalate, stripPrefix)
+ import           Data.Monoid (Endo (Endo))
+ 
+ import qualified Paths_doctest
+diff --git a/src/Parse.hs b/src/Parse.hs
+index 926b318..070e827 100644
+--- a/src/Parse.hs
++++ b/src/Parse.hs
+@@ -18,7 +18,7 @@ module Parse (
+ ) where
+ 
+ import           Data.Char (isSpace)
+-import           Data.List
++import           Data.List (isPrefixOf, stripPrefix)
+ import           Data.Maybe
+ import           Data.String
+ #if __GLASGOW_HASKELL__ < 710
+diff --git a/src/Runner/Example.hs b/src/Runner/Example.hs
+index d79c9b2..7e7a360 100644
+--- a/src/Runner/Example.hs
++++ b/src/Runner/Example.hs
+@@ -4,7 +4,7 @@ module Runner.Example (
+ ) where
+ 
+ import           Data.Char
+-import           Data.List
++import           Data.List (isPrefixOf)
+ import           Util
+ 
+ import           Parse
diff --git a/patches/extra-1.7.9.patch b/patches/extra-1.7.9.patch
new file mode 100644
index 0000000000000000000000000000000000000000..57e1ec16470397a7c174d6fe33746c52c2dcff79
--- /dev/null
+++ b/patches/extra-1.7.9.patch
@@ -0,0 +1,76 @@
+diff --git a/src/Data/List/Extra.hs b/src/Data/List/Extra.hs
+index 5a79bde..cce1813 100644
+--- a/src/Data/List/Extra.hs
++++ b/src/Data/List/Extra.hs
+@@ -6,6 +6,7 @@
+ --   <https://hackage.haskell.org/package/text text> package.
+ module Data.List.Extra(
+     module Data.List,
++    all, any, concat, concatMap, elem, foldl, foldl', foldr, length, null,
+     -- * String operations
+     lower, upper, trim, trimStart, trimEnd, word1, line1,
+     escapeHTML, escapeJSON,
+@@ -38,7 +39,7 @@ module Data.List.Extra(
+     ) where
+ 
+ import Partial
+-import Data.List
++import Data.List hiding (all, any, concat, concatMap, elem, foldl, foldl', foldr, length, null)
+ import Data.Maybe
+ import Data.Function
+ import Data.Char
+diff --git a/src/Data/List/NonEmpty/Extra.hs b/src/Data/List/NonEmpty/Extra.hs
+index 80f753e..f330af4 100644
+--- a/src/Data/List/NonEmpty/Extra.hs
++++ b/src/Data/List/NonEmpty/Extra.hs
+@@ -11,9 +11,10 @@ module Data.List.NonEmpty.Extra(
+     maximum1, minimum1, maximumBy1, minimumBy1, maximumOn1, minimumOn1
+     ) where
+ 
++import           Data.Foldable
+ import           Data.Function
+ import qualified Data.List.Extra as List
+-import           Data.List.NonEmpty
++import           Data.List.NonEmpty (NonEmpty(..), cons, fromList)
+ 
+ #if __GLASGOW_HASKELL__ <= 802
+ import Data.Semigroup ((<>))
+@@ -88,21 +89,21 @@ unionBy eq xs ys = fromList $ List.unionBy eq (toList xs) (toList ys)
+ 
+ -- | The largest element of a non-empty list.
+ maximum1 :: Ord a => NonEmpty a -> a
+-maximum1 = List.maximum
++maximum1 = maximum
+ 
+ -- | The least element of a non-empty list.
+ minimum1 :: Ord a => NonEmpty a -> a
+-minimum1 = List.minimum
++minimum1 = minimum
+ 
+ -- | The largest element of a non-empty list with respect to the given
+ --   comparison function.
+ maximumBy1 :: (a -> a -> Ordering) -> NonEmpty a -> a
+-maximumBy1 = List.maximumBy
++maximumBy1 = maximumBy
+ 
+ -- | The least element of a non-empty list with respect to the given
+ --   comparison function.
+ minimumBy1 :: (a -> a -> Ordering) -> NonEmpty a -> a
+-minimumBy1 = List.minimumBy
++minimumBy1 = minimumBy
+ 
+ -- | A version of 'maximum1' where the comparison is done on some extracted value.
+ maximumOn1 :: Ord b => (a -> b) -> NonEmpty a -> a
+diff --git a/src/System/Directory/Extra.hs b/src/System/Directory/Extra.hs
+index 0ededbf..10b3a0a 100644
+--- a/src/System/Directory/Extra.hs
++++ b/src/System/Directory/Extra.hs
+@@ -23,7 +23,7 @@ module System.Directory.Extra(
+ import System.Directory
+ import Control.Monad.Extra
+ import System.FilePath
+-import Data.List
++import Data.List (sort)
+ #if !MIN_VERSION_directory(1,2,3)
+ import Control.Exception
+ #endif
diff --git a/patches/focus-1.0.2.patch b/patches/focus-1.0.2.patch
new file mode 100644
index 0000000000000000000000000000000000000000..d7f57418804aeaa57847edd6d3e883b360a5aaf2
--- /dev/null
+++ b/patches/focus-1.0.2.patch
@@ -0,0 +1,12 @@
+diff --git a/library/Focus/Prelude.hs b/library/Focus/Prelude.hs
+index e0b8351..4c2a0ad 100644
+--- a/library/Focus/Prelude.hs
++++ b/library/Focus/Prelude.hs
+@@ -30,7 +30,6 @@ import Data.Functor as Exports
+ import Data.Int as Exports
+ import Data.IORef as Exports
+ import Data.Ix as Exports
+-import Data.List as Exports hiding (sortOn, isSubsequenceOf, uncons, concat, foldr, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, find, maximumBy, minimumBy, mapAccumL, mapAccumR, foldl')
+ import Data.Maybe as Exports
+ import Data.Monoid as Exports hiding (Last(..), First(..))
+ import Data.Ord as Exports
diff --git a/patches/free-algebras-0.1.0.1.patch b/patches/free-algebras-0.1.0.1.patch
index e27f47f1a72fbb1127373e40f62af964950ff052..68fe7e63fcb6644fdb7ae40ae917fdda52775ea3 100644
--- a/patches/free-algebras-0.1.0.1.patch
+++ b/patches/free-algebras-0.1.0.1.patch
@@ -1,3 +1,16 @@
+diff --git a/src/Data/Group/Free.hs b/src/Data/Group/Free.hs
+index 2c38244..b960595 100644
+--- a/src/Data/Group/Free.hs
++++ b/src/Data/Group/Free.hs
+@@ -29,7 +29,7 @@ import qualified Data.DList as DList
+ import           Data.DList.Unsafe (DList (..))
+ #endif
+ import           Data.Group (Group (..))
+-import           Data.List (foldl')
++import           Data.Foldable (foldl')
+ #if __GLASGOW_HASKELL__ < 808
+ import           Data.Semigroup (Semigroup (..))
+ #endif
 diff --git a/src/Data/Semigroup/Abelian.hs b/src/Data/Semigroup/Abelian.hs
 index 6567faf..c38b161 100644
 --- a/src/Data/Semigroup/Abelian.hs
diff --git a/patches/generic-deriving-1.14.patch b/patches/generic-deriving-1.14.patch
new file mode 100644
index 0000000000000000000000000000000000000000..5e2e3999f8e49276e56ef5d3522e7f8c1caf39ad
--- /dev/null
+++ b/patches/generic-deriving-1.14.patch
@@ -0,0 +1,14 @@
+diff --git a/src/Generics/Deriving/TH/Internal.hs b/src/Generics/Deriving/TH/Internal.hs
+index 303f49e..98598e1 100644
+--- a/src/Generics/Deriving/TH/Internal.hs
++++ b/src/Generics/Deriving/TH/Internal.hs
+@@ -17,8 +17,7 @@ module Generics.Deriving.TH.Internal where
+ import           Control.Monad (unless)
+ 
+ import           Data.Char (isAlphaNum, ord)
+-import           Data.Foldable (foldr')
+-import           Data.List
++import           Data.Foldable (foldr', foldl')
+ import qualified Data.Map as Map
+ import           Data.Map as Map (Map)
+ import           Data.Maybe (mapMaybe)
diff --git a/patches/happy-1.20.0.patch b/patches/happy-1.20.0.patch
new file mode 100644
index 0000000000000000000000000000000000000000..bc05f98cc3c99230a55def3a0045b9ab686e2b72
--- /dev/null
+++ b/patches/happy-1.20.0.patch
@@ -0,0 +1,48 @@
+diff --git a/src/GenUtils.lhs b/src/GenUtils.lhs
+index 1982c21..66ae2c3 100644
+--- a/src/GenUtils.lhs
++++ b/src/GenUtils.lhs
+@@ -16,7 +16,7 @@ All the code below is understood to be in the public domain.
+ 
+ > import Data.Char  (isAlphaNum)
+ > import Data.Ord   (comparing)
+-> import Data.List
++> import Data.List  (sortBy)
+ 
+ %------------------------------------------------------------------------------
+ 
+diff --git a/src/Grammar.lhs b/src/Grammar.lhs
+index d3ce625..4ede4c4 100644
+--- a/src/Grammar.lhs
++++ b/src/Grammar.lhs
+@@ -27,7 +27,7 @@ Here is our mid-section datatype
+ 
+ > import Data.Array
+ > import Data.Char
+-> import Data.List
++> import Data.List (findIndices, groupBy, intersperse, nub, sortBy, zip4)
+ > import Data.Maybe (fromMaybe)
+ 
+ > import Control.Monad.Writer
+diff --git a/src/ProduceCode.lhs b/src/ProduceCode.lhs
+index 2961c14..257a82c 100644
+--- a/src/ProduceCode.lhs
++++ b/src/ProduceCode.lhs
+@@ -16,7 +16,7 @@ The code generator.
+ 
+ > import Data.Maybe             ( isJust, isNothing, fromMaybe )
+ > import Data.Char
+-> import Data.List
++> import Data.List              (sortBy)
+ 
+ > import Control.Monad          ( forM_ )
+ > import Control.Monad.ST
+@@ -704,7 +704,7 @@ action array indexed by (terminal * last_state) + state
+ >               . shows n_states . str ") (["
+ >           . interleave' "," (map shows goto_offs)
+ >           . str "\n\t])\n\n"
+->           
++>
+ >           . str "happyAdjustOffset :: Prelude.Int -> Prelude.Int\n"
+ >           . str "happyAdjustOffset = Prelude.id\n\n"
+ >
diff --git a/patches/haskeline-0.7.5.0.patch b/patches/haskeline-0.7.5.0.patch
index f3eb2a0344e283ece89618d1bd47805c636c044a..105575754931469c01a00cece58e4bd6f87d652e 100644
--- a/patches/haskeline-0.7.5.0.patch
+++ b/patches/haskeline-0.7.5.0.patch
@@ -11,6 +11,19 @@ index 4186c27..2ec23e3 100644
      
      printLines = mapM_ (printText . (++ crlf))
      moveToNextLine _ = printText crlf
+diff --git a/System/Console/Haskeline/Backend/Posix.hsc b/System/Console/Haskeline/Backend/Posix.hsc
+index 678c97d..b960556 100644
+--- a/System/Console/Haskeline/Backend/Posix.hsc
++++ b/System/Console/Haskeline/Backend/Posix.hsc
+@@ -23,7 +23,7 @@ import Control.Concurrent hiding (throwTo)
+ import Data.Maybe (catMaybes)
+ import System.Posix.Signals.Exts
+ import System.Posix.Types(Fd(..))
+-import Data.List
++import Data.List (foldl')
+ import System.IO
+ import System.Environment
+ 
 diff --git a/System/Console/Haskeline/Backend/Terminfo.hs b/System/Console/Haskeline/Backend/Terminfo.hs
 index fb28553..6cbbd71 100644
 --- a/System/Console/Haskeline/Backend/Terminfo.hs
@@ -33,3 +46,16 @@ index fb28553..6cbbd71 100644
  
  -- Note that these move by a certain number of cells, not graphemes.
  changeRight, changeLeft :: Int -> ActionM ()
+diff --git a/System/Console/Haskeline/Command/History.hs b/System/Console/Haskeline/Command/History.hs
+index fbb1fa8..11eb3f7 100644
+--- a/System/Console/Haskeline/Command/History.hs
++++ b/System/Console/Haskeline/Command/History.hs
+@@ -5,7 +5,7 @@ import System.Console.Haskeline.Command
+ import System.Console.Haskeline.Key
+ import Control.Monad(liftM,mplus)
+ import System.Console.Haskeline.Monads
+-import Data.List
++import Data.List(isPrefixOf, unfoldr)
+ import Data.Maybe(fromMaybe)
+ import System.Console.Haskeline.History
+ import Data.IORef
diff --git a/patches/haskell-src-exts-1.23.1.patch b/patches/haskell-src-exts-1.23.1.patch
new file mode 100644
index 0000000000000000000000000000000000000000..4c98124ff6b46529f6cf3820b8ca83034beda85d
--- /dev/null
+++ b/patches/haskell-src-exts-1.23.1.patch
@@ -0,0 +1,13 @@
+diff --git a/src/Language/Haskell/Exts.hs b/src/Language/Haskell/Exts.hs
+index f45d392..4d95884 100644
+--- a/src/Language/Haskell/Exts.hs
++++ b/src/Language/Haskell/Exts.hs
+@@ -50,7 +50,7 @@ import Language.Haskell.Exts.ExactPrint
+ import Language.Haskell.Exts.SrcLoc
+ import Language.Haskell.Exts.Extension
+ 
+-import Data.List
++import Data.List (isSuffixOf, partition)
+ import Data.Maybe (fromMaybe)
+ import Language.Preprocessor.Unlit
+ import System.IO
diff --git a/patches/hgeometry-0.11.0.0.patch b/patches/hgeometry-0.11.0.0.patch
index 414389136d31688cad3c84d217d03171576c725f..1831a5c248b474c2faa2657307e8136d1be3ef06 100644
--- a/patches/hgeometry-0.11.0.0.patch
+++ b/patches/hgeometry-0.11.0.0.patch
@@ -11,6 +11,26 @@ index 020f940..5ddb701 100644
  
                , bifunctors              >= 4.1
                , bytestring              >= 0.10
+diff --git a/src/Algorithms/Geometry/ConvexHull/JarvisMarch.hs b/src/Algorithms/Geometry/ConvexHull/JarvisMarch.hs
+index 1cd961b..9316c53 100644
+--- a/src/Algorithms/Geometry/ConvexHull/JarvisMarch.hs
++++ b/src/Algorithms/Geometry/ConvexHull/JarvisMarch.hs
+@@ -93,13 +93,13 @@ lowerHull' pts = pruneVertical $ repeatedly cmp steepestCcwFrom s rest
+ -- with minimum slope w.r.t. the given point.
+ steepestCcwFrom   :: (Ord r, Num r)
+                => (Point 2 r :+ a) -> NonEmpty (Point 2 r :+ b)  -> Point 2 r :+ b
+-steepestCcwFrom p = List.minimumBy (ccwCmpAroundWith (Vector2 0 (-1)) p)
++steepestCcwFrom p = minimumBy (ccwCmpAroundWith (Vector2 0 (-1)) p)
+ 
+ -- | Find the next point in clockwise order, i.e. the point
+ -- with maximum slope w.r.t. the given point.
+ steepestCwFrom   :: (Ord r, Num r)
+                => (Point 2 r :+ a) -> NonEmpty (Point 2 r :+ b)  -> Point 2 r :+ b
+-steepestCwFrom p = List.minimumBy (cwCmpAroundWith (Vector2 0 1) p)
++steepestCwFrom p = minimumBy (cwCmpAroundWith (Vector2 0 1) p)
+ 
+ repeatedly       :: (a -> a -> Ordering) -> (a -> NonEmpty a -> a) -> a -> [a] -> NonEmpty a
+ repeatedly cmp f = go
 diff --git a/src/Data/Geometry/PolyLine.hs b/src/Data/Geometry/PolyLine.hs
 index c2c8209..6e041ef 100644
 --- a/src/Data/Geometry/PolyLine.hs
diff --git a/patches/hspec-core-2.7.9.patch b/patches/hspec-core-2.7.9.patch
new file mode 100644
index 0000000000000000000000000000000000000000..3cdb7fd60e1d92b2c8e93e5d2080dc76ebb667f6
--- /dev/null
+++ b/patches/hspec-core-2.7.9.patch
@@ -0,0 +1,13 @@
+diff --git a/src/Test/Hspec/Core/Util.hs b/src/Test/Hspec/Core/Util.hs
+index f0a3585..79b71b1 100644
+--- a/src/Test/Hspec/Core/Util.hs
++++ b/src/Test/Hspec/Core/Util.hs
+@@ -16,7 +16,7 @@ module Test.Hspec.Core.Util (
+ , formatException
+ ) where
+ 
+-import           Data.List
++import           Data.List (intercalate, isInfixOf)
+ import           Data.Char (isSpace)
+ import           GHC.IO.Exception
+ import           Control.Exception
diff --git a/patches/hspec-discover-2.7.9.patch b/patches/hspec-discover-2.7.9.patch
new file mode 100644
index 0000000000000000000000000000000000000000..48a9ac03c82c094eef14cdf1c5a5124d107c8fdf
--- /dev/null
+++ b/patches/hspec-discover-2.7.9.patch
@@ -0,0 +1,26 @@
+diff --git a/src/Test/Hspec/Discover/Run.hs b/src/Test/Hspec/Discover/Run.hs
+index 6d353f9..9fdd8c9 100644
+--- a/src/Test/Hspec/Discover/Run.hs
++++ b/src/Test/Hspec/Discover/Run.hs
+@@ -19,7 +19,7 @@ module Test.Hspec.Discover.Run (
+ ) where
+ import           Control.Monad
+ import           Control.Applicative
+-import           Data.List
++import           Data.List (intercalate, intersperse, stripPrefix)
+ import           Data.Char
+ import           Data.Maybe
+ import           Data.String
+diff --git a/src/Test/Hspec/Discover/Sort.hs b/src/Test/Hspec/Discover/Sort.hs
+index eb3123a..c4b09ad 100644
+--- a/src/Test/Hspec/Discover/Sort.hs
++++ b/src/Test/Hspec/Discover/Sort.hs
+@@ -6,7 +6,7 @@ module Test.Hspec.Discover.Sort (
+ 
+ import           Control.Arrow
+ import           Data.Char
+-import           Data.List
++import           Data.List (sortBy)
+ import           Data.Ord
+ 
+ sortNaturally :: [String] -> [String]
diff --git a/patches/hspec-expectations-0.8.2.patch b/patches/hspec-expectations-0.8.2.patch
new file mode 100644
index 0000000000000000000000000000000000000000..07e28d97b4ed7af7801677b63ed7b2b8c692ace9
--- /dev/null
+++ b/patches/hspec-expectations-0.8.2.patch
@@ -0,0 +1,13 @@
+diff --git a/src/Test/Hspec/Expectations/Matcher.hs b/src/Test/Hspec/Expectations/Matcher.hs
+index e39e030..7fe37e4 100644
+--- a/src/Test/Hspec/Expectations/Matcher.hs
++++ b/src/Test/Hspec/Expectations/Matcher.hs
+@@ -1,7 +1,7 @@
+ module Test.Hspec.Expectations.Matcher (matchList) where
+ 
+ import           Prelude hiding (showList)
+-import           Data.List
++import           Data.List ((\\), intersperse)
+ 
+ matchList :: (Show a, Eq a) => [a] -> [a] -> Maybe String
+ xs `matchList` ys
diff --git a/patches/hspec-wai-0.11.1.patch b/patches/hspec-wai-0.11.1.patch
new file mode 100644
index 0000000000000000000000000000000000000000..ca0eb68d46a88de05d45015d34b06ca8a7bdb6b1
--- /dev/null
+++ b/patches/hspec-wai-0.11.1.patch
@@ -0,0 +1,22 @@
+diff --git a/src/Test/Hspec/Wai/Util.hs b/src/Test/Hspec/Wai/Util.hs
+index 347af6d..10d1aed 100644
+--- a/src/Test/Hspec/Wai/Util.hs
++++ b/src/Test/Hspec/Wai/Util.hs
+@@ -4,7 +4,7 @@ module Test.Hspec.Wai.Util where
+ 
+ import           Control.Monad
+ import           Data.Maybe
+-import           Data.List
++import qualified Data.List as L
+ import           Data.Word
+ import           Data.Char hiding (ord)
+ import qualified Data.Char as Char
+@@ -39,7 +39,7 @@ toStrict :: LB.ByteString -> ByteString
+ toStrict = mconcat . LB.toChunks
+ 
+ formUrlEncodeQuery :: [(String, String)] -> LB.ByteString
+-formUrlEncodeQuery = Builder.toLazyByteString . mconcat . intersperse amp . map encodePair
++formUrlEncodeQuery = Builder.toLazyByteString . mconcat . L.intersperse amp . map encodePair
+   where
+     equals = Builder.word8 (ord '=')
+     amp = Builder.word8 (ord '&')
diff --git a/patches/http-types-0.12.3.patch b/patches/http-types-0.12.3.patch
new file mode 100644
index 0000000000000000000000000000000000000000..21b53358dacaab4741a2c6aae187f07429762f6b
--- /dev/null
+++ b/patches/http-types-0.12.3.patch
@@ -0,0 +1,13 @@
+diff --git a/Network/HTTP/Types/URI.hs b/Network/HTTP/Types/URI.hs
+index ce89e67..c1eb704 100644
+--- a/Network/HTTP/Types/URI.hs
++++ b/Network/HTTP/Types/URI.hs
+@@ -43,7 +43,7 @@ where
+ import           Control.Arrow
+ import           Data.Bits
+ import           Data.Char
+-import           Data.List
++import           Data.List (intersperse)
+ import           Data.Maybe
+ #if __GLASGOW_HASKELL__ < 710
+ import           Data.Monoid
diff --git a/patches/http2-2.0.6.patch b/patches/http2-2.0.6.patch
new file mode 100644
index 0000000000000000000000000000000000000000..b75fb0b6c63fe01115af3feabb050575926e6e31
--- /dev/null
+++ b/patches/http2-2.0.6.patch
@@ -0,0 +1,13 @@
+diff --git a/Imports.hs b/Imports.hs
+index 45bb5fb..f7d6c9e 100644
+--- a/Imports.hs
++++ b/Imports.hs
+@@ -19,7 +19,7 @@ import Data.Bits hiding (Bits)
+ import Data.ByteString.Internal (ByteString(..))
+ import Data.Foldable
+ import Data.Int
+-import Data.List
++import Data.List hiding (all, and, any, concat, concatMap, elem, find, foldl, foldl1, foldl', foldr, foldr1, length, maximum, maximumBy, minimum, minimumBy, notElem, null, or, product, sum)
+ import Data.Maybe
+ import Data.Monoid
+ import Data.Ord
diff --git a/patches/inspection-testing-0.4.3.0.patch b/patches/inspection-testing-0.4.3.0.patch
index fb3d21b3055e1eb618f86dd71dd551a9ddb49b6a..e89b5ec97cd2e934a41d848d3e196852e119eff7 100644
--- a/patches/inspection-testing-0.4.3.0.patch
+++ b/patches/inspection-testing-0.4.3.0.patch
@@ -95,17 +95,44 @@ index 7816010..45ec4b6 100644
  doesNotContainTypeClasses :: Slice -> [Name] -> Maybe (Var, CoreExpr, [TyCon])
  doesNotContainTypeClasses slice tcNs
 diff --git a/src/Test/Inspection/Plugin.hs b/src/Test/Inspection/Plugin.hs
-index e84a26c..d0023f2 100644
+index e84a26c..bd953af 100644
 --- a/src/Test/Inspection/Plugin.hs
 +++ b/src/Test/Inspection/Plugin.hs
-@@ -24,6 +24,10 @@ import GhcPlugins hiding (SrcLoc)
+@@ -12,7 +12,7 @@ import System.Exit
+ import Data.Either
+ import Data.Maybe
+ import Data.Bifunctor
+-import Data.List
++import Data.List (intercalate)
+ import qualified Data.Map.Strict as M
+ import qualified Language.Haskell.TH.Syntax as TH
+ 
+@@ -24,6 +24,14 @@ import GhcPlugins hiding (SrcLoc)
  import Outputable
  #endif
  
 +#if MIN_VERSION_ghc(9,1,0)
 +import GHC.Types.TyThing (lookupDataCon)
 +#endif
++
++#if MIN_VERSION_ghc(9,3,0)
++import GHC.Utils.Error (mkMCDiagnostic)
++#endif
 +
  import Test.Inspection (Obligation(..), Property(..), Result(..))
  import Test.Inspection.Core
  
+@@ -313,9 +321,13 @@ proofPass upon_failure report guts = do
+         (True, SkipO0) -> pure guts
+         (_   , _     ) -> do
+             when noopt $ do
++#if MIN_VERSION_GLASGOW_HASKELL(9,3,0,0)
++                msg (mkMCDiagnostic dflags WarningWithoutFlag)
++#else
+                 warnMsg
+ #if MIN_VERSION_GLASGOW_HASKELL(8,9,0,0)
+                     NoReason
++#endif
+ #endif
+                     $ fsep $ map text
+                     $ words "Test.Inspection: Compilation without -O detected. Expect optimizations to fail."
diff --git a/patches/invariant-0.5.4.patch b/patches/invariant-0.5.4.patch
index ec4d7cd9fccfe680b39b90c94afa6d6c59a33485..d9c03a648567fbecd0ace27059356deac877dfa0 100644
--- a/patches/invariant-0.5.4.patch
+++ b/patches/invariant-0.5.4.patch
@@ -28,9 +28,18 @@ index e68ec01..ce0ded0 100644
  instance Invariant (Arg a) where
    invmap = invmapFunctor
 diff --git a/src/Data/Functor/Invariant/TH.hs b/src/Data/Functor/Invariant/TH.hs
-index a94dd5d..b50c748 100644
+index a94dd5d..9914c00 100644
 --- a/src/Data/Functor/Invariant/TH.hs
 +++ b/src/Data/Functor/Invariant/TH.hs
+@@ -36,7 +36,7 @@ module Data.Functor.Invariant.TH (
+ import           Control.Monad (unless, when)
+ 
+ import           Data.Functor.Invariant.TH.Internal
+-import           Data.List
++import           Data.List (transpose, union)
+ import qualified Data.Map as Map ((!), fromList, keys, lookup, member, size)
+ import           Data.Maybe
+ 
 @@ -866,7 +866,11 @@ mkSimpleConMatch :: (Name -> [a] -> Q Exp)
                   -> Q Match
  mkSimpleConMatch fold conName insides = do
@@ -44,3 +53,18 @@ index a94dd5d..b50c748 100644
    rhs <- fold conName (zipWith (\i v -> i $ VarE v) insides varsNeeded)
    return $ Match pat (NormalB rhs) []
  
+diff --git a/src/Data/Functor/Invariant/TH/Internal.hs b/src/Data/Functor/Invariant/TH/Internal.hs
+index 57df84a..7d2464d 100644
+--- a/src/Data/Functor/Invariant/TH/Internal.hs
++++ b/src/Data/Functor/Invariant/TH/Internal.hs
+@@ -11,9 +11,8 @@ Template Haskell-related utilities.
+ -}
+ module Data.Functor.Invariant.TH.Internal where
+ 
+-import           Data.Foldable (foldr')
++import           Data.Foldable
+ import           Data.Functor.Invariant () -- To import the instances
+-import           Data.List
+ import qualified Data.Map as Map (singleton)
+ import           Data.Map (Map)
+ import           Data.Maybe (fromMaybe, mapMaybe)
diff --git a/patches/language-haskell-extract-0.2.4.patch b/patches/language-haskell-extract-0.2.4.patch
index e909c2f84ca14273c50d8fd5261d3c8a3d9c1633..1441330eb7dbfd3b0f6b8b5eff6785511f990eb4 100644
--- a/patches/language-haskell-extract-0.2.4.patch
+++ b/patches/language-haskell-extract-0.2.4.patch
@@ -1,5 +1,5 @@
 diff --git a/src/Language/Haskell/Extract.hs b/src/Language/Haskell/Extract.hs
-index 3e8958b..43dfe04 100644
+index 3e8958b..19ea3ee 100644
 --- a/src/Language/Haskell/Extract.hs
 +++ b/src/Language/Haskell/Extract.hs
 @@ -1,3 +1,4 @@
@@ -7,6 +7,15 @@ index 3e8958b..43dfe04 100644
  module Language.Haskell.Extract (
    functionExtractor,
    functionExtractorMap,
+@@ -5,7 +6,7 @@ module Language.Haskell.Extract (
+ ) where
+ import Language.Haskell.TH
+ import Text.Regex.Posix
+-import Data.List
++import Data.List (nub)
+ 
+ extractAllFunctions :: String -> Q [String]
+ extractAllFunctions pattern =
 @@ -25,7 +26,11 @@ extractAllFunctions pattern =
  functionExtractor :: String -> ExpQ
  functionExtractor pattern =
diff --git a/patches/lens-4.19.2.patch b/patches/lens-4.19.2.patch
index 898d619131b10b1fdbbf148543961e13112dddfb..3634bb537b025f75b2a0ff1dfc5364888ca7715d 100644
--- a/patches/lens-4.19.2.patch
+++ b/patches/lens-4.19.2.patch
@@ -1,15 +1,24 @@
 diff --git a/lens.cabal b/lens.cabal
-index 9b959ab..b576880 100644
+index 9b959ab..36b5e3c 100644
 --- a/lens.cabal
 +++ b/lens.cabal
 @@ -1,6 +1,7 @@
  name:          lens
  category:      Data, Lenses, Generics
  version:       4.19.2
-+x-revision: 2
++x-revision: 5
  license:       BSD2
  cabal-version: 1.18
  license-file:  LICENSE
+@@ -203,7 +204,7 @@ library
+     base-orphans              >= 0.5.2    && < 1,
+     bifunctors                >= 5.1      && < 6,
+     bytestring                >= 0.9.2.1  && < 0.11,
+-    call-stack                >= 0.1      && < 0.3,
++    call-stack                >= 0.1      && < 0.4,
+     comonad                   >= 4        && < 6,
+     contravariant             >= 1.3      && < 2,
+     containers                >= 0.4.0    && < 0.7,
 @@ -221,7 +222,7 @@ library
      semigroupoids             >= 5        && < 6,
      tagged                    >= 0.4.4    && < 1,
@@ -24,10 +33,19 @@ index 9b959ab..b576880 100644
        directory      >= 1.0,
        deepseq,
 -      doctest        >= 0.11.4 && < 0.12 || >= 0.13 && < 0.17,
-+      doctest        >= 0.11.4 && < 0.12 || >= 0.13 && < 0.18,
++      doctest        >= 0.11.4 && < 0.12 || >= 0.13 && < 0.19,
        filepath,
        generic-deriving,
        lens,
+@@ -457,7 +458,7 @@ test-suite doctests
+       simple-reflect >= 0.3.1,
+       text,
+       unordered-containers,
+-      vector
++      vector < 0.12.2
+ 
+ -- Basic benchmarks for the uniplate-style combinators
+ benchmark plated
 diff --git a/src/Control/Lens/At.hs b/src/Control/Lens/At.hs
 index d87825c..49b877b 100644
 --- a/src/Control/Lens/At.hs
@@ -146,9 +164,18 @@ index 1b65bae..aa01f6a 100644
       $ nub -- stable order
       $ toListOf typeVars t
 diff --git a/src/Control/Lens/Internal/PrismTH.hs b/src/Control/Lens/Internal/PrismTH.hs
-index e556aa3..0df8a12 100644
+index e556aa3..446cb7e 100644
 --- a/src/Control/Lens/Internal/PrismTH.hs
 +++ b/src/Control/Lens/Internal/PrismTH.hs
+@@ -30,7 +30,7 @@ import Control.Lens.Lens
+ import Control.Lens.Setter
+ import Control.Monad
+ import Data.Char (isUpper)
+-import Data.List
++import Data.List (delete, foldl', nub)
+ import Data.Set.Lens
+ import Data.Traversable
+ import Language.Haskell.TH
 @@ -204,7 +204,7 @@ stabToType stab@(Stab cx ty s t a b) = ForallT vs cx $
      ReviewType                   -> reviewTypeName  `conAppsT` [t,b]
  
diff --git a/patches/list-t-1.0.4.patch b/patches/list-t-1.0.4.patch
new file mode 100644
index 0000000000000000000000000000000000000000..d2fbaebd3f158c73d62a9b0ff42e6aaf5e87085d
--- /dev/null
+++ b/patches/list-t-1.0.4.patch
@@ -0,0 +1,20 @@
+diff --git a/library/ListT/Prelude.hs b/library/ListT/Prelude.hs
+index 1d5b2ce..87eabd5 100644
+--- a/library/ListT/Prelude.hs
++++ b/library/ListT/Prelude.hs
+@@ -1,5 +1,5 @@
+ module ListT.Prelude
+-( 
++(
+   module Exports,
+ )
+ where
+@@ -37,7 +37,7 @@ import Data.Functor as Exports
+ import Data.Int as Exports
+ import Data.IORef as Exports
+ import Data.Ix as Exports
+-import Data.List as Exports hiding (sortOn, isSubsequenceOf, uncons, concat, foldr, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, find, maximumBy, minimumBy, mapAccumL, mapAccumR, foldl')
++import Data.List as Exports hiding (sortOn, isSubsequenceOf, uncons, concat, foldr, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, find, maximumBy, minimumBy, mapAccumL, mapAccumR, foldl', length, null)
+ import Data.Maybe as Exports
+ import Data.Monoid as Exports hiding (getLast, getFirst, (<>), Last, First)
+ import Data.Ord as Exports
diff --git a/patches/network-3.1.2.1.patch b/patches/network-3.1.2.1.patch
new file mode 100644
index 0000000000000000000000000000000000000000..e3875ae80b178caa8d01cdf7f4a0f9a92b2c3d8c
--- /dev/null
+++ b/patches/network-3.1.2.1.patch
@@ -0,0 +1,13 @@
+diff --git a/Network/Socket/Imports.hs b/Network/Socket/Imports.hs
+index 9fba655..c0180f6 100644
+--- a/Network/Socket/Imports.hs
++++ b/Network/Socket/Imports.hs
+@@ -19,7 +19,7 @@ import Control.Applicative
+ import Control.Monad
+ import Data.Bits
+ import Data.Int
+-import Data.List
++import Data.List (find, foldl', intersperse)
+ import Data.Maybe
+ import Data.Monoid
+ import Data.Ord
diff --git a/patches/pandoc-2.13.patch b/patches/pandoc-2.13.patch
index faca437fb8159ba94a48188db4f68c6ed4f488a2..4f0aa61a9362b3fb81f38ec480793c055cf79ef2 100644
--- a/patches/pandoc-2.13.patch
+++ b/patches/pandoc-2.13.patch
@@ -72,6 +72,45 @@ index 7c6d017..ea62fea 100644
  smushBlocks :: [Blocks] -> Blocks
 -smushBlocks xs = foldl' combineBlocks mempty xs
 +smushBlocks xs = L.foldl' combineBlocks mempty xs
+diff --git a/src/Text/Pandoc/Readers/Docx/Lists.hs b/src/Text/Pandoc/Readers/Docx/Lists.hs
+index e63f845..a0fbe7a 100644
+--- a/src/Text/Pandoc/Readers/Docx/Lists.hs
++++ b/src/Text/Pandoc/Readers/Docx/Lists.hs
+@@ -17,7 +17,7 @@ module Text.Pandoc.Readers.Docx.Lists ( blocksToBullets
+                                       , listParagraphStyles
+                                       ) where
+ 
+-import Data.List
++import Data.List ((\\), delete, intersect)
+ import Data.Maybe
+ import Data.String (fromString)
+ import qualified Data.Text as T
+diff --git a/src/Text/Pandoc/Readers/Docx/Parse.hs b/src/Text/Pandoc/Readers/Docx/Parse.hs
+index f8ed248..aabd296 100644
+--- a/src/Text/Pandoc/Readers/Docx/Parse.hs
++++ b/src/Text/Pandoc/Readers/Docx/Parse.hs
+@@ -60,7 +60,7 @@ import Control.Monad.State.Strict
+ import Data.Bits ((.|.))
+ import qualified Data.ByteString.Lazy as B
+ import Data.Char (chr, ord, readLitChar)
+-import Data.List
++import Data.List (find)
+ import qualified Data.Map as M
+ import qualified Data.Text as T
+ import Data.Text (Text)
+diff --git a/src/Text/Pandoc/Readers/Odt/Arrows/State.hs b/src/Text/Pandoc/Readers/Odt/Arrows/State.hs
+index 96515bf..7b17cae 100644
+--- a/src/Text/Pandoc/Readers/Odt/Arrows/State.hs
++++ b/src/Text/Pandoc/Readers/Odt/Arrows/State.hs
+@@ -22,7 +22,7 @@ module Text.Pandoc.Readers.Odt.Arrows.State where
+ import Control.Arrow
+ import qualified Control.Category as Cat
+ import Control.Monad
+-import Data.List (foldl')
++import Data.Foldable (foldl')
+ import Text.Pandoc.Readers.Odt.Arrows.Utils
+ import Text.Pandoc.Readers.Odt.Generic.Fallible
+ 
 diff --git a/src/Text/Pandoc/Readers/Odt/ContentReader.hs b/src/Text/Pandoc/Readers/Odt/ContentReader.hs
 index df90880..e4cf1f8 100644
 --- a/src/Text/Pandoc/Readers/Odt/ContentReader.hs
@@ -99,3 +138,17 @@ index df90880..e4cf1f8 100644
  
  
  --
+diff --git a/src/Text/Pandoc/Writers/Texinfo.hs b/src/Text/Pandoc/Writers/Texinfo.hs
+index 6a33b42..9c66640 100644
+--- a/src/Text/Pandoc/Writers/Texinfo.hs
++++ b/src/Text/Pandoc/Writers/Texinfo.hs
+@@ -15,7 +15,8 @@ module Text.Pandoc.Writers.Texinfo ( writeTexinfo ) where
+ import Control.Monad.Except (throwError)
+ import Control.Monad.State.Strict
+ import Data.Char (chr, ord, isAlphaNum)
+-import Data.List (maximumBy, transpose, foldl')
++import Data.Foldable (maximumBy)
++import Data.List (transpose, foldl')
+ import Data.List.NonEmpty (nonEmpty)
+ import Data.Ord (comparing)
+ import qualified Data.Set as Set
diff --git a/patches/primitive-extras-0.10.1.patch b/patches/primitive-extras-0.10.1.patch
index 6b75bac9c2aad537aa23de7e728baeedddc2e5fc..17964bb740d13c2fa7e49986eedab174417764d0 100644
--- a/patches/primitive-extras-0.10.1.patch
+++ b/patches/primitive-extras-0.10.1.patch
@@ -82,3 +82,16 @@ index a1f6402..800b557 100644
        then do
          a <- indexSmallArrayM array (Bitmap.populatedIndex index indices)
          revealA a
+diff --git a/library/PrimitiveExtras/Prelude.hs b/library/PrimitiveExtras/Prelude.hs
+index 06809dd..2eb33de 100644
+--- a/library/PrimitiveExtras/Prelude.hs
++++ b/library/PrimitiveExtras/Prelude.hs
+@@ -35,7 +35,7 @@ import Data.Functor.Identity as Exports
+ import Data.Int as Exports
+ import Data.IORef as Exports
+ import Data.Ix as Exports
+-import Data.List as Exports hiding (sortOn, isSubsequenceOf, uncons, concat, foldr, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, find, maximumBy, minimumBy, mapAccumL, mapAccumR, foldl')
++import Data.List as Exports hiding (sortOn, isSubsequenceOf, uncons, concat, foldr, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, find, maximumBy, minimumBy, mapAccumL, mapAccumR, foldl', length, null)
+ import Data.Maybe as Exports
+ import Data.Monoid as Exports hiding (Last(..), First(..))
+ import Data.Ord as Exports
diff --git a/patches/safe-0.3.19.patch b/patches/safe-0.3.19.patch
new file mode 100644
index 0000000000000000000000000000000000000000..9af21d6d7afb13f2b8787ca60f4f63889087953a
--- /dev/null
+++ b/patches/safe-0.3.19.patch
@@ -0,0 +1,12 @@
+diff --git a/Safe.hs b/Safe.hs
+index 4c39eef..b4cb29d 100644
+--- a/Safe.hs
++++ b/Safe.hs
+@@ -62,6 +62,7 @@ import Data.Ix
+ import Data.List
+ import Data.Maybe
+ import Safe.Partial
++import Prelude hiding (null, minimum, maximum, foldl1, foldr1, length)
+ 
+ ---------------------------------------------------------------------
+ -- UTILITIES
diff --git a/patches/singletons-2.7.patch b/patches/singletons-2.7.patch
index 786234b93145bd4699548176bca8b2db4b8a7b62..e72b27e339d9ac32d4c67690198518f3de005343 100644
--- a/patches/singletons-2.7.patch
+++ b/patches/singletons-2.7.patch
@@ -1,3 +1,16 @@
+diff --git a/Setup.hs b/Setup.hs
+index de4a811..b31506c 100644
+--- a/Setup.hs
++++ b/Setup.hs
+@@ -3,7 +3,7 @@ module Main (main) where
+ 
+ import Control.Monad
+ 
+-import Data.List
++import Data.List (nub)
+ import Data.String
+ 
+ import Distribution.PackageDescription
 diff --git a/singletons.cabal b/singletons.cabal
 index c963f89..977bd1e 100644
 --- a/singletons.cabal
diff --git a/patches/singletons-base-3.0.patch b/patches/singletons-base-3.0.patch
index 7723774a2fb94387798f530b0355a9265917570e..fdbd44e1f290389ef3cfa142b2f81d622f55feff 100644
--- a/patches/singletons-base-3.0.patch
+++ b/patches/singletons-base-3.0.patch
@@ -1,3 +1,16 @@
+diff --git a/Setup.hs b/Setup.hs
+index 769a08f..6b81a5d 100644
+--- a/Setup.hs
++++ b/Setup.hs
+@@ -3,7 +3,7 @@ module Main (main) where
+ 
+ import Control.Monad
+ 
+-import Data.List
++import Data.List (nub)
+ import Data.String
+ 
+ import Distribution.PackageDescription
 diff --git a/src/GHC/Num/Singletons.hs b/src/GHC/Num/Singletons.hs
 index 2e85699..1463f9a 100644
 --- a/src/GHC/Num/Singletons.hs
diff --git a/patches/tasty-1.4.1.patch b/patches/tasty-1.4.1.patch
new file mode 100644
index 0000000000000000000000000000000000000000..0b97632c84abfc4e30a8c560a5b6d8e52289d16f
--- /dev/null
+++ b/patches/tasty-1.4.1.patch
@@ -0,0 +1,13 @@
+diff --git a/Test/Tasty/Patterns/Eval.hs b/Test/Tasty/Patterns/Eval.hs
+index 190bdbc..6bc7418 100644
+--- a/Test/Tasty/Patterns/Eval.hs
++++ b/Test/Tasty/Patterns/Eval.hs
+@@ -6,7 +6,7 @@ import Control.Monad.Reader
+ import Control.Monad.Error.Class (throwError) -- see #201
+ import qualified Data.Sequence as Seq
+ import Data.Foldable
+-import Data.List
++import Data.List (findIndex, intercalate, isInfixOf, isPrefixOf, tails)
+ import Data.Maybe
+ import Data.Char
+ import Test.Tasty.Patterns.Types
diff --git a/patches/th-desugar-1.11.patch b/patches/th-desugar-1.11.patch
index 3969210ea480b3284fad4e80364be468c771f27c..5565d596316b562ff707e3a2ea3d0b7e42bf817e 100644
--- a/patches/th-desugar-1.11.patch
+++ b/patches/th-desugar-1.11.patch
@@ -1,7 +1,16 @@
 diff --git a/Language/Haskell/TH/Desugar.hs b/Language/Haskell/TH/Desugar.hs
-index 626a689..adc1bb4 100644
+index 626a689..ba8f2c4 100644
 --- a/Language/Haskell/TH/Desugar.hs
 +++ b/Language/Haskell/TH/Desugar.hs
+@@ -134,7 +134,7 @@ import Language.Haskell.TH.Syntax
+ import Control.Monad
+ import qualified Data.Foldable as F
+ import Data.Function
+-import Data.List
++import Data.List (deleteFirstsBy)
+ import qualified Data.Map as M
+ import qualified Data.Set as S
+ import Prelude hiding ( exp )
 @@ -163,9 +163,9 @@ instance Desugar Cxt DCxt where
    desugar = dsCxt
    sweeten = cxtToTH
@@ -140,9 +149,18 @@ index 21b1fbe..a5f06ad 100644
  -- | Is this pattern guaranteed to match?
  isUniversalPattern :: DsMonad q => DPat -> q Bool
 diff --git a/Language/Haskell/TH/Desugar/Reify.hs b/Language/Haskell/TH/Desugar/Reify.hs
-index 7b35177..989ce4e 100644
+index 7b35177..fa9f1d5 100644
 --- a/Language/Haskell/TH/Desugar/Reify.hs
 +++ b/Language/Haskell/TH/Desugar/Reify.hs
+@@ -44,7 +44,7 @@ import qualified Data.Foldable as F
+ import Data.Foldable (foldMap)
+ #endif
+ import Data.Function (on)
+-import Data.List
++import Data.List (deleteFirstsBy, find)
+ import qualified Data.Map as Map
+ import Data.Map (Map)
+ import Data.Maybe
 @@ -53,6 +53,7 @@ import Data.Set (Set)
  
  import Language.Haskell.TH.Datatype
diff --git a/patches/th-desugar-1.12.patch b/patches/th-desugar-1.12.patch
index 8da2efebc19da7643dac63572802d5ce03be5f12..e33f21935832777cf209fd4d5ddaab08f52f123c 100644
--- a/patches/th-desugar-1.12.patch
+++ b/patches/th-desugar-1.12.patch
@@ -1,3 +1,15 @@
+diff --git a/Language/Haskell/TH/Desugar.hs b/Language/Haskell/TH/Desugar.hs
+index 1907259..c872f11 100644
+--- a/Language/Haskell/TH/Desugar.hs
++++ b/Language/Haskell/TH/Desugar.hs
+@@ -136,7 +136,6 @@ import Language.Haskell.TH.Syntax
+ import Control.Monad
+ import qualified Data.Foldable as F
+ import Data.Function
+-import Data.List
+ import qualified Data.Map as M
+ import qualified Data.Set as S
+ import Prelude hiding ( exp )
 diff --git a/Language/Haskell/TH/Desugar/Core.hs b/Language/Haskell/TH/Desugar/Core.hs
 index 0a6fe1d..ba9e12d 100644
 --- a/Language/Haskell/TH/Desugar/Core.hs
@@ -34,6 +46,19 @@ index 0a6fe1d..ba9e12d 100644
  dsPat (InfixP p1 name p2) = DConP name <$> mapM dsPat [p1, p2]
  dsPat (UInfixP _ _ _) =
    fail "Cannot desugar unresolved infix operators."
+diff --git a/Language/Haskell/TH/Desugar/Reify.hs b/Language/Haskell/TH/Desugar/Reify.hs
+index 54fd408..e368523 100644
+--- a/Language/Haskell/TH/Desugar/Reify.hs
++++ b/Language/Haskell/TH/Desugar/Reify.hs
+@@ -44,7 +44,7 @@ import qualified Data.Foldable as F
+ import Data.Foldable (foldMap)
+ #endif
+ import Data.Function (on)
+-import Data.List
++import Data.List (deleteFirstsBy, find)
+ import qualified Data.Map as Map
+ import Data.Map (Map)
+ import Data.Maybe
 diff --git a/Language/Haskell/TH/Desugar/Sweeten.hs b/Language/Haskell/TH/Desugar/Sweeten.hs
 index 1512ddb..efa9ace 100644
 --- a/Language/Haskell/TH/Desugar/Sweeten.hs
diff --git a/patches/tls-1.5.5.patch b/patches/tls-1.5.5.patch
new file mode 100644
index 0000000000000000000000000000000000000000..81bf80ceb06e614574776554c316949492429dfd
--- /dev/null
+++ b/patches/tls-1.5.5.patch
@@ -0,0 +1,13 @@
+diff --git a/Network/TLS/Imports.hs b/Network/TLS/Imports.hs
+index 6910476..a9a29a5 100644
+--- a/Network/TLS/Imports.hs
++++ b/Network/TLS/Imports.hs
+@@ -40,7 +40,7 @@ import Control.Monad
+ import Control.Monad.Fail (MonadFail)
+ #endif
+ import Data.Bits
+-import Data.List
++import Data.List hiding (all, any, concat, concatMap, elem, foldl, foldr, length, maximum, notElem, null, sum)
+ import Data.Maybe hiding (fromJust)
+ import Data.Semigroup
+ import Data.Ord
diff --git a/patches/uniplate-1.6.13.patch b/patches/uniplate-1.6.13.patch
new file mode 100644
index 0000000000000000000000000000000000000000..2def0a953a1365b246c7fca91eb7271025e0e339
--- /dev/null
+++ b/patches/uniplate-1.6.13.patch
@@ -0,0 +1,13 @@
+diff --git a/Data/Generics/Uniplate/Internal/Data.hs b/Data/Generics/Uniplate/Internal/Data.hs
+index dd755da..30ae012 100644
+--- a/Data/Generics/Uniplate/Internal/Data.hs
++++ b/Data/Generics/Uniplate/Internal/Data.hs
+@@ -12,7 +12,7 @@ import Data.Generics.Uniplate.Internal.Utils
+ import Data.Data
+ import Data.Generics
+ import Data.Maybe
+-import Data.List
++import Data.List (inits, tails)
+ import Data.IORef
+ import Control.Exception
+ import Control.Monad
diff --git a/patches/vector-builder-0.3.8.1.patch b/patches/vector-builder-0.3.8.1.patch
new file mode 100644
index 0000000000000000000000000000000000000000..eb08ec301374934e8833682899854ab63861a94c
--- /dev/null
+++ b/patches/vector-builder-0.3.8.1.patch
@@ -0,0 +1,12 @@
+diff --git a/library/VectorBuilder/Prelude.hs b/library/VectorBuilder/Prelude.hs
+index dea2307..a5c3514 100644
+--- a/library/VectorBuilder/Prelude.hs
++++ b/library/VectorBuilder/Prelude.hs
+@@ -35,7 +35,6 @@ import Data.Functor.Contravariant as Exports
+ import Data.Int as Exports
+ import Data.IORef as Exports
+ import Data.Ix as Exports
+-import Data.List as Exports hiding (sortOn, isSubsequenceOf, uncons, concat, foldr, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, find, maximumBy, minimumBy, mapAccumL, mapAccumR, foldl')
+ import Data.List.NonEmpty as Exports (NonEmpty(..))
+ import Data.Maybe as Exports
+ import Data.Monoid as Exports hiding (Alt)
diff --git a/patches/wai-extra-3.1.6.patch b/patches/wai-extra-3.1.6.patch
new file mode 100644
index 0000000000000000000000000000000000000000..9dcb791e6d232ed99421e60ce14cff6f842ee202
--- /dev/null
+++ b/patches/wai-extra-3.1.6.patch
@@ -0,0 +1,13 @@
+diff --git a/Network/Wai/UrlMap.hs b/Network/Wai/UrlMap.hs
+index 34db6fc..9cd2920 100644
+--- a/Network/Wai/UrlMap.hs
++++ b/Network/Wai/UrlMap.hs
+@@ -26,7 +26,7 @@ module Network.Wai.UrlMap (
+ ) where
+ 
+ import Control.Applicative
+-import Data.List
++import Data.List (stripPrefix)
+ import Data.Text (Text)
+ import qualified Data.Text as T
+ import qualified Data.Text.Encoding as T
diff --git a/patches/warp-3.3.14.patch b/patches/warp-3.3.14.patch
index cd14a4aa60699a6eae857dd30630ccba5d36ca3c..b993ee02faed202f5a09f31fa7db65d8cc004a9e 100644
--- a/patches/warp-3.3.14.patch
+++ b/patches/warp-3.3.14.patch
@@ -17,6 +17,19 @@ index 0000000..c4496ad
 +word8ToWordCompat# :: Word# -> Word#
 +word8ToWordCompat# x = x
 +#endif
+diff --git a/Network/Wai/Handler/Warp/Imports.hs b/Network/Wai/Handler/Warp/Imports.hs
+index 00bd56a..a266dc7 100644
+--- a/Network/Wai/Handler/Warp/Imports.hs
++++ b/Network/Wai/Handler/Warp/Imports.hs
+@@ -18,7 +18,7 @@ import Control.Monad
+ import Data.Bits
+ import Data.ByteString.Internal (ByteString(..))
+ import Data.Int
+-import Data.List
++import Data.List hiding (null)
+ import Data.List.NonEmpty (NonEmpty(..))
+ import Data.Maybe
+ import Data.Monoid
 diff --git a/Network/Wai/Handler/Warp/ReadInt.hs b/Network/Wai/Handler/Warp/ReadInt.hs
 index 25cf498..2783c2e 100644
 --- a/Network/Wai/Handler/Warp/ReadInt.hs
diff --git a/patches/x509-validation-1.6.11.patch b/patches/x509-validation-1.6.11.patch
new file mode 100644
index 0000000000000000000000000000000000000000..7ffae5dccfd85ebef1c937e95d083da0352feb24
--- /dev/null
+++ b/patches/x509-validation-1.6.11.patch
@@ -0,0 +1,13 @@
+diff --git a/Data/X509/Validation.hs b/Data/X509/Validation.hs
+index be57efb..0aaded7 100644
+--- a/Data/X509/Validation.hs
++++ b/Data/X509/Validation.hs
+@@ -45,7 +45,7 @@ import Data.X509.Validation.Types
+ import Data.Hourglass
+ import System.Hourglass
+ import Data.Maybe
+-import Data.List
++import Data.List (find, intersect)
+ 
+ -- | Possible reason of certificate and chain failure.
+ --
diff --git a/patches/xlsx-0.8.3.patch b/patches/xlsx-0.8.3.patch
index e200ffdf4f49e400fed0315f1bd9986f9690a7a7..f51842c54f12b77c13a25f6834ef3c33237940bb 100644
--- a/patches/xlsx-0.8.3.patch
+++ b/patches/xlsx-0.8.3.patch
@@ -39,6 +39,19 @@ index 67e8bcb..f15f691 100644
  cellValueAtXY :: (Int, Int) -> Lens' Worksheet (Maybe CellValue)
 -cellValueAtXY = cellValueAtRC . swap
 +cellValueAtXY i = cellValueAtRC $ swap i
+diff --git a/src/Codec/Xlsx/Parser.hs b/src/Codec/Xlsx/Parser.hs
+index a210c5b..f013201 100644
+--- a/src/Codec/Xlsx/Parser.hs
++++ b/src/Codec/Xlsx/Parser.hs
+@@ -34,7 +34,7 @@ import Data.ByteString (ByteString)
+ import qualified Data.ByteString.Lazy as L
+ import qualified Data.ByteString.Lazy as LB
+ import Data.ByteString.Lazy.Char8 ()
+-import Data.List
++import Data.List (foldl', stripPrefix)
+ import Data.Map (Map)
+ import qualified Data.Map as M
+ import Data.Maybe
 diff --git a/src/Codec/Xlsx/Types/Drawing.hs b/src/Codec/Xlsx/Types/Drawing.hs
 index 9e42ae8..badc384 100644
 --- a/src/Codec/Xlsx/Types/Drawing.hs
diff --git a/patches/yaml-0.11.5.0.patch b/patches/yaml-0.11.5.0.patch
new file mode 100644
index 0000000000000000000000000000000000000000..7bf18d1e0e2ce5feb1fcde7b22d42e287d7c70d0
--- /dev/null
+++ b/patches/yaml-0.11.5.0.patch
@@ -0,0 +1,13 @@
+diff --git a/src/Data/Yaml/Internal.hs b/src/Data/Yaml/Internal.hs
+index a2082af..8be3eb0 100644
+--- a/src/Data/Yaml/Internal.hs
++++ b/src/Data/Yaml/Internal.hs
+@@ -42,7 +42,7 @@ import qualified Data.ByteString.Builder as BB
+ import qualified Data.ByteString.Lazy as BL
+ import Data.ByteString.Builder.Scientific (scientificBuilder)
+ import Data.Char (toUpper, ord)
+-import Data.List
++import Data.List ((\\), foldl')
+ import Data.Conduit ((.|), ConduitM, runConduit)
+ import qualified Data.Conduit.List as CL
+ import qualified Data.HashMap.Strict as M