diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,9 @@ +# 0.0.0.1 + +Consolidate all the test suites into one + +Remove `Safe` pragmas + # 0.0.0.0 (2022-11-29) -* Initial release +Initial release diff --git a/integer-generators/Integer/Gen.hs b/integer-generators/Integer/Gen.hs deleted file mode 100644 --- a/integer-generators/Integer/Gen.hs +++ /dev/null @@ -1,122 +0,0 @@ -module Integer.Gen - ( - GenIntegral (integral), - GenFinite (finite), - astronomical, - ) - where - -import Control.Applicative (pure, (<*>)) -import Data.Function (id, ($)) -import Data.Functor (fmap) -import Data.Int (Int) -import Data.Word (Word) -import Integer (BoundedBelow (..), Integer, Natural, Positive, Sign (..), - Signed (..)) -import Text.Show (Show) - -import qualified Hedgehog -import qualified Hedgehog.Gen as Gen -import qualified Hedgehog.Range as Range -import qualified Prelude as Bounded (Bounded (..)) -import qualified Prelude as Num (Integral (..), Num (..), (+), (^)) - ---- - -class (Num.Integral a, Show a) => GenIntegral a - where - -- | Generators for 'Integer', 'Natural', 'Positive', - -- or 'Signed' selected from one of three methods: - -- - -- * small numbers (magnitude less than ten) - -- * large numbers (well in excess of 64-bit) - -- * numbers at or around a bound of 'Int' or 'Word' - integral :: Hedgehog.Gen a - -instance GenIntegral Integer where integral = integer -instance GenIntegral Natural where integral = boundedBelow -instance GenIntegral Positive where integral = boundedBelow -instance GenIntegral Signed where integral = signed - ---- - -class (Num.Integral a, Bounded.Bounded a, Show a) => GenFinite a - where - finite :: Hedgehog.Gen a - -instance GenFinite Int where finite = defaultFinite - -instance GenFinite Word where finite = defaultFinite - -defaultFinite :: (Num.Integral a, Bounded.Bounded a) => Hedgehog.Gen a -defaultFinite = Gen.choice - [ Gen.integral $ Range.linear Bounded.minBound Bounded.maxBound - , Gen.integral $ Range.linear Bounded.maxBound Bounded.minBound - ] - ---- - -smol :: Num.Integral a => a -smol = 10 - -astronomical :: Num.Integral a => a -astronomical = 2 Num.^ (99 :: Integer) - -bigRange :: Num.Integral a => Range.Range a -bigRange = Range.exponential smol astronomical - ---- - -integer :: Hedgehog.Gen Integer -integer = Gen.choice [smolInteger, nearFiniteBoundInteger, bigInteger] - -smolInteger :: Hedgehog.Gen Integer -smolInteger = Gen.integral $ Range.linearFrom 0 (Num.negate smol) smol - -bigInteger :: Hedgehog.Gen Integer -bigInteger = Gen.element [id, Num.negate] <*> Gen.integral bigRange - -nearFiniteBoundInteger :: Hedgehog.Gen Integer -nearFiniteBoundInteger = Gen.element [id, Num.negate] <*> nearPositiveFiniteBound - ---- - -boundedBelow :: forall a. (BoundedBelow a, Num.Integral a) => Hedgehog.Gen a -boundedBelow = Gen.choice [smolBoundedBelow, nearPositiveFiniteBound, bigBoundedBelow] - -smolBoundedBelow :: forall a. (BoundedBelow a, Num.Integral a) => Hedgehog.Gen a -smolBoundedBelow = fmap Num.fromInteger $ Gen.integral $ Range.linear (Num.toInteger $ minBound @a) smol - -bigBoundedBelow :: forall a. (BoundedBelow a, Num.Integral a) => Hedgehog.Gen a -bigBoundedBelow = fmap Num.fromInteger $ Gen.integral bigRange - -nearPositiveFiniteBound :: forall a. Num.Integral a => Hedgehog.Gen a -nearPositiveFiniteBound = fmap Num.fromInteger $ - pure (Num.+) - <*> Gen.element - [ Num.toInteger (Bounded.maxBound :: Int) - , Num.toInteger (Bounded.maxBound :: Word) - ] - <*> smolInteger - ---- - -signed :: Hedgehog.Gen Signed -signed = Gen.choice [smolSigned, nearFiniteBoundSigned, bigSigned] - -smolSigned :: Hedgehog.Gen Signed -smolSigned = Gen.frequency - [ (,) 1 $ pure Zero - , (,) 9 $ pure NonZero <*> sign <*> smolBoundedBelow - ] - -bigSigned :: Hedgehog.Gen Signed -bigSigned = pure NonZero <*> sign <*> bigBoundedBelow - -nearFiniteBoundSigned :: Hedgehog.Gen Signed -nearFiniteBoundSigned = pure NonZero <*> sign <*> nearPositiveFiniteBound - ---- - -sign :: Hedgehog.Gen Sign -sign = Gen.element [PlusSign, MinusSign] diff --git a/integer-types.cabal b/integer-types.cabal --- a/integer-types.cabal +++ b/integer-types.cabal @@ -1,7 +1,7 @@ cabal-version: 3.0 name: integer-types -version: 0.0.0.0 +version: 0.0.0.1 category: Numeric synopsis: Integer, Natural, and Positive @@ -20,7 +20,7 @@ license: Apache-2.0 license-file: license.txt -extra-doc-files: readme.md changelog.md +extra-source-files: *.md common base default-language: GHC2021 @@ -32,30 +32,13 @@ PatternSynonyms ViewPatterns build-depends: - base ^>= 4.16 || ^>= 4.17 + , base ^>= 4.16 || ^>= 4.17 , deepseq ^>= 1.4.6 - -common test - import: base - default-extensions: - AllowAmbiguousTypes - build-depends: - exceptions - , integer-types - -common test-with-hedgehog - import: test - build-depends: - hedgehog ^>= 1.1 || ^>= 1.2 - -common test-with-hspec - import: test - build-depends: - hspec + , quaalude ^>= 0.0 library import: base - hs-source-dirs: integer-types + hs-source-dirs: library exposed-modules: Integer Integer.BoundedBelow @@ -70,40 +53,19 @@ other-modules: Integer.Positive.Unsafe -library integer-generators - import: test-with-hedgehog - hs-source-dirs: integer-generators - exposed-modules: Integer.Gen - -test-suite test-integer-arithmetic - import: test-with-hedgehog - type: exitcode-stdio-1.0 - main-is: Main.hs - hs-source-dirs: test-integer-arithmetic - build-depends: integer-generators - -test-suite test-integer-conversions - import: test-with-hedgehog - type: exitcode-stdio-1.0 - main-is: Main.hs - hs-source-dirs: test-integer-conversions - build-depends: integer-generators - -test-suite test-integer-enum - import: test-with-hspec - type: exitcode-stdio-1.0 - main-is: Main.hs - hs-source-dirs: test-integer-enum - -test-suite test-integer-deepseq - import: test-with-hspec - type: exitcode-stdio-1.0 - main-is: Main.hs - hs-source-dirs: test-integer-deepseq - -test-suite test-integer-finite - import: test-with-hedgehog +test-suite test-integer-types + import: base + hs-source-dirs: test type: exitcode-stdio-1.0 + default-extensions: + AllowAmbiguousTypes + BlockArguments + build-depends: + , exceptions ^>= 0.10.4 + , integer-types + , hedgehog ^>= 1.0.5 || ^>= 1.1 || ^>= 1.2 + , hspec ^>= 2.8.5 || ^>= 2.9 || ^>= 2.10 + , hspec-hedgehog ^>= 0.0.1 main-is: Main.hs - hs-source-dirs: test-integer-finite - build-depends: integer-generators + other-modules: + Integer.Gen diff --git a/integer-types/Integer.hs b/integer-types/Integer.hs deleted file mode 100644 --- a/integer-types/Integer.hs +++ /dev/null @@ -1,24 +0,0 @@ -{-# language Safe #-} - -module Integer - ( - {- ** Types -} Integer, Natural, Positive, - Signed (Zero, NonZero, Minus, Plus), Sign (MinusSign, PlusSign), - {- ** Subtraction -} Subtraction (subtractInteger, subtractSigned), Subtraction' (subtract), - {- ** Conversion -} IntegerNarrow (narrow), IntegerConvert (convert), IntegerEquiv, yolo, ConvertWithFinite (toInt, fromInt, toWord, fromWord), Finite (..), - {- ** Lower bound -} BoundedBelow (minBound), - ) - where - -import Integer.BoundedBelow (BoundedBelow (minBound)) -import Integer.Conversion (IntegerConvert (convert), IntegerEquiv, - IntegerNarrow (narrow), yolo) -import Integer.Finite (ConvertWithFinite (fromInt, fromWord, toInt, toWord), - Finite (..)) -import Integer.Integer (Integer) -import Integer.Natural (Natural) -import Integer.Positive (Positive) -import Integer.Sign (Sign (MinusSign, PlusSign)) -import Integer.Signed (Signed (Minus, NonZero, Plus, Zero)) -import Integer.Subtraction (Subtraction (subtractInteger, subtractSigned), - Subtraction' (subtract)) diff --git a/integer-types/Integer/BoundedBelow.hs b/integer-types/Integer/BoundedBelow.hs deleted file mode 100644 --- a/integer-types/Integer/BoundedBelow.hs +++ /dev/null @@ -1,11 +0,0 @@ -module Integer.BoundedBelow where - -import Numeric.Natural (Natural) - -class BoundedBelow a where - minBound :: a - -instance BoundedBelow Natural where - minBound = 0 - - diff --git a/integer-types/Integer/Conversion.hs b/integer-types/Integer/Conversion.hs deleted file mode 100644 --- a/integer-types/Integer/Conversion.hs +++ /dev/null @@ -1,93 +0,0 @@ -{-# language Safe #-} - -module Integer.Conversion - ( - IntegerNarrow (narrow), - IntegerConvert (convert), - IntegerEquiv, - yolo, - ) - where - -import Data.Function (id, (.)) -import Data.Maybe (Maybe (..)) -import Integer.Integer (Integer) -import Integer.Natural (Natural) -import Integer.Positive (Positive) -import Integer.Signed (Signed) - -import qualified Integer.Integer as Integer -import qualified Integer.Natural as Natural -import qualified Integer.Positive as Positive -import qualified Integer.Signed as Signed -import qualified Prelude as Num (Integral (..), Num (..)) - -class IntegerNarrow a b => IntegerConvert a b where - convert :: a -> b - -class IntegerNarrow a b where - narrow :: a -> Maybe b - -class (IntegerConvert a b, IntegerConvert b a) => IntegerEquiv a b - - ---- Isomorphisms --- - -instance IntegerEquiv Integer Integer -instance IntegerConvert Integer Integer where convert = id -instance IntegerNarrow Integer Integer where narrow = Just - -instance IntegerEquiv Natural Natural -instance IntegerConvert Natural Natural where convert = id -instance IntegerNarrow Natural Natural where narrow = Just - -instance IntegerEquiv Positive Positive -instance IntegerConvert Positive Positive where convert = id -instance IntegerNarrow Positive Positive where narrow = Just - -instance IntegerEquiv Signed Signed -instance IntegerConvert Signed Signed where convert = id -instance IntegerNarrow Signed Signed where narrow = Just - -instance IntegerEquiv Integer Signed -instance IntegerConvert Integer Signed where convert = Integer.toSigned -instance IntegerNarrow Integer Signed where narrow = Just . convert - -instance IntegerEquiv Signed Integer -instance IntegerConvert Signed Integer where convert = Signed.toInteger -instance IntegerNarrow Signed Integer where narrow = Just . convert - - ---- Prisms --- - -instance IntegerNarrow Integer Natural where narrow = Integer.toNatural -instance IntegerNarrow Natural Integer where narrow = Just . convert -instance IntegerConvert Natural Integer where convert = Natural.toInteger - -instance IntegerNarrow Signed Natural where narrow = Signed.toNatural -instance IntegerNarrow Natural Signed where narrow = Just . convert -instance IntegerConvert Natural Signed where convert = Natural.toSigned - -instance IntegerNarrow Integer Positive where narrow = Integer.toPositive -instance IntegerNarrow Positive Integer where narrow = Just . convert -instance IntegerConvert Positive Integer where convert = Positive.toInteger - -instance IntegerNarrow Natural Positive where narrow = Natural.toPositive -instance IntegerNarrow Positive Natural where narrow = Just . convert -instance IntegerConvert Positive Natural where convert = Positive.toNatural - -instance IntegerNarrow Signed Positive where narrow = Signed.toPositive -instance IntegerNarrow Positive Signed where narrow = Just . convert -instance IntegerConvert Positive Signed where convert = Positive.toSigned - - ---- lol --- - --- | Partial conversion between 'Num.Integral' types via 'Integer' --- --- @ --- yolo = 'Num.fromInteger' . 'Num.toInteger' --- @ --- -yolo :: (Num.Integral a, Num.Num b) => a -> b -yolo = Num.fromInteger . Num.toInteger diff --git a/integer-types/Integer/Finite.hs b/integer-types/Integer/Finite.hs deleted file mode 100644 --- a/integer-types/Integer/Finite.hs +++ /dev/null @@ -1,59 +0,0 @@ -module Integer.Finite where - -import Data.Function ((.)) -import Data.Int (Int) -import Data.Maybe (Maybe) -import Data.Word (Word) -import Integer.Integer (Integer) -import Integer.Natural (Natural) -import Integer.Positive (Positive) -import Integer.Signed (Signed) -import Prelude (Bounded, Integral) - -import qualified Data.Maybe as Maybe -import qualified Integer.Integer as Integer -import qualified Integer.Natural as Natural -import qualified Integer.Positive as Positive -import qualified Integer.Signed as Signed - -class ConvertWithFinite a where - toWord :: a -> Maybe Word - fromWord :: Word -> Maybe a - toInt :: a -> Maybe Int - fromInt :: Int -> Maybe a - -instance ConvertWithFinite Natural where - toWord = Natural.toWord - fromWord = Maybe.Just . Natural.fromWord - toInt = Natural.toInt - fromInt = Natural.fromInt - -instance ConvertWithFinite Positive where - toWord = Positive.toWord - fromWord = Positive.fromWord - toInt = Positive.toInt - fromInt = Positive.fromInt - -instance ConvertWithFinite Integer where - toWord = Integer.toWord - fromWord = Maybe.Just . Integer.fromWord - toInt = Integer.toInt - fromInt = Maybe.Just . Integer.fromInt - -instance ConvertWithFinite Signed where - toWord = Signed.toWord - fromWord = Maybe.Just . Signed.fromWord - toInt = Signed.toInt - fromInt = Maybe.Just . Signed.fromInt - -class (Bounded b, Integral b) => Finite b where - toFinite :: ConvertWithFinite a => a -> Maybe b - fromFinite :: ConvertWithFinite a => b -> Maybe a - -instance Finite Int where - toFinite = toInt - fromFinite = fromInt - -instance Finite Word where - toFinite = toWord - fromFinite = fromWord diff --git a/integer-types/Integer/Integer.hs b/integer-types/Integer/Integer.hs deleted file mode 100644 --- a/integer-types/Integer/Integer.hs +++ /dev/null @@ -1,65 +0,0 @@ -{-# language Safe #-} - -module Integer.Integer - ( - {- * Type -} Integer, - {- * Conversion -} - {- ** Positive -} toPositive, fromPositive, - {- ** Natural -} toNatural, fromNatural, - {- ** Signed -} toSigned, fromSigned, - {- ** Int -} toInt, fromInt, - {- ** Word -} toWord, fromWord, - ) - where - -import Data.Int (Int) -import Data.Maybe (Maybe (..)) -import Data.Word (Word) -import Integer.Positive (Positive) -import Integer.Signed (Signed (..)) -import Numeric.Natural (Natural) -import Prelude (Integer) - -import qualified Data.Bool as Bool -import qualified Data.Ord as Ord -import qualified Integer.Natural as Natural -import qualified Integer.Positive as Positive -import qualified Integer.Signed as Signed -import qualified Prelude as Bounded (Bounded (..)) -import qualified Prelude as Num (Integral (..), Num (..)) - -toPositive :: Integer -> Maybe Positive -toPositive = Positive.fromInteger - -fromPositive :: Positive -> Integer -fromPositive = Positive.toInteger - -toNatural :: Integer -> Maybe Natural -toNatural = Natural.fromInteger - -fromNatural :: Natural -> Integer -fromNatural = Natural.toInteger - -toSigned :: Integer -> Signed -toSigned = Signed.fromInteger - -fromSigned :: Signed -> Integer -fromSigned = Signed.toInteger - -toInt :: Integer -> Maybe Int -toInt x = if ok then Just (Num.fromInteger x) else Nothing - where - ok = x Ord.>= Num.toInteger (Bounded.minBound :: Int) Bool.&& - x Ord.<= Num.toInteger (Bounded.maxBound :: Int) - -fromInt :: Int -> Integer -fromInt = Num.toInteger - -toWord :: Integer -> Maybe Word -toWord x = if ok then Just (Num.fromInteger x) else Nothing - where - ok = x Ord.>= Num.toInteger (Bounded.minBound :: Word) Bool.&& - x Ord.<= Num.toInteger (Bounded.maxBound :: Word) - -fromWord :: Word -> Integer -fromWord = Num.toInteger diff --git a/integer-types/Integer/Natural.hs b/integer-types/Integer/Natural.hs deleted file mode 100644 --- a/integer-types/Integer/Natural.hs +++ /dev/null @@ -1,86 +0,0 @@ -{-# language Trustworthy #-} - -module Integer.Natural - ( - {- * Type -} Natural, - {- * Subtraction -} subtract, - {- * Conversion -} - {- ** Positive -} toPositive, fromPositive, - {- ** Integer -} toInteger, fromInteger, - {- ** Signed -} toSigned, fromSigned, - {- ** Int -} toInt, fromInt, - {- ** Word -} toWord, fromWord, - {- * One (1) -} one, addOne, subtractOne, - ) - where - -import Data.Function (($)) -import Data.Int (Int) -import Data.Maybe (Maybe (..)) -import Data.Word (Word) -import Integer.Signed (Signed (..)) -import Numeric.Natural (Natural) -import Prelude (Integer) - -import qualified Data.Ord as Ord -import qualified Integer.Positive as Positive -import qualified Integer.Positive.Unsafe as Positive.Unsafe -import qualified Integer.Signed as Signed -import qualified Prelude as Bounded (Bounded (..)) -import qualified Prelude as Num (Integral (..), Num (..)) - -toPositive :: Natural -> Maybe Positive.Unsafe.Positive -toPositive = Positive.fromNatural - -fromPositive :: Positive.Unsafe.Positive -> Natural -fromPositive = Positive.toNatural - -fromInteger :: Integer -> Maybe Natural -fromInteger x = if x Ord.>= 0 then Just (Num.fromInteger x) else Nothing - -toInteger :: Natural -> Integer -toInteger = Num.toInteger - -toSigned :: Natural -> Signed -toSigned = Signed.fromNatural - -fromSigned :: Signed -> Maybe Natural -fromSigned = Signed.toNatural - -toInt :: Natural -> Maybe Int -toInt x = if ok then Just (Num.fromInteger x') else Nothing - where - ok = x' Ord.<= Num.toInteger (Bounded.maxBound :: Int) - x' = Num.toInteger x - -fromInt :: Int -> Maybe Natural -fromInt x = if ok then Just (Num.fromInteger x') else Nothing - where - ok = x Ord.>= 0 - x' = Num.toInteger x - -toWord :: Natural -> Maybe Word -toWord x = if ok then Just (Num.fromInteger x') else Nothing - where - ok = x' Ord.<= Num.toInteger (Bounded.maxBound :: Word) - x' = Num.toInteger x - -fromWord :: Word -> Natural -fromWord x = Num.fromInteger (Num.toInteger x) - -subtract :: Natural -> Natural -> Signed -subtract a b = case Ord.compare a b of - Ord.EQ -> Zero - Ord.GT -> Plus $ Positive.Unsafe.fromNatural $ (Num.-) a b - Ord.LT -> Minus $ Positive.Unsafe.fromNatural $ (Num.-) b a - -one :: Natural -one = 1 - -addOne :: Integer -> Integer -addOne = (Num.+ 1) - -subtractOne :: Natural -> Maybe Signed -subtractOne x = case x of - 0 -> Nothing - p -> Just (subtract p 1) diff --git a/integer-types/Integer/Positive.hs b/integer-types/Integer/Positive.hs deleted file mode 100644 --- a/integer-types/Integer/Positive.hs +++ /dev/null @@ -1,75 +0,0 @@ -{-# language Trustworthy #-} - -module Integer.Positive - ( - {- * Type -} Positive, - {- * Subtraction -} subtract, - {- * Conversion -} - {- ** Natural -} toNatural, fromNatural, - {- ** Integer -} toInteger, fromInteger, - {- ** Signed -} toSigned, fromSigned, - {- ** Int -} toInt, fromInt, - {- ** Word -} toWord, fromWord, - {- * One (1) -} one, addOne, subtractOne, - ) - where - -import Data.Function (($)) -import Data.Int (Int) -import Data.Maybe (Maybe (..)) -import Data.Word (Word) -import Integer.Positive.Unsafe (Positive, addOne, one, toInteger, toNatural) -import Integer.Signed (Signed (..)) -import Numeric.Natural (Natural) -import Prelude (Integer) - -import qualified Data.Ord as Ord -import qualified Integer.Positive.Unsafe as Unsafe -import qualified Prelude as Bounded (Bounded (..)) -import qualified Prelude as Num (Integral (..), Num (..)) - -fromInteger :: Integer -> Maybe Positive -fromInteger x = if x Ord.> 0 then Just (Unsafe.fromInteger x) else Nothing - -fromNatural :: Natural -> Maybe Positive -fromNatural x = case x of 0 -> Nothing; _ -> Just (Unsafe.fromNatural x) - -toInt :: Positive -> Maybe Int -toInt x = if ok then Just (Num.fromInteger x') else Nothing - where - ok = x' Ord.<= Num.toInteger (Bounded.maxBound :: Int) - x' = Num.toInteger x - -fromInt :: Int -> Maybe Positive -fromInt x = if ok then Just (Num.fromInteger x') else Nothing - where - ok = x' Ord.>= 1 - x' = Num.toInteger x - -toWord :: Positive -> Maybe Word -toWord x = if ok then Just (Num.fromInteger x') else Nothing - where - ok = x' Ord.<= Num.toInteger (Bounded.maxBound :: Word) - x' = Num.toInteger x - -fromWord :: Word -> Maybe Positive -fromWord x = if ok then Just (Num.fromInteger x') else Nothing - where - ok = x' Ord.>= 1 - x' = Num.toInteger x - -subtract :: Positive -> Positive -> Signed -subtract a b = case Ord.compare a b of - Ord.EQ -> Zero - Ord.GT -> Plus $ Unsafe.subtract a b - Ord.LT -> Minus $ Unsafe.subtract b a - -subtractOne :: Positive -> Natural -subtractOne x = toNatural x Num.- 1 - -toSigned :: Positive -> Signed -toSigned = Plus - -fromSigned :: Signed -> Maybe Positive -fromSigned (Plus x) = Just x -fromSigned _ = Nothing diff --git a/integer-types/Integer/Positive/Unsafe.hs b/integer-types/Integer/Positive/Unsafe.hs deleted file mode 100644 --- a/integer-types/Integer/Positive/Unsafe.hs +++ /dev/null @@ -1,160 +0,0 @@ -{-# language Unsafe #-} - -{- | This module is unsafe not merely in the sense that it contains partial -functions, but moreover than it is capable of constructing the invalid -'Positive' value @'FromNatural' 0@ representing zero, which is not positive. -When a function has "checked" in its name, this indicates that it is partial but -will never construct an invalid 'Positive'. -} - -module Integer.Positive.Unsafe - ( - {- * Type -} Positive (FromNatural), - {- * Conversion -} - {- ** Natural -} toNatural, fromNatural, fromNaturalChecked, - {- ** Integer -} toInteger, fromInteger, fromIntegerChecked, - {- ** Int -} toInt, fromInt, fromIntChecked, - {- * Arithmetic -} subtract, subtractChecked, - {- * One (1) -} one, addOne, subtractOne, subtractOneChecked, - ) - where - -import Data.Function (const, id, ($), (.)) -import Integer.BoundedBelow (BoundedBelow) -import Numeric.Natural (Natural) -import Prelude (Enum, Eq, Int, Integer, Integral, Num, Ord, Real, Show) - -import qualified Control.DeepSeq as DeepSeq -import qualified Control.Exception as Exception -import qualified Data.Bits as Bits -import qualified Data.List as List -import qualified Data.Maybe as Maybe -import qualified Data.Ord as Ord -import qualified Integer.BoundedBelow as BoundedBelow -import qualified Prelude as Enum (Enum (..)) -import qualified Prelude as Num (Integral (..), Num (..), Real (..), - fromIntegral) -import qualified Text.Show as Show - -newtype Positive = FromNatural{ toNatural :: Natural } deriving (Eq, Ord) - -instance DeepSeq.NFData Positive where rnf (FromNatural x) = DeepSeq.rnf x - -fromNatural :: Natural -> Positive -fromNatural = FromNatural - -fromNaturalChecked :: Natural -> Positive -fromNaturalChecked x = case x of 0 -> Exception.throw Exception.Underflow; _ -> fromNatural x - -toInteger :: Positive -> Integer -toInteger = Num.toInteger . toNatural - -fromInteger :: Integer -> Positive -fromInteger = fromNatural . Num.fromInteger - -fromIntegerChecked :: Integer -> Positive -fromIntegerChecked x = if x Ord.>= 1 then fromInteger x else Exception.throw Exception.Underflow - -add :: Positive -> Positive -> Positive -add a b = fromNatural (toNatural a Num.+ toNatural b) - -subtract :: Positive -> Positive -> Positive -subtract a b = fromNatural (toNatural a Num.- toNatural b) - -subtractChecked :: Positive -> Positive -> Positive -subtractChecked a b = if a Ord.> b then subtract a b else Exception.throw Exception.Underflow - -multiply :: Positive -> Positive -> Positive -multiply a b = fromNatural (toNatural a Num.* toNatural b) - -one :: Positive -one = fromNatural 1 - -addOne :: Positive -> Positive -addOne = fromNatural . (Num.+ 1) . toNatural - -subtractOne :: Positive -> Positive -subtractOne = fromNatural . (Num.- 1) . toNatural - -subtractOneChecked :: Positive -> Positive -subtractOneChecked x = case x of { 1 -> Exception.throw Exception.Underflow; _ -> subtractOne x } - -toInt :: Positive -> Int -toInt = Num.fromIntegral . toNatural - -toIntChecked :: Positive -> Int -toIntChecked = Maybe.fromMaybe (Exception.throw Exception.Overflow) . Bits.toIntegralSized . toNatural - -fromInt :: Int -> Positive -fromInt = fromNatural . Num.fromIntegral - -fromIntChecked :: Int -> Positive -fromIntChecked x = case Num.signum x of { 1 -> fromInt x; _ -> Exception.throw Exception.Underflow } - -enumFrom :: Positive -> [Positive] -enumFrom = List.map fromNatural . Enum.enumFrom . toNatural - -enumFromTo :: Positive -> Positive -> [Positive] -enumFromTo a b = List.map fromNatural $ Enum.enumFromTo (toNatural a) (toNatural b) - -enumFromThen :: Positive -> Positive -> [Positive] -enumFromThen a b = if a Ord.< b then ascending else descending - where - ascending = List.map fromNatural $ Enum.enumFromThen (toNatural a) (toNatural b) - descending = List.map fromInteger $ List.takeWhile (Ord.>= 1) $ - Enum.enumFromThen (toInteger a) (toInteger b) - -enumFromThenTo :: Positive -> Positive -> Positive -> [Positive] -enumFromThenTo a b c = if a Ord.< b then ascending else descending - where - ascending = List.map fromNatural $ Enum.enumFromThenTo (toNatural a) (toNatural b) (toNatural c) - descending = List.map fromInteger $ List.takeWhile (Ord.>= 1) $ - Enum.enumFromThenTo (toInteger a) (toInteger b) (toInteger c) - -type Div a = a -> a -> (a, a) - -divisionOp :: Div Natural -> Div Positive -divisionOp o a b = - let (q, r) = o (toNatural a) (toNatural b) - in (fromNaturalChecked q, fromNaturalChecked r) - -instance BoundedBelow Positive - where - minBound = 1 - -instance Num Positive - where - abs = id - negate = const (Exception.throw Exception.Underflow) - signum = const (fromNatural 1) - fromInteger = fromIntegerChecked - (+) = add - (*) = multiply - (-) = subtractChecked - -instance Enum Positive - where - succ = addOne - pred = subtractOneChecked - - fromEnum = toIntChecked - toEnum = fromIntChecked - - enumFrom = enumFrom - enumFromTo = enumFromTo - enumFromThen = enumFromThen - enumFromThenTo = enumFromThenTo - -instance Real Positive - where - toRational = Num.toRational . toInteger - -instance Integral Positive - where - toInteger = toInteger - quotRem = divisionOp Num.quotRem - divMod = divisionOp Num.divMod - -instance Show Positive - where - show = Show.show . toNatural - showsPrec i = Show.showsPrec i . toNatural diff --git a/integer-types/Integer/Sign.hs b/integer-types/Integer/Sign.hs deleted file mode 100644 --- a/integer-types/Integer/Sign.hs +++ /dev/null @@ -1,24 +0,0 @@ -{-# language Safe #-} - -module Integer.Sign - ( - {- * Type -} Sign (..), - {- * Operations -} negate, multiply, - ) - where - -import Prelude (Eq, Ord, Show, seq, (==)) - -import qualified Control.DeepSeq as DeepSeq - -data Sign = MinusSign | PlusSign - deriving (Eq, Ord, Show) - -instance DeepSeq.NFData Sign where rnf x = seq x () - -negate :: Sign -> Sign -negate PlusSign = MinusSign -negate MinusSign = PlusSign - -multiply :: Sign -> Sign -> Sign -multiply a b = if a == b then PlusSign else MinusSign diff --git a/integer-types/Integer/Signed.hs b/integer-types/Integer/Signed.hs deleted file mode 100644 --- a/integer-types/Integer/Signed.hs +++ /dev/null @@ -1,213 +0,0 @@ -{-# language Trustworthy #-} - -module Integer.Signed - ( - {- * Type -} Signed (Zero, NonZero, Plus, Minus, NotPlus, NotMinus), - {- * Conversion -} - {- ** Integer -} toInteger, fromInteger, - {- ** Natural -} toNatural, fromNatural, - {- ** Positive -} toPositive, fromPositive, - {- ** Int -} toInt, fromInt, - {- ** Word -} toWord, fromWord, - ) - where - -import Data.Function (($), (.)) -import Data.Int (Int) -import Data.Maybe (Maybe (..)) -import Data.Word (Word) -import Integer.Positive.Unsafe (Positive) -import Integer.Sign (Sign (..)) -import Numeric.Natural (Natural) -import Prelude (Enum, Eq, Integer, Integral, Num, Ord, Real, Show, seq) - -import qualified Control.DeepSeq as DeepSeq -import qualified Data.List as List -import qualified Data.Ord as Ord -import qualified Integer.Positive.Unsafe as Positive.Unsafe -import qualified Integer.Sign as Sign -import qualified Prelude as Bounded (Bounded (..)) -import qualified Prelude as Enum (Enum (..)) -import qualified Prelude as Num (Integral (..), Num (..), Real (..)) -import qualified Text.Show as Show - -data Signed = Zero | NonZero Sign Positive - deriving (Eq) - -instance Ord Signed where - compare Zero Zero = Ord.EQ - - compare Zero (Minus _) = Ord.GT - compare Zero (Plus _ ) = Ord.LT - compare (Minus _) Zero = Ord.LT - compare (Plus _) Zero = Ord.GT - - compare (Plus _) (Minus _) = Ord.GT - compare (Minus _) (Plus _) = Ord.LT - compare (Plus a) (Plus b) = Ord.compare a b - compare (Minus a) (Minus b) = Ord.compare b a - -instance DeepSeq.NFData Signed where - rnf Zero = () - rnf (NonZero a b) = a `seq` b `seq` () - -pattern Minus :: Positive -> Signed -pattern Minus x = NonZero MinusSign x -pattern Plus :: Positive -> Signed - -pattern Plus x = NonZero PlusSign x - --- | A 'Signed' that is either zero or positive -pattern NotMinus :: Natural -> Signed -pattern NotMinus x <- (toNatural -> Just x) - where NotMinus = fromNatural - --- | A 'Signed' that is either zero or negative; --- the 'Natural' gives the magnitude of the negative -pattern NotPlus :: Natural -> Signed -pattern NotPlus x <- ((toNatural . negate) -> Just x) - where NotPlus = negate . fromNatural - -{-# complete Zero, Minus, Plus #-} -{-# complete Plus, NotPlus #-} -{-# complete Minus, NotMinus #-} - -fromPositive :: Positive -> Signed -fromPositive = Plus - -toPositive :: Signed -> Maybe Positive -toPositive (Plus x) = Just x -toPositive _ = Nothing - -fromNatural :: Natural -> Signed -fromNatural 0 = Zero -fromNatural x = Plus $ Positive.Unsafe.fromNatural x - -toNatural :: Signed -> Maybe Natural -toNatural (Minus _) = Nothing -toNatural Zero = Just 0 -toNatural (Plus x) = Just (Positive.Unsafe.toNatural x) - -add :: Signed -> Signed -> Signed -add Zero x = x -add x Zero = x -add (NonZero sa a) (NonZero sb b) = case (sa, sb) of - (PlusSign, PlusSign) -> Plus $ a Num.+ b - (MinusSign, MinusSign) -> Minus $ a Num.+ b - - (MinusSign, PlusSign) -> case Ord.compare a b of - Ord.EQ -> Zero - Ord.LT -> Plus $ Positive.Unsafe.subtract b a - Ord.GT -> Minus $ Positive.Unsafe.subtract a b - - (PlusSign, MinusSign) -> case Ord.compare a b of - Ord.EQ -> Zero - Ord.LT -> Minus $ Positive.Unsafe.subtract b a - Ord.GT -> Plus $ Positive.Unsafe.subtract a b - -negate :: Signed -> Signed -negate Zero = Zero -negate (NonZero s x) = NonZero (Sign.negate s) x - -multiply :: Signed -> Signed -> Signed -multiply Zero _ = Zero -multiply _ Zero = Zero -multiply (NonZero sa a) (NonZero sb b) = - NonZero (Sign.multiply sa sb) (a Num.* b) - -abs :: Signed -> Signed -abs Zero = Zero -abs x@(NonZero s p) = case s of - PlusSign -> x - MinusSign -> NonZero PlusSign p - -signum :: Signed -> Signed -signum Zero = Zero -signum (NonZero s _) = NonZero s Positive.Unsafe.one - -fromInteger :: Integer -> Signed -fromInteger x = case Ord.compare x 0 of - Ord.EQ -> Zero - Ord.LT -> Minus $ Positive.Unsafe.fromInteger $ Num.abs x - Ord.GT -> Plus $ Positive.Unsafe.fromInteger x - -toInteger :: Signed -> Integer -toInteger Zero = 0 -toInteger (Plus x) = Positive.Unsafe.toInteger x -toInteger (Minus x) = Num.negate $ Positive.Unsafe.toInteger x - -toInt :: Signed -> Maybe Int -toInt x = case x of - Zero -> Just 0 - Plus p -> if ok then Just (Num.fromInteger i) else Nothing - where - ok = i Ord.<= Num.toInteger (Bounded.maxBound :: Int) - i = Positive.Unsafe.toInteger p - Minus p -> if ok then Just (Num.fromInteger i) else Nothing - where - ok = i Ord.>= Num.toInteger (Bounded.minBound :: Int) - i = Num.negate (Positive.Unsafe.toInteger p) - -fromInt :: Int -> Signed -fromInt x = case Ord.compare x 0 of - Ord.EQ -> Zero - Ord.GT -> Plus $ Positive.Unsafe.fromInt x - Ord.LT -> Minus $ Positive.Unsafe.fromInteger $ Num.negate $ Num.toInteger x - -toWord :: Signed -> Maybe Word -toWord x = case x of - Zero -> Just 0 - Plus p -> if ok then Just (Num.fromInteger i) else Nothing - where - ok = i Ord.<= Num.toInteger (Bounded.maxBound :: Word) - i = Positive.Unsafe.toInteger p - Minus _ -> Nothing - -fromWord :: Word -> Signed -fromWord x = case x of - 0 -> Zero - _ -> Plus $ Positive.Unsafe.fromInteger (Num.toInteger x) - -type Div a = a -> a -> (a, a) - -divisionOp :: Div Integer -> Div Signed -divisionOp o a b = - let (q, r) = o (toInteger a) (toInteger b) - in (fromInteger q, fromInteger r) - -instance Num Signed - where - (+) = add - (*) = multiply - negate = negate - abs = abs - signum = signum - fromInteger = fromInteger - -instance Enum Signed - where - pred = fromInteger . Enum.pred . toInteger - succ = fromInteger . Enum.succ . toInteger - - toEnum = fromInteger . Enum.toEnum - fromEnum = Enum.fromEnum . toInteger - - enumFrom a = List.map fromInteger $ Enum.enumFrom (toInteger a) - enumFromTo a b = List.map fromInteger $ Enum.enumFromTo (toInteger a) (toInteger b) - enumFromThen a b = List.map fromInteger $ Enum.enumFromThen (toInteger a) (toInteger b) - enumFromThenTo a b c = List.map fromInteger $ Enum.enumFromThenTo (toInteger a) (toInteger b) (toInteger c) - -instance Real Signed - where - toRational = Num.toRational . toInteger - -instance Integral Signed - where - toInteger = toInteger - quotRem = divisionOp Num.quotRem - divMod = divisionOp Num.divMod - -instance Show Signed - where - show = Show.show . Num.toInteger - showsPrec i = Show.showsPrec i . Num.toInteger diff --git a/integer-types/Integer/Subtraction.hs b/integer-types/Integer/Subtraction.hs deleted file mode 100644 --- a/integer-types/Integer/Subtraction.hs +++ /dev/null @@ -1,47 +0,0 @@ -module Integer.Subtraction - ( - Subtraction (subtractInteger, subtractSigned), - Subtraction' (subtract), - ) - where - -import Integer.Integer (Integer) -import Integer.Natural (Natural) -import Integer.Positive (Positive) -import Integer.Signed (Signed) - -import qualified Integer.Natural as Natural -import qualified Integer.Positive as Positive -import qualified Integer.Signed as Signed -import qualified Prelude as Num (Num (..)) - --- | Domain of a subtraction operation -class Subtraction a where - subtractInteger :: a -> a -> Integer - subtractInteger a b = Signed.toInteger (subtractSigned a b) - - subtractSigned :: a -> a -> Signed - subtractSigned a b = Signed.fromInteger (subtractInteger a b) - -instance Subtraction Integer where - subtractInteger = (Num.-) - -instance Subtraction Signed where - subtractInteger a b = (Num.-) (Signed.toInteger a) (Signed.toInteger b) - subtractSigned = (Num.-) - -instance Subtraction Natural where - subtractSigned = Natural.subtract - -instance Subtraction Positive where - subtractSigned = Positive.subtract - --- | Codomain of a subtraction operation -class Subtraction' b where - subtract :: Subtraction a => a -> a -> b - -instance Subtraction' Integer where - subtract = subtractInteger - -instance Subtraction' Signed where - subtract = subtractSigned diff --git a/library/Integer.hs b/library/Integer.hs new file mode 100644 --- /dev/null +++ b/library/Integer.hs @@ -0,0 +1,22 @@ +module Integer + ( + {- ** Types -} Integer, Natural, Positive, + Signed (Zero, NonZero, Minus, Plus), Sign (MinusSign, PlusSign), + {- ** Subtraction -} Subtraction (subtractInteger, subtractSigned), Subtraction' (subtract), + {- ** Conversion -} IntegerNarrow (narrow), IntegerConvert (convert), IntegerEquiv, yolo, ConvertWithFinite (toInt, fromInt, toWord, fromWord), Finite (..), + {- ** Lower bound -} BoundedBelow (minBound), + ) + where + +import Integer.BoundedBelow (BoundedBelow (minBound)) +import Integer.Conversion (IntegerConvert (convert), IntegerEquiv, + IntegerNarrow (narrow), yolo) +import Integer.Finite (ConvertWithFinite (fromInt, fromWord, toInt, toWord), + Finite (..)) +import Integer.Integer (Integer) +import Integer.Natural (Natural) +import Integer.Positive (Positive) +import Integer.Sign (Sign (MinusSign, PlusSign)) +import Integer.Signed (Signed (Minus, NonZero, Plus, Zero)) +import Integer.Subtraction (Subtraction (subtractInteger, subtractSigned), + Subtraction' (subtract)) diff --git a/library/Integer/BoundedBelow.hs b/library/Integer/BoundedBelow.hs new file mode 100644 --- /dev/null +++ b/library/Integer/BoundedBelow.hs @@ -0,0 +1,11 @@ +module Integer.BoundedBelow where + +import Numeric.Natural (Natural) + +class BoundedBelow a where + minBound :: a + +instance BoundedBelow Natural where + minBound = 0 + + diff --git a/library/Integer/Conversion.hs b/library/Integer/Conversion.hs new file mode 100644 --- /dev/null +++ b/library/Integer/Conversion.hs @@ -0,0 +1,91 @@ +module Integer.Conversion + ( + IntegerNarrow (narrow), + IntegerConvert (convert), + IntegerEquiv, + yolo, + ) + where + +import Essentials + +import Integer.Integer (Integer) +import Integer.Natural (Natural) +import Integer.Positive (Positive) +import Integer.Signed (Signed) + +import qualified Integer.Integer as Integer +import qualified Integer.Natural as Natural +import qualified Integer.Positive as Positive +import qualified Integer.Signed as Signed +import qualified Prelude as Num (Integral (..), Num (..)) + +class IntegerNarrow a b => IntegerConvert a b where + convert :: a -> b + +class IntegerNarrow a b where + narrow :: a -> Maybe b + +class (IntegerConvert a b, IntegerConvert b a) => IntegerEquiv a b + + +--- Isomorphisms --- + +instance IntegerEquiv Integer Integer +instance IntegerConvert Integer Integer where convert = id +instance IntegerNarrow Integer Integer where narrow = Just + +instance IntegerEquiv Natural Natural +instance IntegerConvert Natural Natural where convert = id +instance IntegerNarrow Natural Natural where narrow = Just + +instance IntegerEquiv Positive Positive +instance IntegerConvert Positive Positive where convert = id +instance IntegerNarrow Positive Positive where narrow = Just + +instance IntegerEquiv Signed Signed +instance IntegerConvert Signed Signed where convert = id +instance IntegerNarrow Signed Signed where narrow = Just + +instance IntegerEquiv Integer Signed +instance IntegerConvert Integer Signed where convert = Integer.toSigned +instance IntegerNarrow Integer Signed where narrow = Just . convert + +instance IntegerEquiv Signed Integer +instance IntegerConvert Signed Integer where convert = Signed.toInteger +instance IntegerNarrow Signed Integer where narrow = Just . convert + + +--- Prisms --- + +instance IntegerNarrow Integer Natural where narrow = Integer.toNatural +instance IntegerNarrow Natural Integer where narrow = Just . convert +instance IntegerConvert Natural Integer where convert = Natural.toInteger + +instance IntegerNarrow Signed Natural where narrow = Signed.toNatural +instance IntegerNarrow Natural Signed where narrow = Just . convert +instance IntegerConvert Natural Signed where convert = Natural.toSigned + +instance IntegerNarrow Integer Positive where narrow = Integer.toPositive +instance IntegerNarrow Positive Integer where narrow = Just . convert +instance IntegerConvert Positive Integer where convert = Positive.toInteger + +instance IntegerNarrow Natural Positive where narrow = Natural.toPositive +instance IntegerNarrow Positive Natural where narrow = Just . convert +instance IntegerConvert Positive Natural where convert = Positive.toNatural + +instance IntegerNarrow Signed Positive where narrow = Signed.toPositive +instance IntegerNarrow Positive Signed where narrow = Just . convert +instance IntegerConvert Positive Signed where convert = Positive.toSigned + + +--- lol --- + +-- | Partial conversion between 'Num.Integral' types via 'Integer' +-- +-- @ +-- yolo = 'Num.fromInteger' . 'Num.toInteger' +-- @ +-- +yolo :: (Num.Integral a, Num.Num b) => a -> b +yolo = Num.fromInteger . Num.toInteger diff --git a/library/Integer/Finite.hs b/library/Integer/Finite.hs new file mode 100644 --- /dev/null +++ b/library/Integer/Finite.hs @@ -0,0 +1,59 @@ +module Integer.Finite where + +import Essentials + +import Data.Int (Int) +import Data.Word (Word) +import Integer.Integer (Integer) +import Integer.Natural (Natural) +import Integer.Positive (Positive) +import Integer.Signed (Signed) +import Prelude (Integral) + +import qualified Data.Maybe as Maybe +import qualified Integer.Integer as Integer +import qualified Integer.Natural as Natural +import qualified Integer.Positive as Positive +import qualified Integer.Signed as Signed + +class ConvertWithFinite a where + toWord :: a -> Maybe Word + fromWord :: Word -> Maybe a + toInt :: a -> Maybe Int + fromInt :: Int -> Maybe a + +instance ConvertWithFinite Natural where + toWord = Natural.toWord + fromWord = Maybe.Just . Natural.fromWord + toInt = Natural.toInt + fromInt = Natural.fromInt + +instance ConvertWithFinite Positive where + toWord = Positive.toWord + fromWord = Positive.fromWord + toInt = Positive.toInt + fromInt = Positive.fromInt + +instance ConvertWithFinite Integer where + toWord = Integer.toWord + fromWord = Maybe.Just . Integer.fromWord + toInt = Integer.toInt + fromInt = Maybe.Just . Integer.fromInt + +instance ConvertWithFinite Signed where + toWord = Signed.toWord + fromWord = Maybe.Just . Signed.fromWord + toInt = Signed.toInt + fromInt = Maybe.Just . Signed.fromInt + +class (Bounded b, Integral b) => Finite b where + toFinite :: ConvertWithFinite a => a -> Maybe b + fromFinite :: ConvertWithFinite a => b -> Maybe a + +instance Finite Int where + toFinite = toInt + fromFinite = fromInt + +instance Finite Word where + toFinite = toWord + fromFinite = fromWord diff --git a/library/Integer/Integer.hs b/library/Integer/Integer.hs new file mode 100644 --- /dev/null +++ b/library/Integer/Integer.hs @@ -0,0 +1,64 @@ +module Integer.Integer + ( + {- * Type -} Integer, + {- * Conversion -} + {- ** Positive -} toPositive, fromPositive, + {- ** Natural -} toNatural, fromNatural, + {- ** Signed -} toSigned, fromSigned, + {- ** Int -} toInt, fromInt, + {- ** Word -} toWord, fromWord, + ) + where + +import Essentials + +import Data.Int (Int) +import Data.Word (Word) +import Integer.Positive (Positive) +import Integer.Signed (Signed (..)) +import Numeric.Natural (Natural) +import Prelude (Integer) + +import qualified Data.Bool as Bool +import qualified Data.Ord as Ord +import qualified Integer.Natural as Natural +import qualified Integer.Positive as Positive +import qualified Integer.Signed as Signed +import qualified Prelude as Bounded (Bounded (..)) +import qualified Prelude as Num (Integral (..), Num (..)) + +toPositive :: Integer -> Maybe Positive +toPositive = Positive.fromInteger + +fromPositive :: Positive -> Integer +fromPositive = Positive.toInteger + +toNatural :: Integer -> Maybe Natural +toNatural = Natural.fromInteger + +fromNatural :: Natural -> Integer +fromNatural = Natural.toInteger + +toSigned :: Integer -> Signed +toSigned = Signed.fromInteger + +fromSigned :: Signed -> Integer +fromSigned = Signed.toInteger + +toInt :: Integer -> Maybe Int +toInt x = if ok then Just (Num.fromInteger x) else Nothing + where + ok = x Ord.>= Num.toInteger (Bounded.minBound :: Int) Bool.&& + x Ord.<= Num.toInteger (Bounded.maxBound :: Int) + +fromInt :: Int -> Integer +fromInt = Num.toInteger + +toWord :: Integer -> Maybe Word +toWord x = if ok then Just (Num.fromInteger x) else Nothing + where + ok = x Ord.>= Num.toInteger (Bounded.minBound :: Word) Bool.&& + x Ord.<= Num.toInteger (Bounded.maxBound :: Word) + +fromWord :: Word -> Integer +fromWord = Num.toInteger diff --git a/library/Integer/Natural.hs b/library/Integer/Natural.hs new file mode 100644 --- /dev/null +++ b/library/Integer/Natural.hs @@ -0,0 +1,84 @@ +module Integer.Natural + ( + {- * Type -} Natural, + {- * Subtraction -} subtract, + {- * Conversion -} + {- ** Positive -} toPositive, fromPositive, + {- ** Integer -} toInteger, fromInteger, + {- ** Signed -} toSigned, fromSigned, + {- ** Int -} toInt, fromInt, + {- ** Word -} toWord, fromWord, + {- * One (1) -} one, addOne, subtractOne, + ) + where + +import Essentials + +import Data.Int (Int) +import Data.Word (Word) +import Integer.Signed (Signed (..)) +import Numeric.Natural (Natural) +import Prelude (Integer) + +import qualified Data.Ord as Ord +import qualified Integer.Positive as Positive +import qualified Integer.Positive.Unsafe as Positive.Unsafe +import qualified Integer.Signed as Signed +import qualified Prelude as Bounded (Bounded (..)) +import qualified Prelude as Num (Integral (..), Num (..)) + +toPositive :: Natural -> Maybe Positive.Unsafe.Positive +toPositive = Positive.fromNatural + +fromPositive :: Positive.Unsafe.Positive -> Natural +fromPositive = Positive.toNatural + +fromInteger :: Integer -> Maybe Natural +fromInteger x = if x Ord.>= 0 then Just (Num.fromInteger x) else Nothing + +toInteger :: Natural -> Integer +toInteger = Num.toInteger + +toSigned :: Natural -> Signed +toSigned = Signed.fromNatural + +fromSigned :: Signed -> Maybe Natural +fromSigned = Signed.toNatural + +toInt :: Natural -> Maybe Int +toInt x = if ok then Just (Num.fromInteger x') else Nothing + where + ok = x' Ord.<= Num.toInteger (Bounded.maxBound :: Int) + x' = Num.toInteger x + +fromInt :: Int -> Maybe Natural +fromInt x = if ok then Just (Num.fromInteger x') else Nothing + where + ok = x Ord.>= 0 + x' = Num.toInteger x + +toWord :: Natural -> Maybe Word +toWord x = if ok then Just (Num.fromInteger x') else Nothing + where + ok = x' Ord.<= Num.toInteger (Bounded.maxBound :: Word) + x' = Num.toInteger x + +fromWord :: Word -> Natural +fromWord x = Num.fromInteger (Num.toInteger x) + +subtract :: Natural -> Natural -> Signed +subtract a b = case Ord.compare a b of + Ord.EQ -> Zero + Ord.GT -> Plus $ Positive.Unsafe.fromNatural $ (Num.-) a b + Ord.LT -> Minus $ Positive.Unsafe.fromNatural $ (Num.-) b a + +one :: Natural +one = 1 + +addOne :: Integer -> Integer +addOne = (Num.+ 1) + +subtractOne :: Natural -> Maybe Signed +subtractOne x = case x of + 0 -> Nothing + p -> Just (subtract p 1) diff --git a/library/Integer/Positive.hs b/library/Integer/Positive.hs new file mode 100644 --- /dev/null +++ b/library/Integer/Positive.hs @@ -0,0 +1,73 @@ +module Integer.Positive + ( + {- * Type -} Positive, + {- * Subtraction -} subtract, + {- * Conversion -} + {- ** Natural -} toNatural, fromNatural, + {- ** Integer -} toInteger, fromInteger, + {- ** Signed -} toSigned, fromSigned, + {- ** Int -} toInt, fromInt, + {- ** Word -} toWord, fromWord, + {- * One (1) -} one, addOne, subtractOne, + ) + where + +import Essentials + +import Data.Int (Int) +import Data.Word (Word) +import Integer.Positive.Unsafe (Positive, addOne, one, toInteger, toNatural) +import Integer.Signed (Signed (..)) +import Numeric.Natural (Natural) +import Prelude (Integer) + +import qualified Data.Ord as Ord +import qualified Integer.Positive.Unsafe as Unsafe +import qualified Prelude as Bounded (Bounded (..)) +import qualified Prelude as Num (Integral (..), Num (..)) + +fromInteger :: Integer -> Maybe Positive +fromInteger x = if x Ord.> 0 then Just (Unsafe.fromInteger x) else Nothing + +fromNatural :: Natural -> Maybe Positive +fromNatural x = case x of 0 -> Nothing; _ -> Just (Unsafe.fromNatural x) + +toInt :: Positive -> Maybe Int +toInt x = if ok then Just (Num.fromInteger x') else Nothing + where + ok = x' Ord.<= Num.toInteger (Bounded.maxBound :: Int) + x' = Num.toInteger x + +fromInt :: Int -> Maybe Positive +fromInt x = if ok then Just (Num.fromInteger x') else Nothing + where + ok = x' Ord.>= 1 + x' = Num.toInteger x + +toWord :: Positive -> Maybe Word +toWord x = if ok then Just (Num.fromInteger x') else Nothing + where + ok = x' Ord.<= Num.toInteger (Bounded.maxBound :: Word) + x' = Num.toInteger x + +fromWord :: Word -> Maybe Positive +fromWord x = if ok then Just (Num.fromInteger x') else Nothing + where + ok = x' Ord.>= 1 + x' = Num.toInteger x + +subtract :: Positive -> Positive -> Signed +subtract a b = case Ord.compare a b of + Ord.EQ -> Zero + Ord.GT -> Plus $ Unsafe.subtract a b + Ord.LT -> Minus $ Unsafe.subtract b a + +subtractOne :: Positive -> Natural +subtractOne x = toNatural x Num.- 1 + +toSigned :: Positive -> Signed +toSigned = Plus + +fromSigned :: Signed -> Maybe Positive +fromSigned (Plus x) = Just x +fromSigned _ = Nothing diff --git a/library/Integer/Positive/Unsafe.hs b/library/Integer/Positive/Unsafe.hs new file mode 100644 --- /dev/null +++ b/library/Integer/Positive/Unsafe.hs @@ -0,0 +1,159 @@ +{- | This module is unsafe not merely in the sense that it contains partial +functions, but moreover than it is capable of constructing the invalid +'Positive' value @'FromNatural' 0@ representing zero, which is not positive. +When a function has "checked" in its name, this indicates that it is partial but +will never construct an invalid 'Positive'. -} + +module Integer.Positive.Unsafe + ( + {- * Type -} Positive (FromNatural), + {- * Conversion -} + {- ** Natural -} toNatural, fromNatural, fromNaturalChecked, + {- ** Integer -} toInteger, fromInteger, fromIntegerChecked, + {- ** Int -} toInt, fromInt, fromIntChecked, + {- * Arithmetic -} subtract, subtractChecked, + {- * One (1) -} one, addOne, subtractOne, subtractOneChecked, + ) + where + +import Essentials ( ($), Enum, Eq, Ord, Show, (.), id ) + +import Integer.BoundedBelow (BoundedBelow) +import Numeric.Natural (Natural) +import Prelude (Int, Integer, Integral, Num, Real) + +import qualified Control.DeepSeq as DeepSeq +import qualified Control.Exception as Exception +import qualified Data.Bits as Bits +import qualified Data.List as List +import qualified Data.Maybe as Maybe +import qualified Data.Ord as Ord +import qualified Integer.BoundedBelow as BoundedBelow +import qualified Prelude as Enum (Enum (..)) +import qualified Prelude as Num (Integral (..), Num (..), Real (..), + fromIntegral) +import qualified Text.Show as Show + +newtype Positive = FromNatural{ toNatural :: Natural } deriving (Eq, Ord) + +instance DeepSeq.NFData Positive where rnf (FromNatural x) = DeepSeq.rnf x + +fromNatural :: Natural -> Positive +fromNatural = FromNatural + +fromNaturalChecked :: Natural -> Positive +fromNaturalChecked x = case x of 0 -> Exception.throw Exception.Underflow; _ -> fromNatural x + +toInteger :: Positive -> Integer +toInteger = Num.toInteger . toNatural + +fromInteger :: Integer -> Positive +fromInteger = fromNatural . Num.fromInteger + +fromIntegerChecked :: Integer -> Positive +fromIntegerChecked x = if x Ord.>= 1 then fromInteger x else Exception.throw Exception.Underflow + +add :: Positive -> Positive -> Positive +add a b = fromNatural (toNatural a Num.+ toNatural b) + +subtract :: Positive -> Positive -> Positive +subtract a b = fromNatural (toNatural a Num.- toNatural b) + +subtractChecked :: Positive -> Positive -> Positive +subtractChecked a b = if a Ord.> b then subtract a b else Exception.throw Exception.Underflow + +multiply :: Positive -> Positive -> Positive +multiply a b = fromNatural (toNatural a Num.* toNatural b) + +one :: Positive +one = fromNatural 1 + +addOne :: Positive -> Positive +addOne = fromNatural . (Num.+ 1) . toNatural + +subtractOne :: Positive -> Positive +subtractOne = fromNatural . (Num.- 1) . toNatural + +subtractOneChecked :: Positive -> Positive +subtractOneChecked x = case x of { 1 -> Exception.throw Exception.Underflow; _ -> subtractOne x } + +toInt :: Positive -> Int +toInt = Num.fromIntegral . toNatural + +toIntChecked :: Positive -> Int +toIntChecked = Maybe.fromMaybe (Exception.throw Exception.Overflow) . Bits.toIntegralSized . toNatural + +fromInt :: Int -> Positive +fromInt = fromNatural . Num.fromIntegral + +fromIntChecked :: Int -> Positive +fromIntChecked x = case Num.signum x of { 1 -> fromInt x; _ -> Exception.throw Exception.Underflow } + +enumFrom :: Positive -> [Positive] +enumFrom = List.map fromNatural . Enum.enumFrom . toNatural + +enumFromTo :: Positive -> Positive -> [Positive] +enumFromTo a b = List.map fromNatural $ Enum.enumFromTo (toNatural a) (toNatural b) + +enumFromThen :: Positive -> Positive -> [Positive] +enumFromThen a b = if a Ord.< b then ascending else descending + where + ascending = List.map fromNatural $ Enum.enumFromThen (toNatural a) (toNatural b) + descending = List.map fromInteger $ List.takeWhile (Ord.>= 1) $ + Enum.enumFromThen (toInteger a) (toInteger b) + +enumFromThenTo :: Positive -> Positive -> Positive -> [Positive] +enumFromThenTo a b c = if a Ord.< b then ascending else descending + where + ascending = List.map fromNatural $ Enum.enumFromThenTo (toNatural a) (toNatural b) (toNatural c) + descending = List.map fromInteger $ List.takeWhile (Ord.>= 1) $ + Enum.enumFromThenTo (toInteger a) (toInteger b) (toInteger c) + +type Div a = a -> a -> (a, a) + +divisionOp :: Div Natural -> Div Positive +divisionOp o a b = + let (q, r) = o (toNatural a) (toNatural b) + in (fromNaturalChecked q, fromNaturalChecked r) + +instance BoundedBelow Positive + where + minBound = 1 + +instance Num Positive + where + abs = id + negate = \_ -> Exception.throw Exception.Underflow + signum = \_ -> fromNatural 1 + fromInteger = fromIntegerChecked + (+) = add + (*) = multiply + (-) = subtractChecked + +instance Enum Positive + where + succ = addOne + pred = subtractOneChecked + + fromEnum = toIntChecked + toEnum = fromIntChecked + + enumFrom = enumFrom + enumFromTo = enumFromTo + enumFromThen = enumFromThen + enumFromThenTo = enumFromThenTo + +instance Real Positive + where + toRational = Num.toRational . toInteger + +instance Integral Positive + where + toInteger = toInteger + quotRem = divisionOp Num.quotRem + divMod = divisionOp Num.divMod + +instance Show Positive + where + show = Show.show . toNatural + showsPrec i = Show.showsPrec i . toNatural diff --git a/library/Integer/Sign.hs b/library/Integer/Sign.hs new file mode 100644 --- /dev/null +++ b/library/Integer/Sign.hs @@ -0,0 +1,24 @@ +module Integer.Sign + ( + {- * Type -} Sign (..), + {- * Operations -} negate, multiply, + ) + where + +import Essentials + +import Prelude (seq) + +import qualified Control.DeepSeq as DeepSeq + +data Sign = MinusSign | PlusSign + deriving (Eq, Ord, Show) + +instance DeepSeq.NFData Sign where rnf x = seq x () + +negate :: Sign -> Sign +negate PlusSign = MinusSign +negate MinusSign = PlusSign + +multiply :: Sign -> Sign -> Sign +multiply a b = if a == b then PlusSign else MinusSign diff --git a/library/Integer/Signed.hs b/library/Integer/Signed.hs new file mode 100644 --- /dev/null +++ b/library/Integer/Signed.hs @@ -0,0 +1,211 @@ +module Integer.Signed + ( + {- * Type -} Signed (Zero, NonZero, Plus, Minus, NotPlus, NotMinus), + {- * Conversion -} + {- ** Integer -} toInteger, fromInteger, + {- ** Natural -} toNatural, fromNatural, + {- ** Positive -} toPositive, fromPositive, + {- ** Int -} toInt, fromInt, + {- ** Word -} toWord, fromWord, + ) + where + +import Essentials + +import Data.Int (Int) +import Data.Word (Word) +import Integer.Positive.Unsafe (Positive) +import Integer.Sign (Sign (..)) +import Numeric.Natural (Natural) +import Prelude (Integer, Integral, Num, Real, seq) + +import qualified Control.DeepSeq as DeepSeq +import qualified Data.List as List +import qualified Data.Ord as Ord +import qualified Integer.Positive.Unsafe as Positive.Unsafe +import qualified Integer.Sign as Sign +import qualified Prelude as Bounded (Bounded (..)) +import qualified Prelude as Enum (Enum (..)) +import qualified Prelude as Num (Integral (..), Num (..), Real (..)) +import qualified Text.Show as Show + +data Signed = Zero | NonZero Sign Positive + deriving (Eq) + +instance Ord Signed where + compare Zero Zero = Ord.EQ + + compare Zero (Minus _) = Ord.GT + compare Zero (Plus _ ) = Ord.LT + compare (Minus _) Zero = Ord.LT + compare (Plus _) Zero = Ord.GT + + compare (Plus _) (Minus _) = Ord.GT + compare (Minus _) (Plus _) = Ord.LT + compare (Plus a) (Plus b) = Ord.compare a b + compare (Minus a) (Minus b) = Ord.compare b a + +instance DeepSeq.NFData Signed where + rnf Zero = () + rnf (NonZero a b) = a `seq` b `seq` () + +pattern Minus :: Positive -> Signed +pattern Minus x = NonZero MinusSign x +pattern Plus :: Positive -> Signed + +pattern Plus x = NonZero PlusSign x + +-- | A 'Signed' that is either zero or positive +pattern NotMinus :: Natural -> Signed +pattern NotMinus x <- (toNatural -> Just x) + where NotMinus = fromNatural + +-- | A 'Signed' that is either zero or negative; +-- the 'Natural' gives the magnitude of the negative +pattern NotPlus :: Natural -> Signed +pattern NotPlus x <- ((toNatural . negate) -> Just x) + where NotPlus = negate . fromNatural + +{-# complete Zero, Minus, Plus #-} +{-# complete Plus, NotPlus #-} +{-# complete Minus, NotMinus #-} + +fromPositive :: Positive -> Signed +fromPositive = Plus + +toPositive :: Signed -> Maybe Positive +toPositive (Plus x) = Just x +toPositive _ = Nothing + +fromNatural :: Natural -> Signed +fromNatural 0 = Zero +fromNatural x = Plus $ Positive.Unsafe.fromNatural x + +toNatural :: Signed -> Maybe Natural +toNatural (Minus _) = Nothing +toNatural Zero = Just 0 +toNatural (Plus x) = Just (Positive.Unsafe.toNatural x) + +add :: Signed -> Signed -> Signed +add Zero x = x +add x Zero = x +add (NonZero sa a) (NonZero sb b) = case (sa, sb) of + (PlusSign, PlusSign) -> Plus $ a Num.+ b + (MinusSign, MinusSign) -> Minus $ a Num.+ b + + (MinusSign, PlusSign) -> case Ord.compare a b of + Ord.EQ -> Zero + Ord.LT -> Plus $ Positive.Unsafe.subtract b a + Ord.GT -> Minus $ Positive.Unsafe.subtract a b + + (PlusSign, MinusSign) -> case Ord.compare a b of + Ord.EQ -> Zero + Ord.LT -> Minus $ Positive.Unsafe.subtract b a + Ord.GT -> Plus $ Positive.Unsafe.subtract a b + +negate :: Signed -> Signed +negate Zero = Zero +negate (NonZero s x) = NonZero (Sign.negate s) x + +multiply :: Signed -> Signed -> Signed +multiply Zero _ = Zero +multiply _ Zero = Zero +multiply (NonZero sa a) (NonZero sb b) = + NonZero (Sign.multiply sa sb) (a Num.* b) + +abs :: Signed -> Signed +abs Zero = Zero +abs x@(NonZero s p) = case s of + PlusSign -> x + MinusSign -> NonZero PlusSign p + +signum :: Signed -> Signed +signum Zero = Zero +signum (NonZero s _) = NonZero s Positive.Unsafe.one + +fromInteger :: Integer -> Signed +fromInteger x = case Ord.compare x 0 of + Ord.EQ -> Zero + Ord.LT -> Minus $ Positive.Unsafe.fromInteger $ Num.abs x + Ord.GT -> Plus $ Positive.Unsafe.fromInteger x + +toInteger :: Signed -> Integer +toInteger Zero = 0 +toInteger (Plus x) = Positive.Unsafe.toInteger x +toInteger (Minus x) = Num.negate $ Positive.Unsafe.toInteger x + +toInt :: Signed -> Maybe Int +toInt x = case x of + Zero -> Just 0 + Plus p -> if ok then Just (Num.fromInteger i) else Nothing + where + ok = i Ord.<= Num.toInteger (Bounded.maxBound :: Int) + i = Positive.Unsafe.toInteger p + Minus p -> if ok then Just (Num.fromInteger i) else Nothing + where + ok = i Ord.>= Num.toInteger (Bounded.minBound :: Int) + i = Num.negate (Positive.Unsafe.toInteger p) + +fromInt :: Int -> Signed +fromInt x = case Ord.compare x 0 of + Ord.EQ -> Zero + Ord.GT -> Plus $ Positive.Unsafe.fromInt x + Ord.LT -> Minus $ Positive.Unsafe.fromInteger $ Num.negate $ Num.toInteger x + +toWord :: Signed -> Maybe Word +toWord x = case x of + Zero -> Just 0 + Plus p -> if ok then Just (Num.fromInteger i) else Nothing + where + ok = i Ord.<= Num.toInteger (Bounded.maxBound :: Word) + i = Positive.Unsafe.toInteger p + Minus _ -> Nothing + +fromWord :: Word -> Signed +fromWord x = case x of + 0 -> Zero + _ -> Plus $ Positive.Unsafe.fromInteger (Num.toInteger x) + +type Div a = a -> a -> (a, a) + +divisionOp :: Div Integer -> Div Signed +divisionOp o a b = + let (q, r) = o (toInteger a) (toInteger b) + in (fromInteger q, fromInteger r) + +instance Num Signed + where + (+) = add + (*) = multiply + negate = negate + abs = abs + signum = signum + fromInteger = fromInteger + +instance Enum Signed + where + pred = fromInteger . Enum.pred . toInteger + succ = fromInteger . Enum.succ . toInteger + + toEnum = fromInteger . Enum.toEnum + fromEnum = Enum.fromEnum . toInteger + + enumFrom a = List.map fromInteger $ Enum.enumFrom (toInteger a) + enumFromTo a b = List.map fromInteger $ Enum.enumFromTo (toInteger a) (toInteger b) + enumFromThen a b = List.map fromInteger $ Enum.enumFromThen (toInteger a) (toInteger b) + enumFromThenTo a b c = List.map fromInteger $ Enum.enumFromThenTo (toInteger a) (toInteger b) (toInteger c) + +instance Real Signed + where + toRational = Num.toRational . toInteger + +instance Integral Signed + where + toInteger = toInteger + quotRem = divisionOp Num.quotRem + divMod = divisionOp Num.divMod + +instance Show Signed + where + show = Show.show . Num.toInteger + showsPrec i = Show.showsPrec i . Num.toInteger diff --git a/library/Integer/Subtraction.hs b/library/Integer/Subtraction.hs new file mode 100644 --- /dev/null +++ b/library/Integer/Subtraction.hs @@ -0,0 +1,47 @@ +module Integer.Subtraction + ( + Subtraction (subtractInteger, subtractSigned), + Subtraction' (subtract), + ) + where + +import Integer.Integer (Integer) +import Integer.Natural (Natural) +import Integer.Positive (Positive) +import Integer.Signed (Signed) + +import qualified Integer.Natural as Natural +import qualified Integer.Positive as Positive +import qualified Integer.Signed as Signed +import qualified Prelude as Num (Num (..)) + +-- | Domain of a subtraction operation +class Subtraction a where + subtractInteger :: a -> a -> Integer + subtractInteger a b = Signed.toInteger (subtractSigned a b) + + subtractSigned :: a -> a -> Signed + subtractSigned a b = Signed.fromInteger (subtractInteger a b) + +instance Subtraction Integer where + subtractInteger = (Num.-) + +instance Subtraction Signed where + subtractInteger a b = (Num.-) (Signed.toInteger a) (Signed.toInteger b) + subtractSigned = (Num.-) + +instance Subtraction Natural where + subtractSigned = Natural.subtract + +instance Subtraction Positive where + subtractSigned = Positive.subtract + +-- | Codomain of a subtraction operation +class Subtraction' b where + subtract :: Subtraction a => a -> a -> b + +instance Subtraction' Integer where + subtract = subtractInteger + +instance Subtraction' Signed where + subtract = subtractSigned diff --git a/test-integer-arithmetic/Main.hs b/test-integer-arithmetic/Main.hs deleted file mode 100644 --- a/test-integer-arithmetic/Main.hs +++ /dev/null @@ -1,78 +0,0 @@ -{-# language TemplateHaskell #-} -{-# options_ghc -fno-warn-missing-signatures #-} - -module Main (main) where - -import Integer - -import Control.Applicative (pure) -import Control.Monad (Monad) -import Data.Eq (Eq) -import Data.Function (($), (.)) -import Data.Maybe (Maybe (Just, Nothing)) -import Hedgehog ((===)) -import Integer.Gen (GenIntegral) -import Prelude (Num, fromInteger, toInteger, ($!), (*), (+), (-)) -import Text.Show (Show) - -import qualified Control.Exception as Exception (ArithException (Underflow)) -import qualified Control.Monad.Catch as Exception (MonadCatch, try) -import qualified Data.Either as Either -import qualified Hedgehog -import qualified Hedgehog.Main as Hedgehog -import qualified Integer.Gen as Gen - -main = Hedgehog.defaultMain [Hedgehog.checkSequential $$(Hedgehog.discover)] - -testLimit :: Hedgehog.TestLimit -testLimit = 1000 - -property = Hedgehog.withTests testLimit . Hedgehog.property - --- | Assert that a closed binary 'Num' operation behaves the same --- on a type as it does when applied via conversion with 'Integer' -checkNumOp :: forall a m. GenIntegral a => Monad m => - (forall b. Num b => b -> b -> b) -> Hedgehog.PropertyT m () -checkNumOp o = do - x :: a <- Hedgehog.forAll Gen.integral - y :: a <- Hedgehog.forAll Gen.integral - x `o` y === fromInteger (toInteger x `o` toInteger y) - --- | Assert that 'subtract' in @a@ gives the same result --- as '(-)' via @b@. -checkSubtract :: forall a b m. - (GenIntegral a, Subtraction a, Subtraction' b, Num b) => - (IntegerConvert a b, IntegerNarrow b a) => - (Eq b, Show b) => - Exception.MonadCatch m => Hedgehog.PropertyT m () -checkSubtract = do - x :: a <- Hedgehog.forAll Gen.integral - y :: a <- Hedgehog.forAll Gen.integral - (subtract x y :: b) === (convert x - convert y :: b) - --- | Assert that '(-)' in @a@ gives the same result as --- '(-)' via @Integer@ if the result is within the range --- of @a@, and is undefined otherwise -checkPartialSubtract :: forall a m. - (GenIntegral a, Subtraction a, IntegerNarrow Integer a) => - Exception.MonadCatch m => Hedgehog.PropertyT m () -checkPartialSubtract = do - x :: a <- Hedgehog.forAll Gen.integral - y :: a <- Hedgehog.forAll Gen.integral - case narrow (toInteger x - toInteger y) :: Maybe a of - Just z -> x - y === z - Nothing -> do - z <- Exception.try (pure $! x - y) - z === Either.Left Exception.Underflow - -prop_add_positive = property $ checkNumOp @Positive (+) -prop_add_signed = property $ checkNumOp @Signed (+) -prop_multiply_positive = property $ checkNumOp @Positive (*) -prop_multiply_signed = property $ checkNumOp @Signed (*) - -prop_subtract_natural_signed = property $ checkSubtract @Natural @Signed -prop_subtract_natural_integer = property $ checkSubtract @Natural @Integer -prop_subtract_positive_signed = property $ checkSubtract @Positive @Signed -prop_subtract_positive_integer = property $ checkSubtract @Positive @Integer - -prop_partial_subtract_positive = property $ checkPartialSubtract @Positive diff --git a/test-integer-conversions/Main.hs b/test-integer-conversions/Main.hs deleted file mode 100644 --- a/test-integer-conversions/Main.hs +++ /dev/null @@ -1,91 +0,0 @@ -{-# language TemplateHaskell #-} -{-# options_ghc -fno-warn-missing-signatures #-} - -module Main (main) where - -import Integer - -import Control.Applicative (pure) -import Control.Monad (Monad) -import Data.Eq (Eq) -import Data.Function (($), (.)) -import Data.Maybe (Maybe (..)) -import Hedgehog (evalMaybe, (===)) -import Integer.Gen (GenIntegral) -import Prelude (($!)) -import Text.Show (Show) - -import qualified Control.Exception as Exception (ArithException (Underflow)) -import qualified Control.Monad.Catch as Exception (MonadCatch, try) -import qualified Data.Either as Either -import qualified Data.Ord as Ord -import qualified Hedgehog -import qualified Hedgehog.Main as Hedgehog -import qualified Integer.Gen as Gen -import qualified Prelude as Num (toInteger) - -main = Hedgehog.defaultMain [Hedgehog.checkSequential $$(Hedgehog.discover)] - -testLimit :: Hedgehog.TestLimit -testLimit = 1000 - -property = Hedgehog.withTests testLimit . Hedgehog.property - --- | Half of an isomorphism test: @review (view x)@ = @x@ -checkIso :: forall a b m. (GenIntegral a, IntegerEquiv a b) => - Monad m => Hedgehog.PropertyT m () -checkIso = do - x :: a <- Hedgehog.forAll Gen.integral - convert (convert x :: b) === x - --- | Half of a prism test: @preview (x review)@ = @Just@ -checkConvert :: forall a b m. - (GenIntegral a, IntegerConvert a b, IntegerNarrow b a) => - Monad m => Hedgehog.PropertyT m () -checkConvert = do - x :: a <- Hedgehog.forAll Gen.integral - narrow (convert x :: b) === Just x - --- | Half of a prism test: @fmap review (preview x)@ = @Just x@ --- for @x@ in range, @Nothing@ otherwise -checkNarrow :: forall a b m. (GenIntegral a, BoundedBelow b) => - (IntegerConvert b a, IntegerNarrow a b) => - (Show b, Eq b) => Monad m => Hedgehog.PropertyT m () -checkNarrow = do - x :: a <- Hedgehog.forAll Gen.integral - let y :: Maybe b = narrow x - if x Ord.>= convert (minBound @b) - then do - z <- evalMaybe y - convert z === x - else y === Nothing - --- | Like 'checkNarrow @Integer', but tests the partial 'yolo' --- function rather than the safe 'convert' function -checkYolo :: forall a m. (GenIntegral a, BoundedBelow a) => - Exception.MonadCatch m => Hedgehog.PropertyT m () -checkYolo = do - x :: Integer <- Hedgehog.forAll Gen.integral - let y :: a = yolo x - if x Ord.>= Num.toInteger (minBound @a) - then yolo y === x - else do - z <- Exception.try (pure $! y) - z === Either.Left Exception.Underflow - -prop_iso_integer_signed = property $ checkIso @Integer @Signed -prop_iso_signed_integer = property $ checkIso @Signed @Integer - -prop_prism_natural_integer = property $ checkConvert @Natural @Integer -prop_prism_integer_natural = property $ checkNarrow @Integer @Natural -prop_prism_natural_signed = property $ checkConvert @Natural @Signed -prop_prism_signed_natural = property $ checkNarrow @Signed @Natural -prop_prism_positive_integer = property $ checkConvert @Positive @Integer -prop_prism_integer_positive = property $ checkNarrow @Integer @Positive -prop_prism_positive_signed = property $ checkConvert @Positive @Signed -prop_prism_signed_positive = property $ checkNarrow @Signed @Positive -prop_prism_positive_natural = property $ checkConvert @Positive @Natural -prop_prism_natural_positive = property $ checkNarrow @Natural @Positive - -prop_yolo_positive = property $ checkYolo @Positive -prop_yolo_natural = property $ checkYolo @Natural diff --git a/test-integer-deepseq/Main.hs b/test-integer-deepseq/Main.hs deleted file mode 100644 --- a/test-integer-deepseq/Main.hs +++ /dev/null @@ -1,40 +0,0 @@ -{-# options_ghc -fno-warn-missing-signatures #-} - -module Main (main) where - -import Integer - -import Control.Applicative (pure) -import Control.DeepSeq (NFData, ($!!)) -import Control.Exception (Exception, throw) -import Data.Either (Either (..)) -import Data.Eq (Eq) -import Data.Function (($)) -import Test.Hspec (describe, hspec, it, shouldBe) -import Text.Show (Show) - -import qualified Control.Monad.Catch as Exception (MonadCatch, try) - -data X = X - deriving (Eq, Show) - -instance Exception X - -force :: NFData a => Exception.MonadCatch m => a -> m (Either X a) -force x = Exception.try (pure $!! x) - -main = hspec $ do - describe "Signed" $ do - describe "deepseq" $ do - it "can succeed" $ do - x <- force (NonZero MinusSign 5) - x `shouldBe` Right (-5) - it "can force an error" $ do - x <- force (throw X :: Signed) - x `shouldBe` Left X - it "can force an error in sign" $ do - x <- force (NonZero (throw X) 5) - x `shouldBe` Left X - it "can force an error in magnitude" $ do - x <- force (NonZero MinusSign (throw X)) - x `shouldBe` Left X diff --git a/test-integer-enum/Main.hs b/test-integer-enum/Main.hs deleted file mode 100644 --- a/test-integer-enum/Main.hs +++ /dev/null @@ -1,71 +0,0 @@ -{-# options_ghc -fno-warn-missing-signatures #-} - -module Main (main) where - -import Integer - -import Data.Function (($)) -import Data.List (take) -import Test.Hspec (describe, hspec, it, shouldBe) - -main = hspec $ do - describe "Positive" $ do - describe "[a ..]" $ do - it "counts upward" $ - take 3 [5 :: Positive ..] `shouldBe` [5, 6, 7] - it "can start with 1" $ - take 3 [1 :: Positive ..] `shouldBe` [1, 2, 3] - describe "[a .. b]" $ do - it "counts upward" $ - [5 .. 8 :: Positive] `shouldBe` [5, 6, 7, 8] - it "can start with 1" $ - [1 .. 5 :: Positive] `shouldBe` [1, 2, 3, 4, 5] - it "does not count downward" $ do - [8 .. 5 :: Positive] `shouldBe` [] - [8 .. 7 :: Positive] `shouldBe` [] - it "can return 1 item" $ do - [3 .. 3 :: Positive] `shouldBe` [3] - [1 .. 1 :: Positive] `shouldBe` [1] - describe "[a, b ..]" $ do - it "can count upward by 1" $ do - take 5 [5, 6 :: Positive ..] `shouldBe` [5, 6, 7, 8, 9] - take 5 [1, 2 :: Positive ..] `shouldBe` [1, 2, 3, 4, 5] - it "can count downward by 1" $ - [5, 4 :: Positive ..] `shouldBe` [5, 4, 3, 2, 1] - it "can count upward by 2" $ do - take 5 [5, 7 :: Positive ..] `shouldBe` [5, 7, 9, 11, 13] - take 5 [1, 3 :: Positive ..] `shouldBe` [1, 3, 5, 7, 9] - it "can count downward by 2" $ - [9, 7 :: Positive ..] `shouldBe` [9, 7, 5, 3, 1] - it "can count downward by 2 without exactly reaching its lower bound" $ - [8, 6 :: Positive ..] `shouldBe` [8, 6, 4, 2] - it "can repeat 1 item indefinitely" $ - take 5 [4, 4 :: Positive ..] `shouldBe` [4, 4, 4, 4, 4] - describe "[a, b .. c]" $ do - it "can count upward by 1" $ do - [5, 6 .. 9 :: Positive] `shouldBe` [5, 6, 7, 8, 9] - [1, 2 .. 5 :: Positive] `shouldBe` [1, 2, 3, 4, 5] - it "can count downward by 1" $ - [9, 8 .. 5 :: Positive] `shouldBe` [9, 8, 7, 6, 5] - it "can count upward by 2" $ do - [5, 7 .. 11 :: Positive] `shouldBe` [5, 7, 9, 11] - [1, 3 .. 7 :: Positive] `shouldBe` [1, 3, 5, 7] - it "can count upward without exactly reaching its upper bound" $ - [5, 7 .. 12 :: Positive] `shouldBe` [5, 7, 9, 11] - it "can count downward by 2" $ - [11, 9 .. 5 :: Positive] `shouldBe` [11, 9, 7, 5] - it "can count downward by 2 without exactly reaching its lower bound" $ - [11, 9 .. 4 :: Positive] `shouldBe` [11, 9, 7, 5] - it "can count downward with a lower bound of 1" $ do - [7, 5 .. 1 :: Positive] `shouldBe` [7, 5, 3, 1] - [8, 6 .. 1 :: Positive] `shouldBe` [8, 6, 4, 2] - it "can repeat 1 item indefinitely" $ do - take 5 [4, 4 .. 9 :: Positive] `shouldBe` [4, 4, 4, 4, 4] - take 5 [4, 4 .. 4 :: Positive] `shouldBe` [4, 4, 4, 4, 4] - it "can return 1 item" $ do - [4, 5 .. 4 :: Positive] `shouldBe` [4] - [4, 3 .. 4 :: Positive] `shouldBe` [4] - it "can return an empty list" $ do - [4, 4 .. 3 :: Positive] `shouldBe` [] - [4, 5 .. 3 :: Positive] `shouldBe` [] - [5, 4 .. 6 :: Positive] `shouldBe` [] diff --git a/test-integer-finite/Main.hs b/test-integer-finite/Main.hs deleted file mode 100644 --- a/test-integer-finite/Main.hs +++ /dev/null @@ -1,71 +0,0 @@ -{-# language TemplateHaskell #-} -{-# options_ghc -fno-warn-missing-signatures #-} - -module Main (main) where - -import Integer - -import Control.Monad (Monad) -import Data.Eq (Eq) -import Data.Function (($), (.)) -import Data.Int (Int) -import Data.Maybe (Maybe (..)) -import Data.Word (Word) -import Hedgehog ((===)) -import Integer.Gen (GenFinite, GenIntegral) -import Text.Show (Show) - -import qualified Data.Bool as Bool -import qualified Data.Ord as Ord -import qualified Hedgehog -import qualified Hedgehog.Main as Hedgehog -import qualified Integer.Gen as Gen -import qualified Prelude as Bounded (Bounded (..)) -import qualified Prelude as Num (fromInteger, toInteger) - -main = Hedgehog.defaultMain [Hedgehog.checkSequential $$(Hedgehog.discover)] - -testLimit :: Hedgehog.TestLimit -testLimit = 1000 - -property = Hedgehog.withTests testLimit . Hedgehog.property - -checkToFinite :: forall a b m. Monad m => - (ConvertWithFinite a, GenIntegral a, Show a) => - (Integer.Finite b, Eq b, Show b) => - Hedgehog.PropertyT m () -checkToFinite = do - x :: a <- Hedgehog.forAll Gen.integral - let x' = Num.toInteger x - let ok = x' Ord.>= Num.toInteger (Bounded.minBound :: b) Bool.&& - x' Ord.<= Num.toInteger (Bounded.maxBound :: b) - (Integer.toFinite x :: Maybe b) === - if ok then Just (Num.fromInteger x') else Nothing - -checkFromFinite :: forall a b m. Monad m => - (ConvertWithFinite a, IntegerNarrow Integer a, Eq a, Show a) => - (Finite b, GenFinite b, Show b) => - Hedgehog.PropertyT m () -checkFromFinite = do - x :: b <- Hedgehog.forAll Gen.finite - (Integer.fromFinite x :: Maybe a) === Integer.narrow (Num.toInteger x) - -prop_convert_integer_int = property $ checkToFinite @Integer @Int -prop_convert_int_integer = property $ checkFromFinite @Integer @Int -prop_convert_integer_word = property $ checkToFinite @Integer @Word -prop_convert_word_integer = property $ checkFromFinite @Integer @Word - -prop_convert_natural_int = property $ checkToFinite @Natural @Int -prop_convert_int_natural = property $ checkFromFinite @Natural @Int -prop_convert_natural_word = property $ checkToFinite @Natural @Word -prop_convert_word_natural = property $ checkFromFinite @Natural @Word - -prop_convert_positive_int = property $ checkToFinite @Positive @Int -prop_convert_int_positive = property $ checkFromFinite @Positive @Int -prop_convert_positive_word = property $ checkToFinite @Positive @Word -prop_convert_word_positive = property $ checkFromFinite @Positive @Word - -prop_convert_signed_int = property $ checkToFinite @Signed @Int -prop_convert_int_signed = property $ checkFromFinite @Signed @Int -prop_convert_signed_word = property $ checkToFinite @Signed @Word -prop_convert_word_signed = property $ checkFromFinite @Signed @Word diff --git a/test/Integer/Gen.hs b/test/Integer/Gen.hs new file mode 100644 --- /dev/null +++ b/test/Integer/Gen.hs @@ -0,0 +1,120 @@ +module Integer.Gen + ( + GenIntegral (integral), + GenFinite (finite), + astronomical, + ) + where + +import Essentials + +import Data.Int (Int) +import Data.Word (Word) +import Integer (BoundedBelow (..), Integer, Natural, Positive, Sign (..), + Signed (..)) + +import qualified Hedgehog +import qualified Hedgehog.Gen as Gen +import qualified Hedgehog.Range as Range +import qualified Prelude as Bounded (Bounded (..)) +import qualified Prelude as Num (Integral (..), Num (..), (+), (^)) + +--- + +class (Num.Integral a, Show a) => GenIntegral a + where + -- | Generators for 'Integer', 'Natural', 'Positive', + -- or 'Signed' selected from one of three methods: + -- + -- * small numbers (magnitude less than ten) + -- * large numbers (well in excess of 64-bit) + -- * numbers at or around a bound of 'Int' or 'Word' + integral :: Hedgehog.Gen a + +instance GenIntegral Integer where integral = integer +instance GenIntegral Natural where integral = boundedBelow +instance GenIntegral Positive where integral = boundedBelow +instance GenIntegral Signed where integral = signed + +--- + +class (Num.Integral a, Bounded.Bounded a, Show a) => GenFinite a + where + finite :: Hedgehog.Gen a + +instance GenFinite Int where finite = defaultFinite + +instance GenFinite Word where finite = defaultFinite + +defaultFinite :: (Num.Integral a, Bounded.Bounded a) => Hedgehog.Gen a +defaultFinite = Gen.choice + [ Gen.integral $ Range.linear Bounded.minBound Bounded.maxBound + , Gen.integral $ Range.linear Bounded.maxBound Bounded.minBound + ] + +--- + +smol :: Num.Integral a => a +smol = 10 + +astronomical :: Num.Integral a => a +astronomical = 2 Num.^ (99 :: Integer) + +bigRange :: Num.Integral a => Range.Range a +bigRange = Range.exponential smol astronomical + +--- + +integer :: Hedgehog.Gen Integer +integer = Gen.choice [smolInteger, nearFiniteBoundInteger, bigInteger] + +smolInteger :: Hedgehog.Gen Integer +smolInteger = Gen.integral $ Range.linearFrom 0 (Num.negate smol) smol + +bigInteger :: Hedgehog.Gen Integer +bigInteger = Gen.element [id, Num.negate] <*> Gen.integral bigRange + +nearFiniteBoundInteger :: Hedgehog.Gen Integer +nearFiniteBoundInteger = Gen.element [id, Num.negate] <*> nearPositiveFiniteBound + +--- + +boundedBelow :: forall a. (BoundedBelow a, Num.Integral a) => Hedgehog.Gen a +boundedBelow = Gen.choice [smolBoundedBelow, nearPositiveFiniteBound, bigBoundedBelow] + +smolBoundedBelow :: forall a. (BoundedBelow a, Num.Integral a) => Hedgehog.Gen a +smolBoundedBelow = fmap Num.fromInteger $ Gen.integral $ Range.linear (Num.toInteger $ minBound @a) smol + +bigBoundedBelow :: forall a. (BoundedBelow a, Num.Integral a) => Hedgehog.Gen a +bigBoundedBelow = fmap Num.fromInteger $ Gen.integral bigRange + +nearPositiveFiniteBound :: forall a. Num.Integral a => Hedgehog.Gen a +nearPositiveFiniteBound = fmap Num.fromInteger $ + pure (Num.+) + <*> Gen.element + [ Num.toInteger (Bounded.maxBound :: Int) + , Num.toInteger (Bounded.maxBound :: Word) + ] + <*> smolInteger + +--- + +signed :: Hedgehog.Gen Signed +signed = Gen.choice [smolSigned, nearFiniteBoundSigned, bigSigned] + +smolSigned :: Hedgehog.Gen Signed +smolSigned = Gen.frequency + [ (,) 1 $ pure Zero + , (,) 9 $ pure NonZero <*> sign <*> smolBoundedBelow + ] + +bigSigned :: Hedgehog.Gen Signed +bigSigned = pure NonZero <*> sign <*> bigBoundedBelow + +nearFiniteBoundSigned :: Hedgehog.Gen Signed +nearFiniteBoundSigned = pure NonZero <*> sign <*> nearPositiveFiniteBound + +--- + +sign :: Hedgehog.Gen Sign +sign = Gen.element [PlusSign, MinusSign] diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,277 @@ +module Main (main) where + +import Integer + +import Essentials + +import Test.Hspec (hspec, describe, it, shouldBe) +import Test.Hspec.Hedgehog + ((===), evalMaybe, modifyMaxSuccess, hedgehog) + +import Control.DeepSeq (NFData, ($!!)) +import Control.Exception (Exception, throw) +import Data.Either (Either (..)) +import Data.Int (Int) +import Data.List (take) +import Data.Word (Word) +import Integer.Gen (GenFinite) +import Integer.Gen (GenIntegral) +import Prelude (Num, fromInteger, toInteger, ($!), (*), (+), (-)) +import System.IO (IO) + +import qualified Control.Exception as Exception (ArithException (Underflow)) +import qualified Control.Monad.Catch as Exception (MonadCatch, try) +import qualified Data.Bool as Bool +import qualified Data.Either as Either +import qualified Data.Ord as Ord +import qualified Hedgehog +import qualified Integer.Gen as Gen +import qualified Prelude as Bounded (Bounded (..)) +import qualified Prelude as Num (fromInteger) +import qualified Prelude as Num (toInteger) + +main :: IO () +main = hspec do + + describe "Closed Num operations op behaves the same in A \ + \as in Integer" $ modifyMaxSuccess (\_ -> 1000) do + + let check :: forall a m. GenIntegral a => Monad m => + (forall b. Num b => b -> b -> b) -> Hedgehog.PropertyT m () + check o = do + x :: a <- Hedgehog.forAll Gen.integral + y :: a <- Hedgehog.forAll Gen.integral + x `o` y === fromInteger (toInteger x `o` toInteger y) + + it "op = (+), A = Positive" $ hedgehog $ check @Positive (+) + it "op = (+), A = Signed" $ hedgehog $ check @Signed (+) + it "op = (*), A = Positive" $ hedgehog $ check @Positive (*) + it "op = (*), A = Signed" $ hedgehog $ check @Signed (*) + + describe "subtract in A behaves the same as \ + \(-) in B" $ modifyMaxSuccess (\_ -> 1000) do + + let check :: forall a b m. + (GenIntegral a, Subtraction a, Subtraction' b, Num b) => + (IntegerConvert a b, IntegerNarrow b a) => + (Eq b, Show b) => + Exception.MonadCatch m => Hedgehog.PropertyT m () + check = do + x :: a <- Hedgehog.forAll Gen.integral + y :: a <- Hedgehog.forAll Gen.integral + (subtract x y :: b) === (convert x - convert y :: b) + + it "A = Natural, B = Signed" $ hedgehog $ check @Natural @Signed + it "A = Natural, B = Integer" $ hedgehog $ check @Natural @Integer + it "A = Positive, B = Signed" $ hedgehog $ check @Positive @Signed + it "A = Positive, B = Integer" $ hedgehog $ check @Positive @Integer + + describe "(-) in A behaves the same as (-) in Integer if the result \ + \is in A, undefined otherwise" $ modifyMaxSuccess (\_ -> 1000) do + + let check :: forall a m. + (GenIntegral a, Subtraction a, IntegerNarrow Integer a) => + Exception.MonadCatch m => Hedgehog.PropertyT m () + check = do + x :: a <- Hedgehog.forAll Gen.integral + y :: a <- Hedgehog.forAll Gen.integral + case narrow (toInteger x - toInteger y) :: Maybe a of + Just z -> x - y === z + Nothing -> do + z <- Exception.try (pure $! x - y) + z === Either.Left Exception.Underflow + + it "A = Positive" $ hedgehog $ check @Positive + + describe "convert (convert x) = x" do + + let check :: forall a b m. (GenIntegral a, IntegerEquiv a b) => + Monad m => Hedgehog.PropertyT m () + check = do + x :: a <- Hedgehog.forAll Gen.integral + convert (convert x :: b) === x + + it "A = Integer, B = Signed" $ hedgehog $ check @Integer @Signed + it "A = Signed, B = Integer" $ hedgehog $ check @Signed @Integer + + describe "narrow (convert x) = Just x" $ modifyMaxSuccess (\_ -> 1000) do + + let check :: forall a b m. + (GenIntegral a, IntegerConvert a b, IntegerNarrow b a) => + Monad m => Hedgehog.PropertyT m () + check = do + x :: a <- Hedgehog.forAll Gen.integral + narrow (convert x :: b) === Just x + + it "A = Natural, B = Integer" $ hedgehog $ check @Natural @Integer + it "A = Natural, B = Signed" $ hedgehog $ check @Natural @Signed + it "A = Positive, B = Integer" $ hedgehog $ check @Positive @Integer + it "A = Positive, B = Signed" $ hedgehog $ check @Positive @Signed + it "A = Positive, B = Natural" $ hedgehog $ check @Positive @Natural + + describe "narrow x = (Just y | convert y = x) \ + \or Nothing" $ modifyMaxSuccess (\_ -> 1000) do + + let check :: forall a b m. (GenIntegral a, BoundedBelow b) => + (IntegerConvert b a, IntegerNarrow a b) => + (Show b, Eq b) => Monad m => Hedgehog.PropertyT m () + check = do + x :: a <- Hedgehog.forAll Gen.integral + let y :: Maybe b = narrow x + if x Ord.>= convert (minBound @b) + then do + z <- evalMaybe y + convert z === x + else y === Nothing + + it "A = Integer, B = Natural" $ hedgehog $ check @Integer @Natural + it "A = Signed, B = Natural" $ hedgehog $ check @Signed @Natural + it "A = Integer, B = Positive" $ hedgehog $ check @Integer @Positive + it "A = Signed, B = Positive" $ hedgehog $ check @Signed @Positive + it "A = Natural, B = Positive" $ hedgehog $ check @Natural @Positive + + describe "yolo (yolo x) = x, if Integer x is in range of A" do + + let check :: forall a m. (GenIntegral a, BoundedBelow a) => + Exception.MonadCatch m => Hedgehog.PropertyT m () + check = do + x :: Integer <- Hedgehog.forAll Gen.integral + let y :: a = yolo x + if x Ord.>= Num.toInteger (minBound @a) + then yolo y === x + else do + z <- Exception.try (pure $! y) + z === Either.Left Exception.Underflow + + it "A = Positive" $ hedgehog $ check @Positive + it "A = Natural " $ hedgehog $ check @Natural + + describe "toFinite x = (Just y | fromInteger y = x) \ + \or Nothing" $ modifyMaxSuccess (\_ -> 1000) do + + let check :: forall a b m. Monad m => + (ConvertWithFinite a, GenIntegral a, Show a) => + (Integer.Finite b, Eq b, Show b) => + Hedgehog.PropertyT m () + check = do + x :: a <- Hedgehog.forAll Gen.integral + let x' = Num.toInteger x + let ok = x' Ord.>= Num.toInteger (Bounded.minBound :: b) Bool.&& + x' Ord.<= Num.toInteger (Bounded.maxBound :: b) + (Integer.toFinite x :: Maybe b) === + if ok then Just (Num.fromInteger x') else Nothing + + it "A = Integer, B = Int " $ hedgehog $ check @Integer @Int + it "A = Integer, B = Word" $ hedgehog $ check @Integer @Word + it "A = Natural, B = Int " $ hedgehog $ check @Natural @Int + it "A = Natural, B = Word" $ hedgehog $ check @Natural @Word + it "A = Positive, B = Int " $ hedgehog $ check @Positive @Int + it "A = Positive, B = Word" $ hedgehog $ check @Positive @Word + it "A = Signed, B = Int " $ hedgehog $ check @Signed @Int + it "A = Signed, B = Word" $ hedgehog $ check @Signed @Word + + describe "fromFinite x = narrow (toInteger x)" do + + let check :: forall a b m. Monad m => + (ConvertWithFinite a, IntegerNarrow Integer a, Eq a, Show a) => + (Finite b, GenFinite b, Show b) => + Hedgehog.PropertyT m () + check = do + x :: b <- Hedgehog.forAll Gen.finite + (Integer.fromFinite x :: Maybe a) === Integer.narrow (Num.toInteger x) + + it "A = Int, B = Integer " $ hedgehog $ check @Integer @Int + it "A = Word, B = Integer" $ hedgehog $ check @Integer @Word + it "A = Int, B = Natural " $ hedgehog $ check @Natural @Int + it "A = Word, B = Natural" $ hedgehog $ check @Natural @Word + it "A = Int, B = Positive " $ hedgehog $ check @Positive @Int + it "A = Word, B = Positive" $ hedgehog $ check @Positive @Word + it "A = Int, B = Signed " $ hedgehog $ check @Signed @Int + it "A = Word, B = Signed" $ hedgehog $ check @Signed @Word + + describe "Enum @Positive" $ do + + describe "[a ..]" $ do + it "counts upward" $ + take 3 [5 :: Positive ..] `shouldBe` [5, 6, 7] + it "can start with 1" $ + take 3 [1 :: Positive ..] `shouldBe` [1, 2, 3] + + describe "[a .. b]" $ do + it "counts upward" $ + [5 .. 8 :: Positive] `shouldBe` [5, 6, 7, 8] + it "can start with 1" $ + [1 .. 5 :: Positive] `shouldBe` [1, 2, 3, 4, 5] + it "does not count downward" $ do + [8 .. 5 :: Positive] `shouldBe` [] + [8 .. 7 :: Positive] `shouldBe` [] + it "can return 1 item" $ do + [3 .. 3 :: Positive] `shouldBe` [3] + [1 .. 1 :: Positive] `shouldBe` [1] + + describe "[a, b ..]" $ do + it "can count upward by 1" $ do + take 5 [5, 6 :: Positive ..] `shouldBe` [5, 6, 7, 8, 9] + take 5 [1, 2 :: Positive ..] `shouldBe` [1, 2, 3, 4, 5] + it "can count downward by 1" $ + [5, 4 :: Positive ..] `shouldBe` [5, 4, 3, 2, 1] + it "can count upward by 2" $ do + take 5 [5, 7 :: Positive ..] `shouldBe` [5, 7, 9, 11, 13] + take 5 [1, 3 :: Positive ..] `shouldBe` [1, 3, 5, 7, 9] + it "can count downward by 2" $ + [9, 7 :: Positive ..] `shouldBe` [9, 7, 5, 3, 1] + it "can count downward by 2 without exactly reaching its lower bound" $ + [8, 6 :: Positive ..] `shouldBe` [8, 6, 4, 2] + it "can repeat 1 item indefinitely" $ + take 5 [4, 4 :: Positive ..] `shouldBe` [4, 4, 4, 4, 4] + + describe "[a, b .. c]" $ do + it "can count upward by 1" $ do + [5, 6 .. 9 :: Positive] `shouldBe` [5, 6, 7, 8, 9] + [1, 2 .. 5 :: Positive] `shouldBe` [1, 2, 3, 4, 5] + it "can count downward by 1" $ + [9, 8 .. 5 :: Positive] `shouldBe` [9, 8, 7, 6, 5] + it "can count upward by 2" $ do + [5, 7 .. 11 :: Positive] `shouldBe` [5, 7, 9, 11] + [1, 3 .. 7 :: Positive] `shouldBe` [1, 3, 5, 7] + it "can count upward without exactly reaching its upper bound" $ + [5, 7 .. 12 :: Positive] `shouldBe` [5, 7, 9, 11] + it "can count downward by 2" $ + [11, 9 .. 5 :: Positive] `shouldBe` [11, 9, 7, 5] + it "can count downward by 2 without exactly reaching its lower bound" $ + [11, 9 .. 4 :: Positive] `shouldBe` [11, 9, 7, 5] + it "can count downward with a lower bound of 1" $ do + [7, 5 .. 1 :: Positive] `shouldBe` [7, 5, 3, 1] + [8, 6 .. 1 :: Positive] `shouldBe` [8, 6, 4, 2] + it "can repeat 1 item indefinitely" $ do + take 5 [4, 4 .. 9 :: Positive] `shouldBe` [4, 4, 4, 4, 4] + take 5 [4, 4 .. 4 :: Positive] `shouldBe` [4, 4, 4, 4, 4] + it "can return 1 item" $ do + [4, 5 .. 4 :: Positive] `shouldBe` [4] + [4, 3 .. 4 :: Positive] `shouldBe` [4] + it "can return an empty list" $ do + [4, 4 .. 3 :: Positive] `shouldBe` [] + [4, 5 .. 3 :: Positive] `shouldBe` [] + [5, 4 .. 6 :: Positive] `shouldBe` [] + + describe "deepseq @Signed" $ do + it "can succeed" $ do + x <- force (NonZero MinusSign 5) + x `shouldBe` Right (-5) + it "can force an error" $ do + x <- force (throw X :: Signed) + x `shouldBe` Left X + it "can force an error in sign" $ do + x <- force (NonZero (throw X) 5) + x `shouldBe` Left X + it "can force an error in magnitude" $ do + x <- force (NonZero MinusSign (throw X)) + x `shouldBe` Left X + +data X = X + deriving (Eq, Show) + +instance Exception X + +force :: NFData a => Exception.MonadCatch m => a -> m (Either X a) +force x = Exception.try (pure $!! x)