nat-optics 1.0.0.2 → 1.0.0.3

raw patch · 14 files changed

+196/−149 lines, 14 filesdep +hspecdep ~textPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: hspec

Dependency ranges changed: text

API changes (from Hackage documentation)

Files

• changelog.txt +0/−3
• license.txt +1/−1
• nat-optics.cabal +15/−21
• src/NatOptics/Internal.hs +7/−1
• src/NatOptics/NonNegative.hs +8/−9
• src/NatOptics/NonNegative/Unsafe.hs +14/−0
• src/NatOptics/Positive.hs +6/−7
• src/NatOptics/Positive/Math.hs +33/−0
• src/NatOptics/Positive/Unsafe.hs +10/−0
• src/NatOptics/Signed.hs +31/−0
• test/Main.hs +71/−0
• test/NonNegative.hs +0/−39
• test/Positive.hs +0/−39
• test/TestPrelude.hs +0/−29

@@ -1,3 +0,0 @@-v1 - Initial release-v1.0.0.1 - Added tests, added a few examples to the docs-v1.0.0.2 - Support GHC 9.2 and text-2.0, drop hedgehog dependency

@@ -1,4 +1,4 @@-Copyright 2021 Mission Valley Software LLC+Copyright 2021-2022 Mission Valley Software LLC  Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in

@@ -1,7 +1,7 @@ cabal-version: 3.0  name: nat-optics-version: 1.0.0.2+version: 1.0.0.3 category: Numeric, Optics  synopsis:@@ -17,7 +17,7 @@     to cover basic usage, but you probably also want to import     the "Optics" module from the `optics` package. -copyright: 2021 Mission Valley Software LLC+copyright: 2021-2022 Mission Valley Software LLC license: MIT license-file: license.txt @@ -29,8 +29,6 @@  build-type: Simple -extra-source-files: changelog.txt- source-repository head   type: git   location: https://github.com/typeclasses/nat-optics@@ -39,37 +37,33 @@     default-language:   Haskell2010     ghc-options:        -Wall     default-extensions: DerivingStrategies+                      , FlexibleContexts                       , GeneralizedNewtypeDeriving                       , NoImplicitPrelude                       , TypeApplications  common dependencies-    build-depends:      base        ^>= 4.14  || ^>= 4.15 || ^>= 4.16-                      , text        ^>= 1.2.3 || ^>= 2.0+    build-depends:      base ^>= 4.14 || ^>= 4.15 || ^>= 4.16+                      , text ^>= 1.2.3.2 || ^>= 2.0                       , optics-core ^>= 0.4 -common test-    import:             language-                      , dependencies-    build-depends:      nat-optics-    other-modules:      TestPrelude- library     import:             language                       , dependencies     hs-source-dirs:     src     exposed-modules:    NatOptics.NonNegative+                      , NatOptics.NonNegative.Unsafe                       , NatOptics.Positive+                      , NatOptics.Positive.Math+                      , NatOptics.Positive.Unsafe+                      , NatOptics.Signed     other-modules:      NatOptics.Internal -test-suite NonNegative-    import:             test-    type:               exitcode-stdio-1.0-    hs-source-dirs:     test-    main-is:            NonNegative.hs--test-suite Positive-    import:             test+test-suite nat-optics-test+    import:             language+                      , dependencies     type:               exitcode-stdio-1.0     hs-source-dirs:     test-    main-is:            Positive.hs+    main-is:            Main.hs+    build-depends:      nat-optics+                      , hspec ^>= 2.8 || ^>= 2.9 || ^>= 2.10

@@ -1,4 +1,10 @@-module NatOptics.Internal ( strNat, textStr ) where+{-# language Trustworthy #-}++module NatOptics.Internal+  (+    strNat, textStr,+  )+  where  import Control.Monad   ( mfilter ) import Data.Eq         ( (==) )

@@ -1,3 +1,5 @@+{-# language Trustworthy #-}+ module NatOptics.NonNegative   (     {- * Type constructor -} NonNegative,@@ -6,13 +8,12 @@                              natIso, textPrism, stringPrism,      {- * Re-exports -}       Natural, Integer, Prism', Iso',-                             view, review, preview+                             view, review, preview,   ) where  import Control.Applicative ( (*>) ) import Control.Monad       ( guard ) import Data.Bits           ( Bits, toIntegralSized )-import Data.Eq             ( Eq ) import Data.Function       ( (.) ) import Data.Functor        ( fmap, ($>), (<$>) ) import Data.Maybe          ( Maybe )@@ -29,10 +30,8 @@ import Optics.Review       ( review ) import Prelude             ( Integer, Integral, Num,                              fromIntegral, toInteger )-import Text.Show           ( Show ) -newtype NonNegative number = NonNegative{ number :: number }-    deriving newtype (Eq, Ord, Show)+import NatOptics.NonNegative.Unsafe (NonNegative (..))  {- | For any numeric type @n@,      @'NonNegative' n@ is a subset of @n@.@@ -53,7 +52,7 @@ natPrism =     prism'         (fromIntegral . number)-        (fmap NonNegative . toIntegralSized) {- No need to verify+        (fmap NonNegativeUnsafe . toIntegralSized) {- No need to verify             here, because Natural is always non-negative. The only             check here is when converting from 'Natural' to ensure             that it does not overflow the max bound of 'n'. -}@@ -65,7 +64,7 @@  {- | 'Natural' and @'NonNegative' 'Natural'@ are the same thing. -} natIso :: Iso' Natural (NonNegative Natural)-natIso = iso NonNegative number+natIso = iso NonNegativeUnsafe number  stringPrism :: (Integral n, Bits n) => Prism' String (NonNegative n) stringPrism = strNat % natPrism@@ -74,8 +73,8 @@ textPrism = textStr % stringPrism  verify :: (Ord n, Num n) => n -> Maybe (NonNegative n)-verify n = guard (n >= 0) $> NonNegative n+verify n = guard (n >= 0) $> NonNegativeUnsafe n  verifyAndResize :: (Integral a, Integral b, Bits a, Bits b)                 => a -> Maybe (NonNegative b)-verifyAndResize x = verify x *> (NonNegative <$> toIntegralSized x)+verifyAndResize x = verify x *> (NonNegativeUnsafe <$> toIntegralSized x)

@@ -0,0 +1,14 @@+{-# language Unsafe #-}++module NatOptics.NonNegative.Unsafe+  (+    NonNegative (..),+  )+  where++import Data.Eq   ( Eq )+import Data.Ord  ( Ord )+import Text.Show ( Show )++newtype NonNegative number = NonNegativeUnsafe{ number :: number }+    deriving newtype (Eq, Ord, Show)

@@ -1,3 +1,5 @@+{-# language Trustworthy #-}+ module NatOptics.Positive   (     {- * Type constructor -} Positive,@@ -6,13 +8,12 @@                              textPrism, stringPrism,      {- * Re-exports -}       Natural, Integer, Prism',-                             view, review, preview+                             view, review, preview,   ) where  import Control.Applicative ( (*>) ) import Control.Monad       ( guard ) import Data.Bits           ( Bits, toIntegralSized )-import Data.Eq             ( Eq ) import Data.Function       ( (.) ) import Data.Functor        ( ($>), (<$>) ) import Data.Maybe          ( Maybe )@@ -28,10 +29,8 @@ import Optics.Review       ( review ) import Prelude             ( Integer, Integral, Num,                              fromIntegral, toInteger )-import Text.Show           ( Show ) -newtype Positive number = Positive{ number :: number }-    deriving newtype (Eq, Ord, Show)+import NatOptics.Positive.Unsafe (Positive (..))  {- | For any numeric type @n@,      @'Positive' n@ is a subset of @n@.@@ -63,7 +62,7 @@ textPrism = textStr % stringPrism  verify :: (Num n, Ord n) => n -> Maybe (Positive n)-verify n = guard (n > 0) $> Positive n+verify n = guard (n > 0) $> PositiveUnsafe n  verifyAndResize :: (Integral a, Integral b, Bits a, Bits b) => a -> Maybe (Positive b)-verifyAndResize x = verify x *> (Positive <$> toIntegralSized x)+verifyAndResize x = verify x *> (PositiveUnsafe <$> toIntegralSized x)

@@ -0,0 +1,33 @@+{-# language Trustworthy #-}++module NatOptics.Positive.Math+  (+    minus,+    plus,+  )+  where++import Data.Maybe          ( Maybe (..) )+import Data.Ord            ( Ord, (<) )+import Optics.Core         ( preview, review )+import Prelude             ( Num, abs, (+), (-) )++import NatOptics.Positive.Unsafe ( Positive (..) )+import qualified NatOptics.Positive as Positive++import NatOptics.Signed ( Signed )+import qualified NatOptics.Signed as Signed++plus :: Num n => Positive n -> Positive n -> Positive n+plus (PositiveUnsafe a) (PositiveUnsafe b) = PositiveUnsafe (a + b)++minus :: (Num n, Ord n) => Positive n -> Positive n -> Signed n+minus a b =+    let+        a' = review Positive.refine a+        b' = review Positive.refine b+        diff = a' - b'+    in+        case preview Positive.refine (abs diff) of+            Nothing -> Signed.Zero+            Just diff' -> if diff < 0 then Signed.Minus diff' else Signed.Plus diff'

@@ -0,0 +1,10 @@+{-# language Unsafe #-}++module NatOptics.Positive.Unsafe where++import Data.Eq   ( Eq )+import Data.Ord  ( Ord )+import Text.Show ( Show )++newtype Positive number = PositiveUnsafe{ number :: number }+    deriving newtype (Eq, Ord, Show)

@@ -0,0 +1,31 @@+{-# language Trustworthy #-}++module NatOptics.Signed+  (+    Signed (..),+    intIso,+  )+  where++import Data.Eq            ( Eq )+import Data.Ord           ( Ord, compare, Ordering (..) )+import Text.Show          ( Show )+import Optics.Core        ( Iso', iso )+import Prelude            ( Integer, abs, negate )++import NatOptics.Positive.Unsafe ( Positive (..) )++data Signed n = Zero | Minus (Positive n) | Plus (Positive n)+    deriving stock (Eq, Ord, Show)++intIso :: Iso' Integer (Signed Integer)+intIso = iso f g+  where+    f x = case compare x 0 of+        EQ -> Zero+        LT -> Minus (PositiveUnsafe (abs x))+        GT -> Plus (PositiveUnsafe x)+    g y = case y of+        Zero -> 0+        Plus (PositiveUnsafe x) -> x+        Minus (PositiveUnsafe x) -> negate x

@@ -0,0 +1,71 @@+module Main (main) where++import Test.Hspec+import Prelude++import Data.Int (Int16, Int32)+import Data.Maybe (isNothing)+import Optics.Core (preview, review, view)++import qualified NatOptics.Positive as Pos+import qualified NatOptics.Positive.Unsafe as Pos+import qualified NatOptics.Positive.Math as Pos.Math+import qualified NatOptics.NonNegative as NN+import qualified NatOptics.NonNegative.Unsafe as NN+import qualified NatOptics.Signed as S++main :: IO ()+main = hspec $ do+    nonNegativeSpec+    positiveSpec+    signedSpec+    mathSpec++nonNegativeSpec :: SpecWith ()+nonNegativeSpec = describe "NonNegative" $ do+    describe "0" $ do+        specify "preview stringPrism" $ preview (NN.stringPrism @Int32) "0" `shouldBe` Just (NN.NonNegativeUnsafe 0)+        specify "review refine" $ review NN.refine (NN.NonNegativeUnsafe @Int32 0) `shouldBe` 0+        specify "review stringPrism" $ review NN.stringPrism (NN.NonNegativeUnsafe @Int32 0) `shouldBe` "0"+    describe "57" $ do+        specify "preview stringPrism" $ preview (NN.stringPrism @Int32) "57" `shouldBe` Just (NN.NonNegativeUnsafe 57)+        specify "refine" $ review NN.refine (NN.NonNegativeUnsafe @Int32 57) `shouldBe` 57+        specify "stringPrism" $ review NN.stringPrism (NN.NonNegativeUnsafe @Int32 57) `shouldBe` "57"+    describe "preview stringPrism" $ do+        let examples = [ "-0", "-1", "00", "𝟝𝟟", "57 ", "057", "9999999999999999999999999999" ]+        specify "failures" $ all (isNothing . preview (NN.stringPrism @Int32)) examples++positiveSpec :: SpecWith ()+positiveSpec = describe "Positive" $ do+    describe "1" $ do+        specify "preview stringPrism" $ preview (Pos.stringPrism @Int16) "1" `shouldBe` Just (Pos.PositiveUnsafe 1)+        specify "refine" $ review Pos.refine (Pos.PositiveUnsafe @Int16 1) `shouldBe` 1+        specify "stringPrism" $ review Pos.stringPrism (Pos.PositiveUnsafe @Int16 1) `shouldBe` "1"+    describe "57" $ do+        specify "preview stringPrism" $ preview (Pos.stringPrism @Int16) "57" `shouldBe` Just (Pos.PositiveUnsafe 57)+        specify "refine" $ review Pos.refine (Pos.PositiveUnsafe @Int16 57) `shouldBe` 57+        specify "stringPrism" $ review Pos.stringPrism (Pos.PositiveUnsafe @Int16 57) `shouldBe` "57"+    describe "stringPrism" $ do+        let examples = [ "0", "-0", "-1", "00", "𝟝𝟟", "57 ", "057", "99999999999999999999999" ]+        specify "failures" $ all (isNothing . preview (Pos.stringPrism @Int16)) examples++signedSpec :: SpecWith ()+signedSpec = describe "Signed" $ do+    describe "intIso" $ do+        describe "view" $ do+            specify "0" $ view S.intIso 0 `shouldBe` S.Zero+            specify "3" $ view S.intIso 3 `shouldBe` S.Plus (Pos.PositiveUnsafe 3)+            specify "-5" $ view S.intIso (-5) `shouldBe` S.Minus (Pos.PositiveUnsafe 5)+        describe "review" $ do+            specify "0" $ review S.intIso S.Zero `shouldBe` 0+            specify "3" $ review S.intIso (S.Plus (Pos.PositiveUnsafe 3)) `shouldBe` 3+            specify "-5" $ review S.intIso (S.Minus (Pos.PositiveUnsafe 5)) `shouldBe` (-5)++mathSpec :: SpecWith ()+mathSpec = describe "Positive math" $ do+    describe "plus" $ do+        specify "10 + 5" $ Pos.Math.plus (Pos.PositiveUnsafe 10) (Pos.PositiveUnsafe 5) `shouldBe` Pos.PositiveUnsafe @Int32 15+    describe "minus" $ do+        specify "3 - 3" $ Pos.Math.minus (Pos.PositiveUnsafe 3) (Pos.PositiveUnsafe 3) `shouldBe` S.Zero @Int32+        specify "3 - 5" $ Pos.Math.minus (Pos.PositiveUnsafe 3) (Pos.PositiveUnsafe 5) `shouldBe` S.Minus @Int32 (Pos.PositiveUnsafe 2)+        specify "9 - 5" $ Pos.Math.minus (Pos.PositiveUnsafe 9) (Pos.PositiveUnsafe 5) `shouldBe` S.Plus @Int32 (Pos.PositiveUnsafe 4)

@@ -1,39 +0,0 @@-module Main (main) where--import NatOptics.NonNegative-import TestPrelude--main :: IO ()-main = main' failures--failures :: [Failure]-failures =-    case preview (stringPrism @Int32) "0" of-        Nothing -> fail' "preview (stringPrism @Int32) \"0\" = Nothing"-        Just n ->-            case review refine n of-                0 -> okay-                result -> fail' $ "review refine" ! show' n ! "=" ! show result-            <>-            case review stringPrism n of-                "0" -> okay-                result -> fail' $ "review stringPrism" ! show' n ! "=" ! show result-    <>-    case preview (stringPrism @Int32) "57" of-        Nothing -> fail' "preview (stringPrism @Int32) \"57\" = Nothing"-        Just n ->-            case review refine n of-                57 -> okay-                result -> fail' $ "review refine" ! show' n ! "=" ! show result-            <>-            case review stringPrism n of-                "57" -> okay-                result -> fail' $ "review stringPrism" ! show' n ! "=" ! show result-    <>-    foldMap-        (\x -> case preview (stringPrism @Int32) x of-            Nothing -> okay-            result -> fail' $ "preview (stringPrism @Int32)" ! show' x ! "=" ! show result-        )-        [ "-0", "-1", "00", "𝟝𝟟", "57 ", "057"-        , "9999999999999999999999999999" ]

@@ -1,39 +0,0 @@-module Main (main) where--import NatOptics.Positive-import TestPrelude--main :: IO ()-main = main' failures--failures :: [Failure]-failures =-    case preview (stringPrism @Int16) "1" of-        Nothing -> fail' "preview (stringPrism @Int16) \"1\" = Nothing"-        Just n ->-            case review refine n of-                1 -> okay-                result -> fail' $ "review refine" ! show' n ! "=" ! show result-            <>-            case review stringPrism n of-                "1" -> okay-                result -> fail' $ "review stringPrism" ! show' n ! "=" ! show result-    <>-    case preview (stringPrism @Int16) "57" of-        Nothing -> fail' "preview (stringPrism @Int16) \"57\" = Nothing"-        Just n ->-            case review refine n of-                57 -> okay-                result -> fail' $ "review refine" ! show' n ! "=" ! show result-            <>-            case review stringPrism n of-                "57" -> okay-                result -> fail' $ "review stringPrism" ! show' n ! "=" ! show result-    <>-    foldMap-        (\x -> case preview (stringPrism @Int16) x of-            Nothing -> okay-            result -> fail' $ "preview (stringPrism @Int16)" ! show' x ! "=" ! show result-        )-        [ "0", "-0", "-1", "00", "𝟝𝟟", "57 ", "057"-        , "99999999999999999999999" ]

@@ -1,29 +0,0 @@-module TestPrelude (module X, Failure (..), main', show', okay, fail', (!)) where--import Control.Monad as X-import Data.Foldable as X-import Data.Int as X-import Optics.Optic as X-import Optics.Re as X-import Prelude as X-import System.Exit as X--data Failure = Failure String--main' :: [Failure] -> IO ()-main' failures =-    unless (null failures) $ do-        for_ failures $ \(Failure x) -> putStrLn ("🔥 " ++ x)-        exitFailure--show' :: Show a => a -> String-show' x = showsPrec 11 x ""--okay :: [Failure]-okay = []--fail' :: String -> [Failure]-fail' x = [Failure x]--(!) :: String -> String -> String-x ! y = x <> " " <> y