Enum 0.1.0.0 → 0.2.0.0

raw patch · 5 files changed

+121/−72 lines, 5 filesdep +Enumdep +smallcheckdep +tastysetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: Enum, smallcheck, tasty, tasty-hunit

API changes (from Hackage documentation)

Files

• Enum.cabal +18/−6
• Enum.hs +62/−0
• Setup.hs +0/−2
• Util/Enum.hs +0/−64
• test/Main.hs +41/−0

@@ -1,5 +1,5 @@ name:                Enum-version:             0.1.0.0+version:             0.2.0.0 synopsis:            Non-crashing `Enum` operations -- description: license:             BSD3@@ -14,17 +14,13 @@  library   hs-source-dirs:      .-  exposed-modules:     Util.Enum+  exposed-modules:     Enum   build-depends:       base >= 4.7 && < 5   default-language:    Haskell2010   default-extensions:  UnicodeSyntax                      , LambdaCase                      , EmptyCase-                     , PartialTypeSignatures                      , ScopedTypeVariables-                     , FlexibleContexts-                     , FlexibleInstances-                     , DeriveFunctor, DeriveFoldable   ghc-options:         -Wall -Wcompat -Wredundant-constraints -Wno-name-shadowing                        -Wincomplete-record-updates -Wincomplete-uni-patterns                        -Werror=incomplete-patterns@@ -32,6 +28,22 @@                        -Werror=incomplete-record-updates                        -Werror=missing-fields                        -Werror=missing-methods++test-suite test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Main.hs+  build-depends:       base >= 4.7 && < 5+                     , smallcheck >=1.1.4+                     , tasty >=1.0+                     , tasty-hunit >=0.10+                     , Enum+  default-language:    Haskell2010+  default-extensions:  UnicodeSyntax+                     , LambdaCase+                     , EmptyCase+                     , ScopedTypeVariables+  other-extensions:    TypeApplications  source-repository head   type:     git

@@ -0,0 +1,62 @@+module Enum (toEnumMay, fromEnum, predMay, succMay, compareEnum) where++import Prelude hiding (filter, fromEnum, head, tail)+import qualified Prelude++import Control.Monad+import Control.Exception+import Data.List (genericLength)+import System.IO.Unsafe++toEnumMay :: Enum a => Integer -> Maybe a+toEnumMay n+  | n < minInt, Just lower <- lowerEdgeMay, Just lower' <- predMay lower = [lower, lower'..] !!? (minInt - n)+  | n > maxInt, Just upper <- upperEdgeMay = [upper..] !!? (n - maxInt)+  | otherwise = (opMay toEnum <=< toIntMay) n++toIntMay :: Integer -> Maybe Int+toIntMay n = n' <$ guard (n == toInteger n') where n' = fromIntegral n++fromEnum :: Enum a => a -> Integer+fromEnum a+  | Just edge <- lowerEdgeMay, l <- genericLength [a..edge] - 1, l >= 0 = minInt - l+  | Just edge <- upperEdgeMay, l <- genericLength [edge..a] - 1, l >= 0 = maxInt + l+  | otherwise = (toInteger . Prelude.fromEnum) a++minInt, maxInt :: Integer+minInt = toEnum minBound+maxInt = toEnum maxBound++lowerEdgeMay, upperEdgeMay :: Enum a => Maybe a+lowerEdgeMay = opMay Prelude.toEnum minBound+upperEdgeMay = opMay Prelude.toEnum maxBound++compareEnum :: Enum a => a -> a -> Ordering+compareEnum a b+  | _:_ <- enumFromTo a b = LT+  | _:_ <- enumFromTo b a = GT+  | otherwise = EQ++predMay, succMay :: Enum a => a -> Maybe a+predMay = opMay pred+succMay = opMay succ++opMay :: (a -> b) -> a -> Maybe b+opMay f a = unsafePerformIO $ (Just <$> evaluate (f a)) `catches` handlers Nothing++handlers :: a -> [Handler a]+handlers a = [Handler $ \ (_ :: ArithException) -> pure a,+              Handler $ \ (_ :: ArrayException) -> pure a,+              Handler $ \ (_ :: AssertionFailed) -> pure a,+              Handler $ \ (_ :: NonTermination) -> pure a,+              Handler $ \ (_ :: NoMethodError) -> pure a,+              Handler $ \ (_ :: PatternMatchFail) -> pure a,+              Handler $ \ (_ :: RecConError) -> pure a,+              Handler $ \ (_ :: RecSelError) -> pure a,+              Handler $ \ (_ :: RecUpdError) -> pure a,+              Handler $ \ (_ :: ErrorCall) -> pure a]++(!!?) :: [a] -> Integer -> Maybe a+[] !!? _ = Nothing+(x:_) !!? 0 = Just x+(_:xs) !!? n = xs !!? (n-1)

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

@@ -1,64 +0,0 @@-module Util.Enum (toEnumMay, fromEnum, predMay, succMay) where--import Prelude hiding (filter, fromEnum, head, tail)-import qualified Prelude-import Control.Applicative-import Control.Monad-import Control.Exception-import Data.Bool (bool)-import Data.Maybe (fromMaybe)-import Data.Semigroup (Semigroup (..), stimes)-import System.IO.Unsafe--toEnumMay :: Enum a => Integer -> Maybe a-toEnumMay n = opMay (toEnum . fromIntegral) n <|> toEnumSafe n--toEnumSafe :: Enum a => Integer -> Maybe a-toEnumSafe n = stimes (abs n) (EndoM $ bool succMay predMay $ n < 0) `endoM` toEnum 0--fromEnum :: Enum a => a -> Integer-fromEnum = fromMaybe <$> fromEnumSafe <*> opMay (fromIntegral . Prelude.fromEnum)--fromEnumSafe :: Enum a => a -> Integer-fromEnumSafe a = head $ f `mapMaybe` let go n = n :. negate n :. go (n+1) in 0 :. go 1-  where f n = n <$ (guard . (== 0) =<< opMay Prelude.fromEnum =<<-                    stimes (abs n) (EndoM $ bool succMay predMay $ n < 0) `endoM` a)--predMay, succMay :: Enum a => a -> Maybe a-predMay = opMay pred-succMay = opMay succ--opMay :: (a -> b) -> a -> Maybe b-opMay f a = unsafePerformIO $ (Just <$> evaluate (f a)) `catches` handlers Nothing--handlers :: a -> [Handler a]-handlers a = [Handler $ \ (_ :: ArithException) -> pure a,-              Handler $ \ (_ :: ArrayException) -> pure a,-              Handler $ \ (_ :: AssertionFailed) -> pure a,-              Handler $ \ (_ :: NonTermination) -> pure a,-              Handler $ \ (_ :: NoMethodError) -> pure a,-              Handler $ \ (_ :: PatternMatchFail) -> pure a,-              Handler $ \ (_ :: RecConError) -> pure a,-              Handler $ \ (_ :: RecSelError) -> pure a,-              Handler $ \ (_ :: RecUpdError) -> pure a,-              Handler $ \ (_ :: ErrorCall) -> pure a]--newtype EndoM m a = EndoM { endoM :: a -> m a }-instance Monad m => Semigroup (EndoM m a) where EndoM f <> EndoM g = EndoM (f >=> g)-instance Monad m => Monoid (EndoM m a) where-    mappend = (<>)-    mempty = EndoM pure--infixr 5 :.-data Stream a = (:.) { head :: a, tail :: Stream a }-  deriving (Functor, Foldable)--instance Applicative Stream where-    pure a = a :. pure a-    f :. fs <*> x :. xs = f x :. (fs <*> xs)--instance Monad Stream where-    xs >>= f = join (f <$> xs) where join (a :. as) = head a :. join (tail <$> as)--mapMaybe :: (a -> Maybe b) -> Stream a -> Stream b-mapMaybe f (a :. as) = maybe id (:.) (f a) $ mapMaybe f as

@@ -0,0 +1,41 @@+{-# LANGUAGE TypeApplications #-}+module Main where++import Prelude hiding (fromEnum)++import Data.Foldable+import Data.Functor.Const (Const (..))+import Data.Int+import Data.Maybe (isNothing)+import Data.Word++import Test.SmallCheck+import Test.Tasty+import Test.Tasty.HUnit++import Enum++main :: IO ()+main = defaultMain $ testGroup "" $ asum+  [ getConst (boundsTests @Int)+  , getConst (boundsTests @Int8)+  , getConst (boundsTests @Word)+  , getConst (boundsTests @Word8)+  , getConst (boundsTests @Char)+  , getConst (boundsTests @Bool)+  , getConst (boundsTests @Ordering)+  , let lower = toInteger (minBound :: Int)+        upper = toInteger (maxBound :: Int)+        lower' = lower - 1+        upper' = upper + 1+    in+      [lower', lower, 0, upper, upper'] >>= \ n ->+      [ testCase "toEnumMay" $ assertBool "" $ toEnumMay n == Just n+      , testCase ("fromEnum " ++ show n) $ assertBool "" $ fromEnum n == n]+  ]++boundsTests :: ∀ a . (Bounded a, Enum a) => Const [TestTree] a+boundsTests = Const+  [ testCase "predMay minBound" $ assertBool "" . isNothing $ predMay (minBound :: a)+  , testCase "succMay maxBound" $ assertBool "" . isNothing $ succMay (maxBound :: a)+  ]