control-monad-omega 0.3.2 → 0.3.3

raw patch · 6 files changed

+149/−42 lines, 6 filesdep +control-monad-omegadep +tastydep +tasty-benchdep −faildep ~basesetup-changednew-uploaderPVP ok

version bump matches the API change (PVP)

Dependencies added: control-monad-omega, tasty, tasty-bench, tasty-quickcheck

Dependencies removed: fail

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +24/−0
• Control/Monad/Omega.hs +36/−10
• Setup.hs +0/−2
• bench/Bench.hs +13/−0
• control-monad-omega.cabal +43/−30
• test/Properties.hs +33/−0

@@ -0,0 +1,24 @@+# 0.3.3++* Speed up `Applicative` / `Alternative` / `MonadPlus` instances.+* Speed up `(>>=)`: add a trick to check whether a callback is `const []`.++# 0.3.2++* Add `MonadFail` instance.++# 0.3.1++* Add `Alternative` instance.++# 0.3++* Add `MonadPlus` instance.++# 0.2++* Change `diagonal`.++# 0.1++* Initial release.

@@ -1,4 +1,6 @@ {-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}+{-# HLINT ignore "Avoid restricted function" #-} ---------------------------------------------- -- | -- Module    : Control.Monad.Omega@@ -41,12 +43,14 @@     (diagonal, Omega, runOmega, each)  where -import qualified Control.Monad as Monad import qualified Control.Applicative as Applicative+import Control.Exception+import qualified Control.Monad as Monad+import qualified Control.Monad.Fail as Fail import qualified Data.Foldable as Foldable+import Data.List (tails) import qualified Data.Traversable as Traversable--import qualified Control.Monad.Fail as Fail+import System.IO.Unsafe  -- | This is the hinge algorithm of the Omega monad, -- exposed because it can be useful on its own.  Joins @@ -73,27 +77,49 @@     fmap f (Omega xs) = Omega (map f xs)  instance Monad Omega where-    return x = Omega [x]-    Omega m >>= f = Omega $ diagonal $ map (runOmega . f) m+    return = pure+    Omega m >>= f+        | isConstEmpty f = Omega []+        | otherwise = Omega $ diagonal $ map (runOmega . f) m  #if !(MIN_VERSION_base(4,13,0))     fail = Fail.fail #endif +data MyException = MyException+  deriving (Show)++instance Exception MyException++isConstEmpty :: (a -> Omega b) -> Bool+isConstEmpty f = unsafePerformIO $ do+  ret <- try $ evaluate $ f (throw MyException)+  pure $ case ret of+    Left MyException -> False+    Right (Omega xs) -> null xs++ instance Fail.MonadFail Omega where     fail _ = Omega []  instance Monad.MonadPlus Omega where-    mzero = Omega []-    mplus (Omega xs) (Omega ys) = Omega (diagonal [xs,ys])+    mzero = Applicative.empty+    mplus = (Applicative.<|>)  instance Applicative.Applicative Omega where-    pure = return-    (<*>) = Monad.ap+    pure = Omega . (:[])+    liftA2 f (Omega xs) = Omega . go [] . runOmega+        where+            go initYs [] = concatMap (flip (zipWith f) initYs) (tails xs)+            go initYs (y : ys) = zipWith f xs initYs  ++ go (y : initYs) ys  instance Applicative.Alternative Omega where     empty = Omega []-    Omega xs <|> Omega ys = Omega (diagonal [xs,ys])+    Omega xs <|> Omega ys = Omega $ interleave xs ys++interleave :: [a] -> [a] -> [a]+interleave [] ys = ys+interleave (x : xs) ys = x : interleave ys xs  instance Foldable.Foldable Omega where     foldMap f (Omega xs) = Foldable.foldMap f xs

@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain

@@ -0,0 +1,13 @@+module Main where++import Control.Applicative+import Control.Monad.Omega+import Prelude hiding (Applicative)+import Test.Tasty.Bench++main :: IO ()+main = defaultMain+  [ bench "liftA2" $ nf+    (\n -> sum $ runOmega $ liftA2 (+) (each [0..n]) (each [0..n]))+    (100 :: Int)+  ]

@@ -1,36 +1,49 @@-cabal-version: 1.12-Name: control-monad-omega-Description:+cabal-version:   2.0+name:            control-monad-omega+version:         0.3.3+license:         PublicDomain+maintainer:      lrpalmer@gmail.com+author:          Luke Palmer+tested-with:+    ghc ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.8 || ==9.4.8 || ==9.6.6 || ==9.8.2 || ==9.10.1++homepage:        http://github.com/luqui/control-monad-omega+synopsis:        A breadth-first list monad.+description:     A monad for enumerating sets: like the list     monad but breadth-first.-Version: 0.3.2-Stability: experimental-Synopsis: A breadth-first list monad.-License: PublicDomain-Category: Control-Homepage: http://github.com/luqui/control-monad-omega-Author: Luke Palmer-Maintainer: lrpalmer@gmail.com-Build-Type: Simple-Tested-With:-  GHC ==7.0.4-   || ==7.2.2-   || ==7.4.2-   || ==7.6.3-   || ==7.8.4-   || ==7.10.3-   || ==8.0.2-   || ==8.2.2-   || ==8.4.4-   || ==8.6.5-   || ==8.8.1 +category:        Control+build-type:      Simple+extra-doc-files: CHANGELOG.md++source-repository head+    type:     git+    location: https://github.com/luqui/control-monad-omega+ library-  Default-Language: Haskell2010-  Build-Depends: base >=4.3 && <5-  Exposed-Modules: Control.Monad.Omega-  Other-Extensions: CPP+    exposed-modules:  Control.Monad.Omega+    default-language: Haskell2010+    other-extensions: CPP+    build-depends:    base >=4.10 && <5 -  if !impl(ghc >= 8.0)+test-suite omega-tests+    type:             exitcode-stdio-1.0+    main-is:          Properties.hs+    hs-source-dirs:   test+    default-language: Haskell2010     build-depends:-      fail >= 4.9.0.0 && <5+        base,+        control-monad-omega,+        tasty,+        tasty-quickcheck++benchmark omega-bench+    type:             exitcode-stdio-1.0+    main-is:          Bench.hs+    hs-source-dirs:   bench+    default-language: Haskell2010+    build-depends:+        base,+        control-monad-omega,+        tasty-bench

@@ -0,0 +1,33 @@+{-# LANGUAGE ScopedTypeVariables #-}++module Main where++import Control.Applicative (Applicative(..), (<|>))+import Control.Monad (join)+import Control.Monad.Omega+import Data.List (sort)+import Prelude hiding (Applicative(..))+import Test.Tasty+import Test.Tasty.QuickCheck++main :: IO ()+main = defaultMain $ testGroup "All"+  [ testProperty "pure" $ \(x :: Int) ->+    sort (runOmega (pure x)) ===+      sort (pure x)+  , testProperty "liftA2" $ \(xs :: [Int]) ys ->+    sort (runOmega (liftA2 (+) (each xs) (each ys))) ===+      sort (liftA2 (+) xs ys)+  , testProperty "(<|>)" $ \(xs :: [Int]) ys ->+    sort (runOmega (each xs <|> each ys)) ===+      sort (xs <|> ys)+  , testProperty "join" $ \(xss :: [[Int]]) ->+    sort (runOmega (join (each (map each xss)))) ===+      sort (join xss)++  , testProperty "liftA2 vs. join" $ \(xs :: [Int]) ys ->+    let f x y = x * 10 + y in+    runOmega (liftA2 f (each xs) (each ys)) ===+      runOmega (join (each (map (\x -> each (map (\y -> f x y) ys)) xs)))+  ]+