Add a MonadFix instance for Seq (#449)
authorDavid Feuer <David.Feuer@gmail.com>
Mon, 18 Dec 2017 05:10:39 +0000 (00:10 -0500)
committerGitHub <noreply@github.com>
Mon, 18 Dec 2017 05:10:39 +0000 (00:10 -0500)
Data/Sequence/Internal.hs
changelog.md
tests/seq-properties.hs

index 12d27f8..179fc93 100644 (file)
@@ -262,6 +262,7 @@ import Utils.Containers.Internal.StrictPair (StrictPair (..), toPair)
 #if MIN_VERSION_base(4,4,0)
 import Control.Monad.Zip (MonadZip (..))
 #endif
+import Control.Monad.Fix (MonadFix (..), fix)
 
 default ()
 
@@ -434,6 +435,17 @@ instance Monad Seq where
       where add ys x = ys >< f x
     (>>) = (*>)
 
+instance MonadFix Seq where
+    mfix = mfixSeq
+
+-- This is just like the instance for lists, but we can take advantage of
+-- constant-time length and logarithmic-time indexing to speed things up.
+-- Using fromFunction, we make this about as lazy as we can.
+mfixSeq :: (a -> Seq a) -> Seq a
+mfixSeq f = fromFunction (length (f err)) (\k -> fix (\xk -> f xk `index` k))
+  where
+    err = error "mfix for Data.Sequence.Seq applied to strict function"
+
 instance Applicative Seq where
     pure = singleton
     xs *> ys = cycleNTimes (length xs) ys
index 42b4b33..5f28e4b 100644 (file)
@@ -1,8 +1,18 @@
 # Changelog for [`containers` package](http://github.com/haskell/containers)
 
+## 0.5.11
+
+* Sped up unstable sorting for `Data.Sequence` (Thanks, Donacha
+  Oisín Kidney!)
+
+* Made compatible with the upcoming export of `<>` from the
+  `Prelude` (Thanks, Herbert Valerio Riedel!)
+
+* Added a `MonadFix` instance for `Data.Sequence`.
+
 ## 0.5.10.2
 
-* Planned for GHC 8.2.
+* Released with GHC 8.2.
 
 * Use `COMPLETE` pragmas to declare complete sets of pattern synonyms
   for `Data.Sequence`. At last!
index 35cdab2..8272ac9 100644 (file)
@@ -44,6 +44,7 @@ import Test.Framework.Providers.QuickCheck2
 import Control.Monad.Zip (MonadZip (..))
 #endif
 import Control.DeepSeq (deepseq)
+import Control.Monad.Fix (MonadFix (..))
 
 
 main :: IO ()
@@ -139,6 +140,7 @@ main = defaultMain
        , testProperty "cycleTaking" prop_cycleTaking
        , testProperty "intersperse" prop_intersperse
        , testProperty ">>=" prop_bind
+       , testProperty "mfix" test_mfix
 #if __GLASGOW_HASKELL__ >= 800
        , testProperty "Empty pattern" prop_empty_pat
        , testProperty "Empty constructor" prop_empty_con
@@ -807,6 +809,24 @@ prop_bind :: Seq A -> Fun A (Seq B) -> Bool
 prop_bind xs (Fun _ f) =
     toList' (xs >>= f) ~= (toList xs >>= toList . f)
 
+-- MonadFix operation
+
+-- It's exceedingly difficult to construct a proper QuickCheck
+-- property for mfix because the function passed to it must be
+-- lazy. The following property is really just a unit test in
+-- disguise, and not a terribly meaningful one.
+test_mfix :: Property
+test_mfix = toList resS === resL
+  where
+    facty :: (Int -> Int) -> Int -> Int
+    facty _ 0 = 1; facty f n = n * f (n - 1)
+
+    resS :: Seq Int
+    resS = fmap ($ 12) $ mfix (\f -> fromList [facty f, facty (+1), facty (+2)])
+
+    resL :: [Int]
+    resL = fmap ($ 12) $ mfix (\f -> [facty f, facty (+1), facty (+2)])
+
 -- Simple test monad
 
 data M a = Action Int a