intervals 0.7.2 → 0.8

raw patch · 12 files changed

+622/−197 lines, 12 filesdep ~doctestsetup-changednew-uploaderPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: doctest

API changes (from Hackage documentation)

Files

• .travis.yml +121/−1
• CHANGELOG.markdown +10/−0
• README.markdown +1/−1
• Setup.lhs +165/−38
• intervals.cabal +10/−4
• src/Numeric/Interval.hs +6/−0
• src/Numeric/Interval/Internal.hs +106/−30
• src/Numeric/Interval/Kaucher.hs +93/−22
• src/Numeric/Interval/NonEmpty.hs +6/−0
• src/Numeric/Interval/NonEmpty/Internal.hs +79/−25
• tests/doctests.hs +25/−0
• tests/doctests.hsc +0/−76

@@ -1,1 +1,121 @@-language: haskell+# This file has been generated -- see https://github.com/hvr/multi-ghc-travis+language: c+sudo: false++cache:+  directories:+    - $HOME/.cabsnap+    - $HOME/.cabal/packages++before_cache:+  - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log+  - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.tar++matrix:+  include:+    - env: CABALVER=1.18 GHCVER=7.0.4+      compiler: ": #GHC 7.0.4"+      addons: {apt: {packages: [cabal-install-1.18,ghc-7.0.4], sources: [hvr-ghc]}}+    - env: CABALVER=1.18 GHCVER=7.2.2+      compiler: ": #GHC 7.2.2"+      addons: {apt: {packages: [cabal-install-1.18,ghc-7.2.2], sources: [hvr-ghc]}}+    - env: CABALVER=1.18 GHCVER=7.4.2+      compiler: ": #GHC 7.4.2"+      addons: {apt: {packages: [cabal-install-1.18,ghc-7.4.2], sources: [hvr-ghc]}}+    - env: CABALVER=1.18 GHCVER=7.6.3+      compiler: ": #GHC 7.6.3"+      addons: {apt: {packages: [cabal-install-1.18,ghc-7.6.3], sources: [hvr-ghc]}}+    - env: CABALVER=1.18 GHCVER=7.8.4+      compiler: ": #GHC 7.8.4"+      addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}}+    - env: CABALVER=1.24 GHCVER=7.10.3+      compiler: ": #GHC 7.10.3"+      addons: {apt: {packages: [cabal-install-1.24,ghc-7.10.3], sources: [hvr-ghc]}}+    - env: CABALVER=1.24 GHCVER=8.0.2+      compiler: ": #GHC 8.0.2"+      addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.2], sources: [hvr-ghc]}}+    - env: CABALVER=1.24 GHCVER=8.2.1+      compiler: ": #GHC 8.2.1"+      addons: {apt: {packages: [cabal-install-1.24,ghc-8.2.1], sources: [hvr-ghc]}}+    - env: CABALVER=1.24 GHCVER=head+      compiler: ": #GHC head"+      addons: {apt: {packages: [cabal-install-1.24,ghc-head], sources: [hvr-ghc]}}++  allow_failures:+    - env: CABALVER=1.18 GHCVER=7.0.4+    - env: CABALVER=1.18 GHCVER=7.2.2+    - env: CABALVER=1.24 GHCVER=head++before_install:+ - unset CC+ - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH++install:+ - cabal --version+ - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"+ - if [ -f $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz ];+   then+     zcat $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz >+          $HOME/.cabal/packages/hackage.haskell.org/00-index.tar;+   fi+ - travis_retry cabal update -v+ - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config+ - cabal install --only-dependencies --enable-tests --dry -v > installplan.txt+ - sed -i -e '1,/^Resolving /d' installplan.txt; cat installplan.txt++# check whether current requested install-plan matches cached package-db snapshot+ - if diff -u installplan.txt $HOME/.cabsnap/installplan.txt;+   then+     echo "cabal build-cache HIT";+     rm -rfv .ghc;+     cp -a $HOME/.cabsnap/ghc $HOME/.ghc;+     cp -a $HOME/.cabsnap/lib $HOME/.cabsnap/share $HOME/.cabsnap/bin $HOME/.cabal/;+   else+     echo "cabal build-cache MISS";+     rm -rf $HOME/.cabsnap;+     mkdir -p $HOME/.ghc $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin;+     cabal install -j --only-dependencies --enable-tests;+   fi++# snapshot package-db on cache miss+ - if [ ! -d $HOME/.cabsnap ];+   then+      echo "snapshotting package-db to build-cache";+      mkdir $HOME/.cabsnap;+      cp -a $HOME/.ghc $HOME/.cabsnap/ghc;+      cp -a $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin installplan.txt $HOME/.cabsnap/;+   fi++# Here starts the actual work to be performed for the package under+# test; any command which exits with a non-zero exit code causes the+# build to fail.+script:+ # -v2 provides useful information for debugging+ - cabal configure --enable-tests -v2++ # this builds all libraries and executables+ # (including tests/benchmarks)+ - cabal build++ # tests that a source-distribution can be generated+ - cabal sdist++ # check that the generated source-distribution can be built & installed+ - export SRC_TGZ=$(cabal info . | awk '{print $2 ".tar.gz";exit}') ;+   cd dist/;+   if [ -f "$SRC_TGZ" ]; then+      cabal install --force-reinstalls "$SRC_TGZ";+   else+      echo "expected '$SRC_TGZ' not found";+      exit 1;+   fi++notifications:+  irc:+    channels:+      - "irc.freenode.org#haskell-lens"+    skip_join: true+    template:+      - "\x0313intervals\x03/\x0306%{branch}\x03 \x0314%{commit}\x03 %{build_url} %{message}"++# EOF

@@ -1,3 +1,13 @@+0.8+---+* `Eq` and `Ord` instances are now structural+* Deprecate `elem` and `notElem` in favor of `member` and `nonMember`+* Add `iquot`, `irem`, `idiv`, and `imod` functions+* Relax `Fractional` constraint in `deflate` to `Num`+* Revamp `Setup.hs` to use `cabal-doctest`. This makes it build+  with `Cabal-2.0`, and makes the `doctest`s work with `cabal new-build` and+  sandboxes.+ 0.7.2 ----- * Redundant constraint cleanup

@@ -1,7 +1,7 @@ intervals ========== -[![Hackage](https://img.shields.io/hackage/v/intervals.svg)](https://hackage.haskell.org/package/intervals) [![Build Status](https://secure.travis-ci.org/ekmett/intervals.png?branch=master)](http://travis-ci.org/ekmett/intervals)+[![Hackage](https://img.shields.io/hackage/v/intervals.svg)](https://hackage.haskell.org/package/intervals) [![Build Status](https://secure.travis-ci.org/ekmett/intervals.svg?branch=master)](http://travis-ci.org/ekmett/intervals)  Basic interval arithmetic 

@@ -1,55 +1,182 @@-#!/usr/bin/runhaskell \begin{code}-{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-} module Main (main) where +#ifndef MIN_VERSION_cabal_doctest+#define MIN_VERSION_cabal_doctest(x,y,z) 0+#endif+++#if MIN_VERSION_cabal_doctest(1,0,0)+import Distribution.Extra.Doctest ( defaultMainWithDoctests )+#else++-- Otherwise we provide a shim++#ifndef MIN_VERSION_Cabal+#define MIN_VERSION_Cabal(x,y,z) 0+#endif+#ifndef MIN_VERSION_directory+#define MIN_VERSION_directory(x,y,z) 0+#endif+#if MIN_VERSION_Cabal(1,24,0)+#define InstalledPackageId UnitId+#endif++import Control.Monad ( when ) import Data.List ( nub )-import Data.Version ( showVersion )-import Distribution.Package ( PackageName(PackageName), Package, PackageId, InstalledPackageId, packageVersion, packageName )-import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) )+import Data.String ( fromString )+import Distribution.Package ( InstalledPackageId )+import Distribution.Package ( PackageId, Package (..), packageVersion )+import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) , Library (..), BuildInfo (..)) import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks )-import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose, copyFiles )+import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose ) import Distribution.Simple.BuildPaths ( autogenModulesDir )-import Distribution.Simple.Setup ( BuildFlags(buildVerbosity), Flag(..), fromFlag, HaddockFlags(haddockDistPref))-import Distribution.Simple.LocalBuildInfo ( withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps) )-import Distribution.Text ( display )-import Distribution.Verbosity ( Verbosity, normal )+import Distribution.Simple.Setup ( BuildFlags(buildDistPref, buildVerbosity), fromFlag)+import Distribution.Simple.LocalBuildInfo ( withPackageDB, withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps), compiler )+import Distribution.Simple.Compiler ( showCompilerId , PackageDB (..))+import Distribution.Text ( display , simpleParse ) import System.FilePath ( (</>) ) -main :: IO ()-main = defaultMainWithHooks simpleUserHooks-  { buildHook = \pkg lbi hooks flags -> do-     generateBuildModule (fromFlag (buildVerbosity flags)) pkg lbi-     buildHook simpleUserHooks pkg lbi hooks flags-  , postHaddock = \args flags pkg lbi -> do-     copyFiles normal (haddockOutputDir flags pkg) []-     postHaddock simpleUserHooks args flags pkg lbi-  }+#if MIN_VERSION_Cabal(1,25,0)+import Distribution.Simple.BuildPaths ( autogenComponentModulesDir )+#endif -haddockOutputDir :: Package p => HaddockFlags -> p -> FilePath-haddockOutputDir flags pkg = destDir where-  baseDir = case haddockDistPref flags of-    NoFlag -> "."-    Flag x -> x-  destDir = baseDir </> "doc" </> "html" </> display (packageName pkg)+#if MIN_VERSION_directory(1,2,2)+import System.Directory (makeAbsolute)+#else+import System.Directory (getCurrentDirectory)+import System.FilePath (isAbsolute) -generateBuildModule :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO ()-generateBuildModule verbosity pkg lbi = do-  let dir = autogenModulesDir lbi-  createDirectoryIfMissingVerbose verbosity True dir-  withLibLBI pkg lbi $ \_ libcfg -> do-    withTestLBI pkg lbi $ \suite suitecfg -> do-      rewriteFile (dir </> "Build_" ++ testName suite ++ ".hs") $ unlines-        [ "module Build_" ++ testName suite ++ " where"-        , "deps :: [String]"-        , "deps = " ++ (show $ formatdeps (testDeps libcfg suitecfg))+makeAbsolute :: FilePath -> IO FilePath+makeAbsolute p | isAbsolute p = return p+               | otherwise    = do+    cwd <- getCurrentDirectory+    return $ cwd </> p+#endif++generateBuildModule :: String -> BuildFlags -> PackageDescription -> LocalBuildInfo -> IO ()+generateBuildModule testsuiteName flags pkg lbi = do+  let verbosity = fromFlag (buildVerbosity flags)+  let distPref = fromFlag (buildDistPref flags)++  -- Package DBs+  let dbStack = withPackageDB lbi ++ [ SpecificPackageDB $ distPref </> "package.conf.inplace" ]+  let dbFlags = "-hide-all-packages" : packageDbArgs dbStack++  withLibLBI pkg lbi $ \lib libcfg -> do+    let libBI = libBuildInfo lib++    -- modules+    let modules = exposedModules lib ++ otherModules libBI+    -- it seems that doctest is happy to take in module names, not actual files!+    let module_sources = modules++    -- We need the directory with library's cabal_macros.h!+#if MIN_VERSION_Cabal(1,25,0)+    let libAutogenDir = autogenComponentModulesDir lbi libcfg+#else+    let libAutogenDir = autogenModulesDir lbi+#endif++    -- Lib sources and includes+    iArgs <- mapM (fmap ("-i"++) . makeAbsolute) $ libAutogenDir : hsSourceDirs libBI+    includeArgs <- mapM (fmap ("-I"++) . makeAbsolute) $ includeDirs libBI++    -- CPP includes, i.e. include cabal_macros.h+    let cppFlags = map ("-optP"++) $+            [ "-include", libAutogenDir ++ "/cabal_macros.h" ]+            ++ cppOptions libBI++    withTestLBI pkg lbi $ \suite suitecfg -> when (testName suite == fromString testsuiteName) $ do++      -- get and create autogen dir+#if MIN_VERSION_Cabal(1,25,0)+      let testAutogenDir = autogenComponentModulesDir lbi suitecfg+#else+      let testAutogenDir = autogenModulesDir lbi+#endif+      createDirectoryIfMissingVerbose verbosity True testAutogenDir++      -- write autogen'd file+      rewriteFile (testAutogenDir </> "Build_doctests.hs") $ unlines+        [ "module Build_doctests where"+        , ""+        -- -package-id etc. flags+        , "pkgs :: [String]"+        , "pkgs = " ++ (show $ formatDeps $ testDeps libcfg suitecfg)+        , ""+        , "flags :: [String]"+        , "flags = " ++ show (iArgs ++ includeArgs ++ dbFlags ++ cppFlags)+        , ""+        , "module_sources :: [String]"+        , "module_sources = " ++ show (map display module_sources)         ]   where-    formatdeps = map (formatone . snd)-    formatone p = case packageName p of-      PackageName n -> n ++ "-" ++ showVersion (packageVersion p)+    -- we do this check in Setup, as then doctests don't need to depend on Cabal+    isOldCompiler = maybe False id $ do+      a <- simpleParse $ showCompilerId $ compiler lbi+      b <- simpleParse "7.5"+      return $ packageVersion (a :: PackageId) < b +    formatDeps = map formatOne+    formatOne (installedPkgId, pkgId)+      -- The problem is how different cabal executables handle package databases+      -- when doctests depend on the library+      | packageId pkg == pkgId = "-package=" ++ display pkgId+      | otherwise              = "-package-id=" ++ display installedPkgId++    -- From Distribution.Simple.Program.GHC+    packageDbArgs :: [PackageDB] -> [String]+    packageDbArgs | isOldCompiler = packageDbArgsConf+                  | otherwise     = packageDbArgsDb++    -- GHC <7.6 uses '-package-conf' instead of '-package-db'.+    packageDbArgsConf :: [PackageDB] -> [String]+    packageDbArgsConf dbstack = case dbstack of+      (GlobalPackageDB:UserPackageDB:dbs) -> concatMap specific dbs+      (GlobalPackageDB:dbs)               -> ("-no-user-package-conf")+                                           : concatMap specific dbs+      _ -> ierror+      where+        specific (SpecificPackageDB db) = [ "-package-conf=" ++ db ]+        specific _                      = ierror+        ierror = error $ "internal error: unexpected package db stack: "+                      ++ show dbstack++    -- GHC >= 7.6 uses the '-package-db' flag. See+    -- https://ghc.haskell.org/trac/ghc/ticket/5977.+    packageDbArgsDb :: [PackageDB] -> [String]+    -- special cases to make arguments prettier in common scenarios+    packageDbArgsDb dbstack = case dbstack of+      (GlobalPackageDB:UserPackageDB:dbs)+        | all isSpecific dbs              -> concatMap single dbs+      (GlobalPackageDB:dbs)+        | all isSpecific dbs              -> "-no-user-package-db"+                                           : concatMap single dbs+      dbs                                 -> "-clear-package-db"+                                           : concatMap single dbs+     where+       single (SpecificPackageDB db) = [ "-package-db=" ++ db ]+       single GlobalPackageDB        = [ "-global-package-db" ]+       single UserPackageDB          = [ "-user-package-db" ]+       isSpecific (SpecificPackageDB _) = True+       isSpecific _                     = False+ testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)] testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys++defaultMainWithDoctests :: String -> IO ()+defaultMainWithDoctests testSuiteName = defaultMainWithHooks simpleUserHooks+  { buildHook = \pkg lbi hooks flags -> do+     generateBuildModule testSuiteName flags pkg lbi+     buildHook simpleUserHooks pkg lbi hooks flags+  }++#endif++main :: IO ()+main = defaultMainWithDoctests "doctests"  \end{code}

@@ -1,5 +1,5 @@ name:              intervals-version:           0.7.2+version:           0.8 synopsis:          Interval Arithmetic description:   A 'Numeric.Interval.Interval' is a closed, convex set of floating point values.@@ -17,7 +17,7 @@ category:           Math build-type:         Custom cabal-version:      >=1.8-tested-with:        GHC == 7.4.2, GHC == 7.6.1, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10, GHC == 8.0.1+tested-with:        GHC == 7.4.2, GHC == 7.6.1, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.1 extra-source-files:   .travis.yml   CHANGELOG.markdown@@ -28,6 +28,12 @@   type: git   location: git://github.com/ekmett/intervals.git +custom-setup+  setup-depends:+    base >= 4 && <5,+    Cabal,+    cabal-doctest >= 1 && <1.1+ -- You can disable the doctests test suite with -f-test-doctests flag test-doctests   description: Enable (or disable via f-test-doctests) the doctest suite when@@ -72,13 +78,13 @@   ghc-options:    -Wall -threaded   hs-source-dirs: tests -  if !flag(test-doctests) || impl(ghc >= 8)+  if !flag(test-doctests)     buildable: False   else     build-depends:       base,       directory      >= 1.0,-      doctest        >= 0.9.1,+      doctest        >= 0.11.1 && <0.12,       filepath,       QuickCheck,       template-haskell

@@ -18,6 +18,8 @@   , empty   , null   , singleton+  , member+  , notMember   , elem   , notElem   , inf@@ -40,6 +42,10 @@   , possibly, (<?), (<=?), (==?), (>=?), (>?)   , idouble   , ifloat+  , iquot+  , irem+  , idiv+  , imod   ) where  import Numeric.Interval.Internal

@@ -26,6 +26,8 @@   , empty   , null   , singleton+  , member+  , notMember   , elem   , notElem   , inf@@ -48,6 +50,10 @@   , possibly, (<?), (<=?), (==?), (>=?), (>?)   , idouble   , ifloat+  , iquot+  , irem+  , idiv+  , imod   ) where  import Control.Exception as Exception@@ -68,7 +74,8 @@ -- $setup  data Interval a = I !a !a | Empty deriving-  ( Data+  ( Eq, Ord+  , Data   , Typeable #if __GLASGOW_HASKELL__ >= 704   , Generic@@ -191,10 +198,6 @@ singular (I a b) = a == b {-# INLINE singular #-} -instance Eq a => Eq (Interval a) where-  (==) = (==!)-  {-# INLINE (==) #-}- instance Show a => Show (Interval a) where   showsPrec _ Empty = showString "Empty"   showsPrec n (I a b) =@@ -295,7 +298,7 @@ -- -- >>> deflate 1.0 empty -- Empty-deflate :: (Fractional a, Ord a) => a -> Interval a -> Interval a+deflate :: (Num a, Ord a) => a -> Interval a -> Interval a deflate _ Empty               = Empty deflate x (I a b) | a' <= b'  = I a' b'                   | otherwise = Empty@@ -400,6 +403,44 @@  -- | Determine if a point is in the interval. --+-- >>> member 3.2 (1.0 ... 5.0)+-- True+--+-- >>> member 5 (1.0 ... 5.0)+-- True+--+-- >>> member 1 (1.0 ... 5.0)+-- True+--+-- >>> member 8 (1.0 ... 5.0)+-- False+--+-- >>> member 5 empty+-- False+--+member :: Ord a => a -> Interval a -> Bool+member x (I a b) = x >= a && x <= b+member _ Empty = False+{-# INLINE member #-}++-- | Determine if a point is not included in the interval+--+-- >>> notMember 8 (1.0 ... 5.0)+-- True+--+-- >>> notMember 1.4 (1.0 ... 5.0)+-- False+--+-- And of course, nothing is a member of the empty interval.+--+-- >>> notMember 5 empty+-- True+notMember :: Ord a => a -> Interval a -> Bool+notMember x xs = not (member x xs)+{-# INLINE notMember #-}++-- | Determine if a point is in the interval.+-- -- >>> elem 3.2 (1.0 ... 5.0) -- True --@@ -416,9 +457,9 @@ -- False -- elem :: Ord a => a -> Interval a -> Bool-elem x (I a b) = x >= a && x <= b-elem _ Empty = False+elem = member {-# INLINE elem #-}+{-# DEPRECATED elem "Use `member` instead." #-}  -- | Determine if a point is not included in the interval --@@ -433,8 +474,9 @@ -- >>> notElem 5 empty -- True notElem :: Ord a => a -> Interval a -> Bool-notElem x xs = not (elem x xs)+notElem = notMember {-# INLINE notElem #-}+{-# DEPRECATED notElem "Use `notMember` instead." #-}  -- | 'realToFrac' will use the midpoint instance Real a => Real (Interval a) where@@ -444,27 +486,6 @@     b = toRational rb   {-# INLINE toRational #-} -instance Ord a => Ord (Interval a) where-  compare Empty Empty = EQ-  compare Empty _ = LT-  compare _ Empty = GT-  compare (I ax bx) (I ay by)-    | bx < ay = LT-    | ax > by = GT-    | bx == ay && ax == by = EQ-    | otherwise = Exception.throw AmbiguousComparison-  {-# INLINE compare #-}--  max (I a b) (I a' b') = max a a' ... max b b'-  max Empty i = i-  max i Empty = i-  {-# INLINE max #-}--  min (I a b) (I a' b') = min a a' ... min b b'-  min Empty _ = Empty-  min _ Empty = Empty-  {-# INLINE min #-}- -- @'divNonZero' X Y@ assumes @0 `'notElem'` Y@ divNonZero :: (Fractional a, Ord a) => Interval a -> Interval a -> Interval a divNonZero (I a b) (I a' b') =@@ -886,3 +907,58 @@ -- sin 1 :: Interval Double  default (Integer,Double)++-- | an interval containing all x `quot` y+-- >>> (5 `quot` 3) `member` ((4...6) `iquot` (2...4))+-- True+-- >>> (1...10) `iquot` ((-5)...4)+-- *** Exception: divide by zero+iquot :: Integral a => Interval a -> Interval a -> Interval a+iquot i j = case (i,j) of+  (Empty,_) -> Empty+  (_,Empty) -> Empty+  (I l u , I l' u') ->+    if l' <= 0 && 0 <= u' then throw DivideByZero else I+      (minimum [a `quot` b | a <- [l,u], b <- [l',u']])+      (maximum [a `quot` b | a <- [l,u], b <- [l',u']])++-- | an interval containing all x `rem` y+-- >>> (5 `rem` 3) `member` ((4...6) `irem` (2...4))+-- True+-- >>> (1...10) `irem` ((-5)...4)+-- *** Exception: divide by zero+irem :: Integral a => Interval a -> Interval a -> Interval a+irem i j = case (i,j) of+  (Empty,_) -> Empty+  (_,Empty) -> Empty+  (I l u , I l' u') ->+    if l' <= 0 && 0 <= u' then throw DivideByZero else I+      (minimum [0, signum l * (abs u' - 1), signum l * (abs l' - 1)])+      (maximum [0, signum u * (abs u' - 1), signum u * (abs l' - 1)])++-- | an interval containing all x `div` y+-- >>> (5 `div` 3) `member` ((4...6) `idiv` (2...4))+-- True+-- >>> (1...10) `idiv` ((-5)...4)+-- *** Exception: divide by zero+idiv :: Integral a => Interval a -> Interval a -> Interval a+idiv i j = case (i,j) of+  (Empty,_) -> Empty+  (_,Empty) -> Empty+  (I l u , I l' u') ->+    if l' <= 0 && 0 <= u' then throw DivideByZero else I+      (min (l `Prelude.div` max 1 l') (u `Prelude.div` min (-1) u'))+      (max (u `Prelude.div` max 1 l') (l `Prelude.div` min (-1) u'))++-- | an interval containing all x `mod` y+-- >>> (5 `mod` 3) `member` ((4...6) `imod` (2...4))+-- True+-- >>> (1...10) `imod` ((-5)...4)+-- *** Exception: divide by zero+imod :: Integral a => Interval a -> Interval a -> Interval a+imod i j = case (i,j) of+  (Empty,_) -> Empty+  (_,Empty) -> Empty+  (_ , I l' u') ->+    if l' <= 0 && 0 <= u' then throw DivideByZero else+      I (min (l'+1) 0) (max 0 (u'-1))

@@ -13,7 +13,7 @@ -- Stability   :  experimental -- Portability :  DeriveDataTypeable ----- "Directed" Interval arithmetic+-- \"Directed\" Interval arithmetic -- ----------------------------------------------------------------------------- @@ -25,6 +25,8 @@   , empty   , null   , singleton+  , member+  , notMember   , elem   , notElem   , inf@@ -47,6 +49,10 @@   , clamp   , idouble   , ifloat+  , iquot+  , irem+  , idiv+  , imod   ) where  import Control.Applicative hiding (empty)@@ -70,7 +76,8 @@ -- $setup  data Interval a = I !a !a deriving-  ( Data+  ( Eq, Ord+  , Data   , Typeable #if __GLASGOW_HASKELL__ >= 704   , Generic@@ -207,10 +214,6 @@ singular x = not (null x) && inf x == sup x {-# INLINE singular #-} -instance Eq a => Eq (Interval a) where-  (==) = (==!)-  {-# INLINE (==) #-}- instance Show a => Show (Interval a) where   showsPrec n (I a b) =     showParen (n > 3) $@@ -379,6 +382,43 @@  -- | Determine if a point is in the interval. --+-- >>> member 3.2 (1.0 ... 5.0)+-- True+--+-- >>> member 5 (1.0 ... 5.0)+-- True+--+-- >>> member 1 (1.0 ... 5.0)+-- True+--+-- >>> member 8 (1.0 ... 5.0)+-- False+--+-- >>> member 5 empty+-- False+--+member :: Ord a => a -> Interval a -> Bool+member x (I a b) = x >= a && x <= b+{-# INLINE member #-}++-- | Determine if a point is not included in the interval+--+-- >>> notMember 8 (1.0 ... 5.0)+-- True+--+-- >>> notMember 1.4 (1.0 ... 5.0)+-- False+--+-- And of course, nothing is a member of the empty interval.+--+-- >>> notMember 5 empty+-- True+notMember :: Ord a => a -> Interval a -> Bool+notMember x xs = not (member x xs)+{-# INLINE notMember #-}++-- | Determine if a point is in the interval.+-- -- >>> elem 3.2 (1.0 ... 5.0) -- True --@@ -395,8 +435,9 @@ -- False -- elem :: Ord a => a -> Interval a -> Bool-elem x xs = x >= inf xs && x <= sup xs+elem = member {-# INLINE elem #-}+{-# DEPRECATED elem "Use `member` instead." #-}  -- | Determine if a point is not included in the interval --@@ -411,8 +452,9 @@ -- >>> notElem 5 empty -- True notElem :: Ord a => a -> Interval a -> Bool-notElem x xs = not (elem x xs)+notElem = notMember {-# INLINE notElem #-}+{-# DEPRECATED notElem "Use `notMember` instead." #-}  -- | 'realToFrac' will use the midpoint instance Real a => Real (Interval a) where@@ -424,20 +466,6 @@       b = toRational (sup x)   {-# INLINE toRational #-} -instance Ord a => Ord (Interval a) where-  compare x y-    | sup x < inf y = LT-    | inf x > sup y = GT-    | sup x == inf y && inf x == sup y = EQ-    | otherwise = Exception.throw AmbiguousComparison-  {-# INLINE compare #-}--  max (I a b) (I a' b') = max a a' ... max b b'-  {-# INLINE max #-}--  min (I a b) (I a' b') = min a a' ... min b b'-  {-# INLINE min #-}- -- @'divNonZero' X Y@ assumes @0 `'notElem'` Y@ divNonZero :: (Fractional a, Ord a) => Interval a -> Interval a -> Interval a divNonZero (I a b) (I a' b') =@@ -829,3 +857,46 @@   default (Integer,Double)++-- | an interval containing all x `quot` y+-- >>> (5 `quot` 3) `member` ((4...6) `iquot` (2...4))+-- True+-- >>> (1...10) `iquot` ((-5)...4)+-- *** Exception: divide by zero+iquot :: Integral a => Interval a -> Interval a -> Interval a+iquot (I l u) (I l' u') =+  if l' <= 0 && 0 <= u' then throw DivideByZero else I+    (minimum [a `quot` b | a <- [l,u], b <- [l',u']])+    (maximum [a `quot` b | a <- [l,u], b <- [l',u']])++-- | an interval containing all x `rem` y+-- >>> (5 `rem` 3) `member` ((4...6) `irem` (2...4))+-- True+-- >>> (1...10) `irem` ((-5)...4)+-- *** Exception: divide by zero+irem :: Integral a => Interval a -> Interval a -> Interval a+irem (I l u) (I l' u') =+  if l' <= 0 && 0 <= u' then throw DivideByZero else I+    (minimum [0, signum l * (abs u' - 1), signum l * (abs l' - 1)])+    (maximum [0, signum u * (abs u' - 1), signum u * (abs l' - 1)])++-- | an interval containing all x `div` y+-- >>> (5 `div` 3) `member` ((4...6) `idiv` (2...4))+-- True+-- >>> (1...10) `idiv` ((-5)...4)+-- *** Exception: divide by zero+idiv :: Integral a => Interval a -> Interval a -> Interval a+idiv (I l u) (I l' u') =+  if l' <= 0 && 0 <= u' then throw DivideByZero else I+    (min (l `Prelude.div` max 1 l') (u `Prelude.div` min (-1) u'))+    (max (u `Prelude.div` max 1 l') (l `Prelude.div` min (-1) u'))++-- | an interval containing all x `mod` y+-- >>> (5 `mod` 3) `member` ((4...6) `imod` (2...4))+-- True+-- >>> (1...10) `imod` ((-5)...4)+-- *** Exception: divide by zero+imod :: Integral a => Interval a -> Interval a -> Interval a+imod _ (I l' u') =+  if l' <= 0 && 0 <= u' then throw DivideByZero else+    I (min (l'+1) 0) (max 0 (u'-1))

@@ -23,6 +23,8 @@   , interval   , whole   , singleton+  , member+  , notMember   , elem   , notElem   , inf@@ -46,6 +48,10 @@   , scale, symmetric   , idouble   , ifloat+  , iquot+  , irem+  , idiv+  , imod   ) where  import Numeric.Interval.NonEmpty.Internal

@@ -22,6 +22,8 @@   , interval   , whole   , singleton+  , member+  , notMember   , elem   , notElem   , inf@@ -45,6 +47,10 @@   , scale, symmetric   , idouble   , ifloat+  , iquot+  , irem+  , idiv+  , imod   ) where  import Control.Exception as Exception@@ -66,15 +72,16 @@ -- >>> :set -XExtendedDefaultRules -- >>> default (Integer,Double) -- >>> instance (Ord a, Arbitrary a) => Arbitrary (Interval a) where arbitrary = (...) <$> arbitrary <*> arbitrary--- >>> let elementOf xs = sized $ \n -> case n of { 0 -> pure $ inf xs; 1 -> pure $ sup xs; _ -> choose (inf xs, sup xs); }--- >>> let conservative sf f xs = forAll (choose (inf xs, sup xs)) $ \x -> (sf x) `elem` (f xs)--- >>> let conservative2 sf f xs ys = forAll ((,) <$> choose (inf xs, sup xs) <*> choose (inf ys, sup ys)) $ \(x,y) -> (sf x y) `elem` (f xs ys)--- >>> let conservativeExceptNaN sf f xs = forAll (choose (inf xs, sup xs)) $ \x -> isNaN (sf x) || (sf x) `elem` (f xs)+-- >>> let memberOf xs = sized $ \n -> case n of { 0 -> pure $ inf xs; 1 -> pure $ sup xs; _ -> choose (inf xs, sup xs); }+-- >>> let conservative sf f xs = forAll (choose (inf xs, sup xs)) $ \x -> (sf x) `member` (f xs)+-- >>> let conservative2 sf f xs ys = forAll ((,) <$> choose (inf xs, sup xs) <*> choose (inf ys, sup ys)) $ \(x,y) -> (sf x y) `member` (f xs ys)+-- >>> let conservativeExceptNaN sf f xs = forAll (choose (inf xs, sup xs)) $ \x -> isNaN (sf x) || (sf x) `member` (f xs) -- >>> let compose2 = fmap . fmap -- >>> let commutative op a b = (a `op` b) == (b `op` a)  data Interval a = I !a !a deriving-  ( Data+  ( Eq, Ord+  , Data   , Typeable #if __GLASGOW_HASKELL__ >= 704   , Generic@@ -194,10 +201,6 @@ singular (I a b) = a == b {-# INLINE singular #-} -instance Eq a => Eq (Interval a) where-  (==) = (==!)-  {-# INLINE (==) #-}- instance Show a => Show (Interval a) where   showsPrec n (I a b) =     showParen (n > 3) $@@ -331,6 +334,34 @@  -- | Determine if a point is in the interval. --+-- >>> member 3.2 (1.0 ... 5.0)+-- True+--+-- >>> member 5 (1.0 ... 5.0)+-- True+--+-- >>> member 1 (1.0 ... 5.0)+-- True+--+-- >>> member 8 (1.0 ... 5.0)+-- False+member :: Ord a => a -> Interval a -> Bool+member x (I a b) = x >= a && x <= b+{-# INLINE member #-}++-- | Determine if a point is not included in the interval+--+-- >>> notMember 8 (1.0 ... 5.0)+-- True+--+-- >>> notMember 1.4 (1.0 ... 5.0)+-- False+notMember :: Ord a => a -> Interval a -> Bool+notMember x xs = not (member x xs)+{-# INLINE notMember #-}++-- | Determine if a point is in the interval.+-- -- >>> elem 3.2 (1.0 ... 5.0) -- True --@@ -343,8 +374,9 @@ -- >>> elem 8 (1.0 ... 5.0) -- False elem :: Ord a => a -> Interval a -> Bool-elem x (I a b) = x >= a && x <= b+elem = member {-# INLINE elem #-}+{-# DEPRECATED elem "Use `member` instead." #-}  -- | Determine if a point is not included in the interval --@@ -354,8 +386,9 @@ -- >>> notElem 1.4 (1.0 ... 5.0) -- False notElem :: Ord a => a -> Interval a -> Bool-notElem x xs = not (elem x xs)+notElem = notMember {-# INLINE notElem #-}+{-# DEPRECATED notElem "Use `notMember` instead." #-}  -- | 'realToFrac' will use the midpoint instance Real a => Real (Interval a) where@@ -364,20 +397,6 @@     b = toRational rb   {-# INLINE toRational #-} -instance Ord a => Ord (Interval a) where-  compare (I ax bx) (I ay by)-    | bx < ay = LT-    | ax > by = GT-    | bx == ay && ax == by = EQ-    | otherwise = Exception.throw AmbiguousComparison-  {-# INLINE compare #-}--  max (I a b) (I a' b') = max a a' ... max b b'-  {-# INLINE max #-}--  min (I a b) (I a' b') = min a a' ... min b b'-  {-# INLINE min #-}- -- @'divNonZero' X Y@ assumes @0 `'notElem'` Y@ divNonZero :: (Fractional a, Ord a) => Interval a -> Interval a -> Interval a divNonZero (I a b) (I a' b') =@@ -822,3 +841,38 @@ -- sin 1 :: Interval Double  default (Integer,Double)++-- | an interval containing all x `quot` y+-- prop> forAll (memberOf xs) $ \ x -> forAll (memberOf ys) $ \ y -> 0 `notMember` ys ==> (x `quot` y) `member` (xs `iquot` ys)+-- prop> 0 `member` ys ==> ioProperty $ do z <- try (evaluate (xs `iquot` ys)); return $ z === Left DivideByZero+iquot :: Integral a => Interval a -> Interval a -> Interval a+iquot (I l u) (I l' u') =+  if l' <= 0 && 0 <= u' then throw DivideByZero else I+    (minimum [a `quot` b | a <- [l,u], b <- [l',u']])+    (maximum [a `quot` b | a <- [l,u], b <- [l',u']])++-- | an interval containing all x `rem` y+-- prop> forAll (memberOf xs) $ \ x -> forAll (memberOf ys) $ \ y -> 0 `notMember` ys ==> (x `rem` y) `member` (xs `irem` ys)+-- prop> 0 `member` ys ==> ioProperty $ do z <- try (evaluate (xs `irem` ys)); return $ z === Left DivideByZero+irem :: Integral a => Interval a -> Interval a -> Interval a+irem (I l u) (I l' u') =+  if l' <= 0 && 0 <= u' then throw DivideByZero else I+    (minimum [0, signum l * (abs u' - 1), signum l * (abs l' - 1)])+    (maximum [0, signum u * (abs u' - 1), signum u * (abs l' - 1)])++-- | an interval containing all x `div` y+-- prop> forAll (memberOf xs) $ \ x -> forAll (memberOf ys) $ \ y -> 0 `notMember` ys ==> (x `div` y) `member` (xs `idiv` ys)+-- prop> 0 `member` ys ==> ioProperty $ do z <- try (evaluate (xs `idiv` ys)); return $ z === Left DivideByZero+idiv :: Integral a => Interval a -> Interval a -> Interval a+idiv (I l u) (I l' u') =+  if l' <= 0 && 0 <= u' then throw DivideByZero else I+    (min (l `Prelude.div` max 1 l') (u `Prelude.div` min (-1) u'))+    (max (u `Prelude.div` max 1 l') (l `Prelude.div` min (-1) u'))++-- | an interval containing all x `mod` y+-- prop> forAll (memberOf xs) $ \ x -> forAll (memberOf ys) $ \ y -> 0 `notMember` ys ==> (x `mod` y) `member` (xs `imod` ys)+-- prop> 0 `member` ys ==> ioProperty $ do z <- try (evaluate (xs `imod` ys)); return $ z === Left DivideByZero+imod :: Integral a => Interval a -> Interval a -> Interval a+imod _ (I l' u') =+  if l' <= 0 && 0 <= u' then throw DivideByZero else+    I (min (l'+1) 0) (max 0 (u'-1))

@@ -0,0 +1,25 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Main (doctests)+-- Copyright   :  (C) 2012-14 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  portable+--+-- This module provides doctests for a project based on the actual versions+-- of the packages it was built with. It requires a corresponding Setup.lhs+-- to be added to the project+-----------------------------------------------------------------------------+module Main where++import Build_doctests (flags, pkgs, module_sources)+import Data.Foldable (traverse_)+import Test.DocTest++main :: IO ()+main = do+    traverse_ putStrLn args+    doctest args+  where+    args = flags ++ pkgs ++ module_sources

@@ -1,76 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE ForeignFunctionInterface #-}--------------------------------------------------------------------------------- |--- Module      :  Main (doctests)--- Copyright   :  (C) 2012-13 Edward Kmett--- License     :  BSD-style (see the file LICENSE)--- Maintainer  :  Edward Kmett <ekmett@gmail.com>--- Stability   :  provisional--- Portability :  portable------ This module provides doctests for a project based on the actual versions--- of the packages it was built with. It requires a corresponding Setup.lhs--- to be added to the project-------------------------------------------------------------------------------module Main where--import Build_doctests (deps)-#if __GLASGOW_HASKELL__ < 710-import Control.Applicative-#endif-import Control.Monad-import Data.List-import System.Directory-import System.FilePath-import Test.DocTest--##if defined(mingw32_HOST_OS)-##if defined(i386_HOST_ARCH)-##define USE_CP-import Control.Applicative-import Control.Exception-import Foreign.C.Types-foreign import stdcall "windows.h SetConsoleCP" c_SetConsoleCP :: CUInt -> IO Bool-foreign import stdcall "windows.h GetConsoleCP" c_GetConsoleCP :: IO CUInt-##elif defined(x86_64_HOST_ARCH)-##define USE_CP-import Control.Applicative-import Control.Exception-import Foreign.C.Types-foreign import ccall "windows.h SetConsoleCP" c_SetConsoleCP :: CUInt -> IO Bool-foreign import ccall "windows.h GetConsoleCP" c_GetConsoleCP :: IO CUInt-##endif-##endif---- | Run in a modified codepage where we can print UTF-8 values on Windows.-withUnicode :: IO a -> IO a-##ifdef USE_CP-withUnicode m = do-  cp <- c_GetConsoleCP-  (c_SetConsoleCP 65001 >> m) `finally` c_SetConsoleCP cp-##else-withUnicode m = m-##endif--main :: IO ()-main = withUnicode $ getSources >>= \sources -> doctest $-    "-isrc"-  : "-idist/build/autogen"-  : "-optP-include"-  : "-optPdist/build/autogen/cabal_macros.h"-  : "-packageQuickCheck"-  : "-hide-all-packages"-  : map ("-package="++) deps ++ sources--getSources :: IO [FilePath]-getSources = filter (isSuffixOf ".hs") <$> go "src"-  where-    go dir = do-      (dirs, files) <- getFilesAndDirectories dir-      (files ++) . concat <$> mapM go dirs--getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath])-getFilesAndDirectories dir = do-  c <- map (dir </>) . filter (`notElem` ["..", "."]) <$> getDirectoryContents dir-  (,) <$> filterM doesDirectoryExist c <*> filterM doesFileExist c