natural 0.3.0.7 → 0.5.0.1
raw patch · 9 files changed
Files
- LICENCE +2/−2
- README.md +92/−0
- Setup.hs +7/−1
- benchmarks/Main.hs +24/−0
- changelog.md +48/−0
- natural.cabal +62/−47
- src/Natural.hs +2285/−741
- test/Main.hs +18/−0
- test/Tests.hs +0/−2
LICENCE view
@@ -1,4 +1,4 @@-Copyright (c) 2020-2025, System F+Copyright (c) 2018-2026 Tony Morris All rights reserved. @@ -13,7 +13,7 @@ disclaimer in the documentation and/or other materials provided with the distribution. - * Neither the name of QFPL nor the names of other+ * Neither the name of Tony Morris nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission.
+ README.md view
@@ -0,0 +1,92 @@+# natural++Safe natural number, positive integer, and non-zero integer types with lens integration.++## Types++| Type | Range | Semigroup | Monoid identity |+|------|-------|-----------|-----------------|+| `Natural` | >= 0 | addition | 0 |+| `Positive` | >= 1 | multiplication | — |+| `NotZero` | /= 0 | addition | — |++Each type has corresponding newtype wrappers for alternative semigroups:++| Wrapper | Operation |+|---------|-----------|+| `ProductNatural` | multiplication |+| `MaxNatural` / `MinNatural` | max / min |+| `SumPositive` | addition |+| `MaxPositive` / `MinPositive` | max / min |+| `SumNotZero` | addition |+| `MaxNotZero` / `MinNotZero` | max / min |++## Optics++The library uses `lens` for type-safe conversions:++```haskell+-- Prisms for safe construction from integral types+(5 :: Integer) ^? _Natural -- Just (Natural 5)+(-1 :: Integer) ^? _Natural -- Nothing++(3 :: Integer) ^? _Positive -- Just (Positive 3)+(0 :: Integer) ^? _Positive -- Nothing++(7 :: Integer) ^? _NotZero -- Just (NotZero True (Positive 7))+(0 :: Integer) ^? _NotZero -- Nothing++-- Structural prisms+Natural 5 ^? successor -- Just (Natural 4)+Natural 0 ^? successor -- Nothing++Positive 3 ^? successor1 -- Just (Positive 2)+Positive 1 ^? successor1 -- Nothing++-- Isos between related types+Natural 4 ^. successorW -- Positive 5+Natural 3 ^. naturalPositive -- Just (Positive 3)+Natural 3 ^. list -- [(), (), ()]+```++## Type classes++Each type has `Has*` (lens) and `As*` (prism) classes with instances for+standard integral types (`Int`, `Integer`, `Word`, `Const`, `Identity`):++```haskell+class HasNatural a where+ natural :: Lens' a Natural++class AsNatural a where+ _Natural :: Prism' a Natural+```++## NotZero++A non-zero integer represented as a sign (`Bool`: `True` = positive) and a+magnitude (`Positive`):++```haskell+data NotZero = NotZero Bool Positive++positiveNotZero (Positive 5) -- NotZero True (Positive 5)+negativeNotZero (Positive 3) -- NotZero False (Positive 3)+notZeroInteger (NotZero False (Positive 3)) -- -3++-- Multiplication is always total+multiplyNZ (NotZero False (Positive 3)) (NotZero False (Positive 4))+ -- NotZero True (Positive 12)++-- Addition can produce zero+plusNZ (NotZero True (Positive 3)) (NotZero False (Positive 3))+ -- Nothing+```++## Building++```+cabal build+cabal test doctest+cabal bench+```
Setup.hs view
@@ -1,2 +1,8 @@-import Distribution.Simple+{-# OPTIONS_GHC -Wall -Werror #-}++module Main (main) where++import Distribution.Simple (defaultMain)++main :: IO () main = defaultMain
+ benchmarks/Main.hs view
@@ -0,0 +1,24 @@+{-# OPTIONS_GHC -Wall -Werror #-}++module Main (main) where++import Test.Tasty.Bench (bench, bgroup, defaultMain, whnf)+import Natural (Natural, zero', successor', plus, multiply)++n :: Int+n = 1000++nat :: Int -> Natural+nat 0 = zero'+nat k = successor' (nat (k - 1))++main :: IO ()+main =+ defaultMain+ [ bgroup+ "Natural"+ [ bench "successor" $ whnf (iterate successor' zero' !!) n,+ bench "plus" $ whnf (plus (nat 100)) (nat 100),+ bench "multiply" $ whnf (multiply (nat 50)) (nat 50)+ ]+ ]
changelog.md view
@@ -1,3 +1,51 @@+0.5.0.1++* Hide `Natural` and `Positive` constructors from export+* Rewrite doctests to use prism-based construction for external module compatibility++0.5.0.0++* Add `NotZero` data type for non-zero integers (positive or negative)+ with `HasNotZero`, `AsNotZero` classes, `SumNotZero`, `MaxNotZero`,+ `MinNotZero` newtype wrappers, and functions: `positiveNotZero`,+ `negativeNotZero`, `notZeroPositive`, `notZeroInteger`, `isPositive`,+ `isNegative`, `negateNZ`, `absoluteNZ`, `signumNZ`, `plusNZ`,+ `multiplyNZ`, `notZeroOr`+* Add `AsPositive NotZero` instance+* Add `ToJSON` and `FromJSON` instances for `Natural`, `Positive`,+ `NotZero`, and all newtype wrappers (`ProductNatural`, `MaxNatural`,+ `MinNatural`, `SumPositive`, `MaxPositive`, `MinPositive`,+ `SumNotZero`, `MaxNotZero`, `MinNotZero`)+* Add `toJsonNatural`, `parseJsonNatural`, `toJsonPositive`,+ `parseJsonPositive`, `toJsonNotZero`, `parseJsonNotZero` functions+* Add `aeson` dependency+* Change `Semigroup Positive` from addition to multiplication+* Remove `Monoid Positive` (no additive identity for positives)+* Add `SumPositive` wrapper for addition of positives+* Remove redundant `notZero` function (identical to `_Positive` on `Natural`)+* Rename `square` to `power`, `square1` to `power1`+* Fix `(!!)` returning `Nothing` for index zero+* Fix `(!!!)` off-by-one indexing+* Fix `minus1` producing `Positive 0` when arguments are equal+* Fix `length` using lazy `foldl` (now strict `foldl'`)+* Add doctests to all functions and instances+* Modernise cabal file to cabal-version 2.4+* Add doctest test-suite and benchmarks+* Update repository to https://gitlab.com/system-f/code/natural++0.4.0.0++* Add `ToJSON` and `FromJSON` instances for `Natural`, `Positive`, and all newtype wrappers (`ProductNatural`, `MaxNatural`, `MinNatural`, `SumPositive`, `MaxPositive`, `MinPositive`).+* Add `toJsonNatural`, `parseJsonNatural`, `toJsonPositive`, `parseJsonPositive` functions.+* Add `aeson` dependency.+* Rename `square` to `power` and `square1` to `power1`.+* Fix `(!!)` which previously returned `Nothing` for all inputs.+* Fix `(!!!)` which previously returned `Nothing` for all inputs.+* Fix `multiply1` which was performing addition instead of multiplication.+* Fix `minus1` off-by-one when arguments are equal.+* Remove invalid `Monoid Positive` instance (`mempty` was `Positive 0`).+* Add Haddock documentation and doctests.+ 0.3.0.7 * Update version bounds
natural.cabal view
@@ -1,54 +1,69 @@--- documentation, see http://haskell.org/cabal/users-guide/--name: natural-version: 0.3.0.7-synopsis: Natural number+cabal-version: 2.4+name: natural+version: 0.5.0.1+synopsis: Natural number description:- Natural number+ Natural number with lens integration. . <<https://logo.systemf.com.au/systemf-450x450.png>>-license: BSD3-license-file: LICENCE-author: Queensland Functional Programming Lab <oᴉ˙ldɟb@llǝʞsɐɥ>-maintainer: Queensland Functional Programming Lab <oᴉ˙ldɟb@llǝʞsɐɥ>-copyright: Copyright (C) 2020-2025 System F-category: Control-build-type: Simple-extra-source-files: changelog.md-cabal-version: >=1.10-homepage: https://github.com/system-f/natural-bug-reports: https://github.com/system-f/natural/issues-tested-with: GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.3, GHC == 8.6.1, GHC == 8.8.1, GHC == 8.6.5, GHC == 8.10.1, GHC == 9.4.8+license: BSD-3-Clause+license-file: LICENCE+author: Tony Morris <tmorris@tmorris.net>+maintainer: Tony Morris <tmorris@tmorris.net>+category: Data+build-type: Simple+extra-doc-files: changelog.md+ , README.md+homepage: https://gitlab.com/system-f/code/natural+bug-reports: https://gitlab.com/system-f/code/natural/-/issues+tested-with: GHC == 9.6.7 -source-repository head- type: git- location: git@github.com:system-f/natural.git+flag dev+ description: Enable development warnings (-Werror, -O2 for benchmarks)+ manual: True+ default: False +source-repository head+ type: git+ location: https://gitlab.com/system-f/code/natural.git+ library- exposed-modules: Natural- build-depends: base >= 4.8 && < 6- , lens >= 4.15 && < 6- , semigroupoids >= 5 && < 7- hs-source-dirs: src- default-language: Haskell2010- ghc-options: -Wall- if impl(ghc<8.0.1)- build-depends: semigroups >= 0.9 && < 1+ exposed-modules:+ Natural -test-suite tests- build-depends: QuickCheck >= 2.9.2 && < 2.15- , base >= 4.8 && < 6- , checkers >= 0.4.6 && < 0.6- , hedgehog >= 0.5 && < 1.1- , lens >= 4.15 && < 6- , tasty >= 0.11 && < 1.3- , tasty-hunit >= 0.9 && < 0.11- , tasty-hedgehog >= 0.1 && < 1.1- , tasty-quickcheck >= 0.8.4 && < 0.11- , transformers >= 0.4.1 && < 0.6- , natural- type: exitcode-stdio-1.0- main-is: Tests.hs- hs-source-dirs: test- default-language: Haskell2010- ghc-options: -Wall+ build-depends: base >= 4.8 && < 6+ , aeson >= 1.4 && < 3+ , lens >= 4.15 && < 6+ , semigroupoids >= 5 && < 7++ hs-source-dirs: src++ default-language: Haskell2010++ ghc-options: -Wall++ if flag(dev)+ ghc-options: -Werror++benchmark bench+ type: exitcode-stdio-1.0+ hs-source-dirs: benchmarks+ main-is: Main.hs+ build-depends: base >= 4.8 && < 6+ , tasty-bench >= 0.3 && < 1+ , natural+ default-language: Haskell2010+ ghc-options: -Wall++ if flag(dev)+ ghc-options: -Werror -O2++test-suite doctest+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Main.hs+ build-depends: base >= 4.8 && < 6+ , process >= 1 && < 2+ build-tool-depends: doctest:doctest >= 0.22 && < 1+ default-language: Haskell2010+ ghc-options: -Wall
src/Natural.hs view
@@ -1,741 +1,2285 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}--module Natural (- Natural-, HasNatural(..)-, AsNatural(..)-, ProductNatural(..)-, MaxNatural(..)-, MinNatural(..)-, zero-, zero'-, successor-, successor'-, plus-, multiply-, square-, zeroOr-, length-, replicate-, take-, drop-, splitAt-, (!!)-, findIndices-, findIndex-, elemIndices-, elemIndex-, minus-, list-, Positive-, HasPositive(..)-, AsPositive(..)-, SumPositive(..)-, MaxPositive(..)-, MinPositive(..)-, naturalPositive-, one-, one'-, successor1-, successor1'-, successorW-, plus1-, multiply1-, square1-, oneOr-, notZero-, length1-, replicate1-, take1-, drop1-, splitAt1-, (!!!)-, findIndices1-, findIndex1-, elemIndices1-, elemIndex1-, minus1-, list1-, plusone-, minusone-) where--import Control.Applicative(Const)-import Control.Category((.), id)-import Control.Lens(Wrapped(_Wrapped', Unwrapped), Rewrapped, Prism', Lens', Iso', (^?), ( # ), (^.), _Wrapped, prism', iso)-import Control.Monad((>>=))-import Data.Bool(Bool)-import Data.Eq(Eq((==)))-import Data.Foldable(Foldable(foldl))-import Data.Function(const)-import Data.Functor.Identity(Identity)-import Data.Int(Int)-import Data.List(iterate, zip, filter, map, repeat)-import Data.List.NonEmpty(NonEmpty((:|)))-import qualified Data.List.NonEmpty as NonEmpty(iterate, zip, filter)-import Data.Maybe(listToMaybe, Maybe(Just, Nothing), fromMaybe)-import Data.Monoid(Monoid(mappend, mempty))-import Data.Ord(Ord((<)), min, max)-import Data.Semigroup(Semigroup((<>)))-import Data.Semigroup.Foldable(Foldable1(foldMap1))-import Data.Tuple(fst, snd)-import Data.Word(Word)-import Prelude(Show, Integral, Integer, (-), (+), (*), (^), fromIntegral)--newtype Natural =- Natural- Integer- deriving (Eq, Ord, Show)--instance Semigroup Natural where- Natural x <> Natural y =- Natural (x + y)--instance Monoid Natural where- mappend =- (<>)- mempty =- Natural 0--class HasNatural a where- natural ::- Lens'- a- Natural--instance HasNatural Natural where- natural =- id--class AsNatural a where- _Natural ::- Prism'- a- Natural--instance AsNatural Natural where- _Natural =- id--integralPrism ::- Integral a =>- Prism'- a- Natural-integralPrism =- prism'- (\(Natural n) -> fromIntegral n)- (\n -> if n < 0 then Nothing else Just (Natural (fromIntegral n)))--instance AsNatural Int where- _Natural =- integralPrism--instance AsNatural Integer where- _Natural =- integralPrism--instance AsNatural Word where- _Natural =- integralPrism--instance Integral a => AsNatural (Const a b) where- _Natural =- integralPrism--instance Integral a => AsNatural (Identity a) where- _Natural =- integralPrism--newtype ProductNatural =- ProductNatural- Natural- deriving (Eq, Ord, Show)--instance HasNatural ProductNatural where- natural =- _Wrapped . natural--instance AsNatural ProductNatural where- _Natural =- _Wrapped . _Natural--instance ProductNatural ~ a =>- Rewrapped ProductNatural a--instance Wrapped ProductNatural where- type Unwrapped ProductNatural = Natural- _Wrapped' =- iso- (\(ProductNatural x) -> x)- ProductNatural--instance Semigroup ProductNatural where- ProductNatural (Natural x) <> ProductNatural (Natural y) =- ProductNatural (Natural (x * y))--instance Monoid ProductNatural where- mappend =- (<>)- mempty =- ProductNatural (Natural 1)--newtype MaxNatural =- MaxNatural- Natural- deriving (Eq, Ord, Show)--instance HasNatural MaxNatural where- natural =- _Wrapped . natural--instance AsNatural MaxNatural where- _Natural =- _Wrapped . _Natural--instance MaxNatural ~ a =>- Rewrapped MaxNatural a--instance Wrapped MaxNatural where- type Unwrapped MaxNatural = Natural- _Wrapped' =- iso- (\(MaxNatural x) -> x)- MaxNatural--instance Semigroup MaxNatural where- MaxNatural (Natural x) <> MaxNatural (Natural y) =- MaxNatural (Natural (x `max` y))--newtype MinNatural =- MinNatural- Natural- deriving (Eq, Ord, Show)--instance HasNatural MinNatural where- natural =- _Wrapped . natural--instance AsNatural MinNatural where- _Natural =- _Wrapped . _Natural--instance MinNatural ~ a =>- Rewrapped MinNatural a--instance Wrapped MinNatural where- type Unwrapped MinNatural = Natural- _Wrapped' =- iso- (\(MinNatural x) -> x)- MinNatural--instance Semigroup MinNatural where- MinNatural (Natural x) <> MinNatural (Natural y) =- MinNatural (Natural (x `min` y))--zero ::- Prism'- Natural- ()-zero =- prism'- (\() -> Natural 0)- (\(Natural n) -> if n == 0 then Just () else Nothing)--zero' ::- Natural-zero' =- zero # ()--successor ::- Prism'- Natural- Natural-successor =- prism'- (\(Natural n) -> Natural (n + 1))- (\(Natural n) -> if n == 0 then Nothing else Just (Natural (n - 1)))--successor' ::- Natural- -> Natural-successor' =- (successor #)--plus ::- Natural- -> Natural- -> Natural-plus =- (<>)--multiply ::- Natural- -> Natural- -> Natural-multiply x y =- (_Wrapped # x <> (_Wrapped # y :: ProductNatural)) ^. _Wrapped--square ::- Natural- -> Natural- -> Natural-square (Natural x) (Natural y) =- Natural (x ^ y)--zeroOr ::- AsNatural a =>- a- -> Natural-zeroOr n =- fromMaybe zero' (n ^? _Natural)--length ::- Foldable f =>- f a- -> Natural-length =- foldl (const . successor') zero'--replicate ::- Natural- -> a- -> [a]-replicate n =- take n . repeat--take ::- Natural- -> [a]- -> [a]-take _ [] =- []-take n (h:t) =- case n ^? successor of- Nothing ->- []- Just p ->- h : take p t--drop ::- Natural- -> [a]- -> [a]-drop _ [] =- []-drop n (h:t) =- case n ^? successor of- Nothing ->- h:t- Just p ->- drop p t--splitAt ::- Natural- -> [a]- -> ([a], [a])-splitAt n x =- (take n x, drop n x)--(!!) ::- [a]- -> Natural- -> Maybe a-[] !! _ =- Nothing-(_:t) !! n =- (n ^? successor) >>= (t !!)--findIndices ::- (a -> Bool)- -> [a]- -> [Natural]-findIndices p x =- map snd (filter (p . fst) (zip x (iterate successor' zero')))--findIndex ::- (a -> Bool)- -> [a]- -> Maybe Natural-findIndex p =- listToMaybe . findIndices p--elemIndices ::- Eq a =>- a- -> [a]- -> [Natural]-elemIndices =- findIndices . (==)--elemIndex ::- Eq a =>- a- -> [a]- -> Maybe Natural-elemIndex =- findIndex . (==)--minus ::- Natural- -> Natural- -> Natural-minus (Natural x) (Natural y) =- Natural (if x < y then 0 else x - y)--list ::- Iso'- Natural- [()]-list =- iso- (\n -> replicate n ())- length--------newtype Positive =- Positive- Integer- deriving (Eq, Ord, Show)--instance Semigroup Positive where- Positive x <> Positive y =- Positive (x + y)--instance Monoid Positive where- mappend =- (<>)- mempty =- Positive 0--class HasPositive a where- positive ::- Lens'- a- Positive--instance HasPositive Positive where- positive =- id--class AsPositive a where- _Positive ::- Prism'- a- Positive--instance AsPositive Positive where- _Positive =- id--integralPrism1 ::- Integral a =>- Prism'- a- Positive-integralPrism1 =- prism'- (\(Positive n) -> fromIntegral n)- (\n -> if n < 1 then Nothing else Just (Positive (fromIntegral n)))--instance AsPositive Int where- _Positive =- integralPrism1--instance AsPositive Integer where- _Positive =- integralPrism1--instance AsPositive Word where- _Positive =- integralPrism1--instance Integral a => AsPositive (Const a b) where- _Positive =- integralPrism1--instance Integral a => AsPositive (Identity a) where- _Positive =- integralPrism1--newtype SumPositive =- SumPositive- Positive- deriving (Eq, Ord, Show)--instance HasPositive SumPositive where- positive =- _Wrapped . positive--instance AsPositive SumPositive where- _Positive =- _Wrapped . _Positive--instance SumPositive ~ a =>- Rewrapped SumPositive a--instance Wrapped SumPositive where- type Unwrapped SumPositive = Positive- _Wrapped' =- iso- (\(SumPositive x) -> x)- SumPositive--instance Semigroup SumPositive where- SumPositive (Positive x) <> SumPositive (Positive y) =- SumPositive (Positive (x + y))--newtype MaxPositive =- MaxPositive- Positive- deriving (Eq, Ord, Show)--instance HasPositive MaxPositive where- positive =- _Wrapped . positive--instance AsPositive MaxPositive where- _Positive =- _Wrapped . _Positive--instance MaxPositive ~ a =>- Rewrapped MaxPositive a--instance Wrapped MaxPositive where- type Unwrapped MaxPositive = Positive- _Wrapped' =- iso- (\(MaxPositive x) -> x)- MaxPositive--instance Semigroup MaxPositive where- MaxPositive (Positive x) <> MaxPositive (Positive y) =- MaxPositive (Positive (x `max` y))--newtype MinPositive =- MinPositive- Positive- deriving (Eq, Ord, Show)--instance HasPositive MinPositive where- positive =- _Wrapped . positive--instance AsPositive MinPositive where- _Positive =- _Wrapped . _Positive--instance MinPositive ~ a =>- Rewrapped MinPositive a--instance Wrapped MinPositive where- type Unwrapped MinPositive = Positive- _Wrapped' =- iso- (\(MinPositive x) -> x)- MinPositive--instance Semigroup MinPositive where- MinPositive (Positive x) <> MinPositive (Positive y) =- MinPositive (Positive (x `min` y))--naturalPositive ::- Iso' Natural (Maybe Positive)-naturalPositive =- iso- (\(Natural n) ->- if n == 0 then Nothing else Just (Positive n))- (\x -> Natural (- case x of- Nothing ->- 0- Just (Positive n) ->- n)- )--instance AsPositive Natural where- _Positive =- prism'- (\(Positive n) -> Natural n)- (\(Natural n) -> if n == 0 then Nothing else Just (Positive n))--one ::- Prism'- Positive- ()-one =- prism'- (\() -> Positive 1)- (\(Positive n) -> if n == 1 then Just () else Nothing)--one' ::- Positive-one' =- one # ()--successor1 ::- Prism'- Positive- Positive-successor1 =- prism'- (\(Positive n) -> Positive (n + 1))- (\(Positive n) -> if n == 1 then Nothing else Just (Positive (n - 1)))--successor1' ::- Positive- -> Positive-successor1' =- (successor1 #)--successorW ::- Iso'- Natural- Positive-successorW =- iso- (\(Natural n) -> Positive (n + 1))- (\(Positive n) -> Natural (n - 1))--plus1 ::- Positive- -> Positive- -> Positive-plus1 x y =- (_Wrapped # x <> (_Wrapped # y :: SumPositive)) ^. _Wrapped--multiply1 ::- Positive- -> Positive- -> Positive-multiply1 =- (<>)--square1 ::- Positive- -> Positive- -> Positive-square1 (Positive x) (Positive y) =- Positive (x ^ y)--oneOr ::- AsPositive a =>- a- -> Positive-oneOr n =- fromMaybe one' (n ^? _Positive)--notZero ::- Prism'- Natural- Positive-notZero =- prism'- (\(Positive n) -> Natural n)- (\(Natural n) -> if n == 0 then Nothing else Just (Positive n))--length1 ::- Foldable1 f =>- f a- -> Positive-length1 x =- foldMap1 (const (SumPositive one')) x ^. _Wrapped--replicate1 ::- Positive- -> a- -> NonEmpty a-replicate1 n a =- take1 n (a :| repeat a)--take1 ::- Positive- -> NonEmpty a- -> NonEmpty a-take1 n (h:|t) =- h :| take (successorW # n) t--drop1 ::- Positive- -> NonEmpty a- -> [a]-drop1 n (_:|t) =- drop (successorW # n) t--splitAt1 ::- Positive- -> NonEmpty a- -> (NonEmpty a, [a])-splitAt1 n x =- (take1 n x, drop1 n x)--(!!!) ::- NonEmpty a- -> Positive- -> Maybe a-(_:|t) !!! n =- t !! (successorW # n)--findIndices1 ::- (a -> Bool)- -> NonEmpty a- -> [Positive]-findIndices1 p x =- map snd (NonEmpty.filter (p . fst) (NonEmpty.zip x (NonEmpty.iterate successor1' one')))--findIndex1 ::- (a -> Bool)- -> NonEmpty a- -> Maybe Positive-findIndex1 p =- listToMaybe . findIndices1 p--elemIndices1 ::- Eq a =>- a- -> NonEmpty a- -> [Positive]-elemIndices1 =- findIndices1 . (==)--elemIndex1 ::- Eq a =>- a- -> NonEmpty a- -> Maybe Positive-elemIndex1 =- findIndex1 . (==)--minus1 ::- Positive- -> Positive- -> Positive-minus1 (Positive x) (Positive y) =- Positive (if x < y then 1 else x - y)--list1 ::- Iso'- Positive- (NonEmpty ())-list1 =- iso- (\n -> replicate1 n ())- length1--plusone ::- Natural- -> Positive-plusone =- (^. successorW)--minusone ::- Positive- -> Natural-minusone =- (successorW #)+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE NoImplicitPrelude #-}++module Natural+ ( Natural,+ HasNatural (..),+ AsNatural (..),+ ProductNatural (..),+ MaxNatural (..),+ MinNatural (..),+ zero,+ zero',+ successor,+ successor',+ plus,+ multiply,+ power,+ zeroOr,+ length,+ replicate,+ take,+ drop,+ splitAt,+ (!!),+ findIndices,+ findIndex,+ elemIndices,+ elemIndex,+ minus,+ list,+ Positive,+ HasPositive (..),+ AsPositive (..),+ SumPositive (..),+ MaxPositive (..),+ MinPositive (..),+ naturalPositive,+ one,+ one',+ successor1,+ successor1',+ successorW,+ plus1,+ multiply1,+ power1,+ oneOr,+ length1,+ replicate1,+ take1,+ drop1,+ splitAt1,+ (!!!),+ findIndices1,+ findIndex1,+ elemIndices1,+ elemIndex1,+ minus1,+ list1,+ plusone,+ minusone,+ NotZero (..),+ HasNotZero (..),+ AsNotZero (..),+ SumNotZero (..),+ MaxNotZero (..),+ MinNotZero (..),+ positiveNotZero,+ negativeNotZero,+ notZeroPositive,+ notZeroInteger,+ isPositive,+ isNegative,+ negateNZ,+ absoluteNZ,+ signumNZ,+ plusNZ,+ multiplyNZ,+ notZeroOr,+ toJsonNatural,+ parseJsonNatural,+ toJsonPositive,+ parseJsonPositive,+ toJsonNotZero,+ parseJsonNotZero,+ )+where++import Control.Applicative (Const, pure)+import Control.Category (id, (.))+import Control.Lens (Iso', Lens', Prism', Rewrapped, Wrapped (Unwrapped, _Wrapped'), iso, prism', (#), (^.), (^?), _Wrapped)+import Control.Monad (fail, (>>=))+import Data.Aeson.Types+ ( FromJSON (parseJSON),+ Parser,+ ToJSON (toEncoding, toJSON),+ Value,+ )+import Data.Bool (Bool (False, True), not, (&&))+import Data.Eq (Eq ((==)))+import Data.Foldable (Foldable (foldl'))+import Data.Function (const)+import Data.Functor.Identity (Identity)+import Data.Int (Int)+import Data.List (filter, iterate, map, repeat, zip)+import Data.List.NonEmpty (NonEmpty ((:|)))+import qualified Data.List.NonEmpty as NonEmpty (filter, iterate, zip)+import Data.Maybe (Maybe (Just, Nothing), fromMaybe, listToMaybe)+import Data.Monoid (Monoid (mappend, mempty))+import Data.Ord (Ord (compare, (<), (<=)), max, min)+import Data.Semigroup (Semigroup ((<>)))+import Data.Semigroup.Foldable (Foldable1 (foldMap1))+import Data.Tuple (fst, snd)+import Data.Word (Word)+import Prelude (Integer, Integral, Show, abs, fromIntegral, negate, (*), (+), (-), (^))++-- $setup+-- >>> :set -XOverloadedStrings+-- >>> import Control.Lens((^?), (^.), (#), _Wrapped', _Wrapped)+-- >>> import Data.Aeson(encode, decode, fromJSON, Result(..))+-- >>> import Data.Aeson.Types(parse, Value(Number))+-- >>> import Data.List.NonEmpty(NonEmpty(..))+-- >>> import Data.Maybe(fromJust)+-- >>> let nat n = fromJust ((n :: Integer) ^? _Natural)+-- >>> let pos n = fromJust ((n :: Integer) ^? _Positive)++-- | A natural number (>= 0) represented as a newtype over 'Integer'.+--+-- >>> nat 0+-- Natural 0+--+-- >>> nat 5+-- Natural 5+newtype Natural+ = Natural+ Integer+ deriving (Eq, Ord, Show)++-- |+--+-- >>> nat 3 <> nat 4+-- Natural 7+--+-- >>> nat 0 <> nat 5+-- Natural 5+instance Semigroup Natural where+ Natural x <> Natural y =+ Natural (x + y)++-- |+--+-- >>> mempty :: Natural+-- Natural 0+instance Monoid Natural where+ mappend =+ (<>)+ mempty =+ Natural 0++class HasNatural a where+ natural ::+ Lens'+ a+ Natural++-- |+--+-- >>> (nat 5) ^. natural+-- Natural 5+instance HasNatural Natural where+ natural =+ id++class AsNatural a where+ _Natural ::+ Prism'+ a+ Natural++-- |+--+-- >>> _Natural # nat 5 :: Natural+-- Natural 5+instance AsNatural Natural where+ _Natural =+ id++integralPrism ::+ (Integral a) =>+ Prism'+ a+ Natural+integralPrism =+ prism'+ (\(Natural n) -> fromIntegral n)+ (\n -> if n < 0 then Nothing else Just (Natural (fromIntegral n)))++-- |+--+-- >>> (5 :: Int) ^? _Natural+-- Just (Natural 5)+--+-- >>> (-1 :: Int) ^? _Natural+-- Nothing+instance AsNatural Int where+ _Natural =+ integralPrism++-- |+--+-- >>> (42 :: Integer) ^? _Natural+-- Just (Natural 42)+--+-- >>> (-1 :: Integer) ^? _Natural+-- Nothing+instance AsNatural Integer where+ _Natural =+ integralPrism++-- |+--+-- >>> (7 :: Word) ^? _Natural+-- Just (Natural 7)+instance AsNatural Word where+ _Natural =+ integralPrism++-- |+--+-- >>> import Data.Functor.Identity(Identity(..))+-- >>> import Control.Applicative(Const(..))+-- >>> (Const 5 :: Const Integer Bool) ^? _Natural+-- Just (Natural 5)+instance (Integral a) => AsNatural (Const a b) where+ _Natural =+ integralPrism++-- |+--+-- >>> import Data.Functor.Identity(Identity(..))+-- >>> (Identity 5 :: Identity Integer) ^? _Natural+-- Just (Natural 5)+instance (Integral a) => AsNatural (Identity a) where+ _Natural =+ integralPrism++-- |+--+-- >>> ProductNatural (nat 3) <> ProductNatural (nat 4)+-- ProductNatural (Natural 12)+--+-- >>> mempty :: ProductNatural+-- ProductNatural (Natural 1)+newtype ProductNatural+ = ProductNatural+ Natural+ deriving (Eq, Ord, Show)++-- |+--+-- >>> ProductNatural (nat 5) ^. natural+-- Natural 5+instance HasNatural ProductNatural where+ natural =+ _Wrapped . natural++-- |+--+-- >>> ProductNatural (nat 5) ^? _Natural+-- Just (Natural 5)+instance AsNatural ProductNatural where+ _Natural =+ _Wrapped . _Natural++instance+ (ProductNatural ~ a) =>+ Rewrapped ProductNatural a++-- |+--+-- >>> ProductNatural (nat 5) ^. _Wrapped'+-- Natural 5+instance Wrapped ProductNatural where+ type Unwrapped ProductNatural = Natural+ _Wrapped' =+ iso+ (\(ProductNatural x) -> x)+ ProductNatural++-- |+--+-- >>> ProductNatural (nat 3) <> ProductNatural (nat 4)+-- ProductNatural (Natural 12)+instance Semigroup ProductNatural where+ ProductNatural (Natural x) <> ProductNatural (Natural y) =+ ProductNatural (Natural (x * y))++-- |+--+-- >>> mempty :: ProductNatural+-- ProductNatural (Natural 1)+instance Monoid ProductNatural where+ mappend =+ (<>)+ mempty =+ ProductNatural (Natural 1)++-- |+--+-- >>> MaxNatural (nat 3) <> MaxNatural (nat 7)+-- MaxNatural (Natural 7)+newtype MaxNatural+ = MaxNatural+ Natural+ deriving (Eq, Ord, Show)++-- |+--+-- >>> MaxNatural (nat 7) ^. natural+-- Natural 7+instance HasNatural MaxNatural where+ natural =+ _Wrapped . natural++-- |+--+-- >>> MaxNatural (nat 7) ^? _Natural+-- Just (Natural 7)+instance AsNatural MaxNatural where+ _Natural =+ _Wrapped . _Natural++instance+ (MaxNatural ~ a) =>+ Rewrapped MaxNatural a++-- |+--+-- >>> MaxNatural (nat 7) ^. _Wrapped'+-- Natural 7+instance Wrapped MaxNatural where+ type Unwrapped MaxNatural = Natural+ _Wrapped' =+ iso+ (\(MaxNatural x) -> x)+ MaxNatural++-- |+--+-- >>> MaxNatural (nat 3) <> MaxNatural (nat 7)+-- MaxNatural (Natural 7)+instance Semigroup MaxNatural where+ MaxNatural (Natural x) <> MaxNatural (Natural y) =+ MaxNatural (Natural (x `max` y))++-- |+--+-- >>> MinNatural (nat 3) <> MinNatural (nat 7)+-- MinNatural (Natural 3)+newtype MinNatural+ = MinNatural+ Natural+ deriving (Eq, Ord, Show)++-- |+--+-- >>> MinNatural (nat 3) ^. natural+-- Natural 3+instance HasNatural MinNatural where+ natural =+ _Wrapped . natural++-- |+--+-- >>> MinNatural (nat 3) ^? _Natural+-- Just (Natural 3)+instance AsNatural MinNatural where+ _Natural =+ _Wrapped . _Natural++instance+ (MinNatural ~ a) =>+ Rewrapped MinNatural a++-- |+--+-- >>> MinNatural (nat 3) ^. _Wrapped'+-- Natural 3+instance Wrapped MinNatural where+ type Unwrapped MinNatural = Natural+ _Wrapped' =+ iso+ (\(MinNatural x) -> x)+ MinNatural++-- |+--+-- >>> MinNatural (nat 3) <> MinNatural (nat 7)+-- MinNatural (Natural 3)+instance Semigroup MinNatural where+ MinNatural (Natural x) <> MinNatural (Natural y) =+ MinNatural (Natural (x `min` y))++-- | Serialises a 'Natural' to a JSON number.+--+-- >>> fromJSON (Number 0) :: Result Natural+-- Success (Natural 0)+--+-- >>> fromJSON (Number 42) :: Result Natural+-- Success (Natural 42)+--+-- >>> decode "42" :: Maybe Natural+-- Just (Natural 42)+--+-- >>> decode "0" :: Maybe Natural+-- Just (Natural 0)+--+-- >>> decode "-1" :: Maybe Natural+-- Nothing+instance ToJSON Natural where+ toJSON =+ toJsonNatural+ toEncoding (Natural n) =+ toEncoding n++-- | Parses a 'Natural' from a JSON number, failing on negative values.+--+-- >>> decode "0" :: Maybe Natural+-- Just (Natural 0)+instance FromJSON Natural where+ parseJSON =+ parseJsonNatural++-- | Serialises any value with a 'HasNatural' instance to a JSON 'Value'.+--+-- >>> toJsonNatural (nat 42)+-- Number 42.0+--+-- >>> toJsonNatural (ProductNatural (nat 12))+-- Number 12.0+--+-- >>> toJsonNatural (MaxNatural (nat 7))+-- Number 7.0+--+-- >>> toJsonNatural (MinNatural (nat 3))+-- Number 3.0+{-# SPECIALIZE toJsonNatural ::+ Natural ->+ Value+ #-}+{-# INLINE toJsonNatural #-}+toJsonNatural ::+ (HasNatural a) =>+ a ->+ Value+toJsonNatural a =+ let Natural n = a ^. natural+ in toJSON n++-- | Parses a JSON value into a 'Natural', failing on negative values.+--+-- >>> parse parseJsonNatural (Number 42)+-- Success (Natural 42)+--+-- >>> parse parseJsonNatural (Number 0)+-- Success (Natural 0)+--+-- >>> parse parseJsonNatural (Number (-1))+-- Error "parse failed, Natural: expected non-negative integer"+{-# INLINE parseJsonNatural #-}+parseJsonNatural ::+ Value ->+ Parser Natural+parseJsonNatural v =+ parseJSON v >>= \n ->+ if n < 0+ then fail "parse failed, Natural: expected non-negative integer"+ else pure (Natural n)++-- | Serialises a 'ProductNatural' to a JSON number.+--+-- >>> encode (ProductNatural (nat 12))+-- "12"+instance ToJSON ProductNatural where+ toJSON =+ toJsonNatural+ toEncoding (ProductNatural n) =+ toEncoding n++-- | Parses a 'ProductNatural' from a JSON number, failing on negative values.+--+-- >>> decode "12" :: Maybe ProductNatural+-- Just (ProductNatural (Natural 12))+--+-- >>> decode "-1" :: Maybe ProductNatural+-- Nothing+instance FromJSON ProductNatural where+ parseJSON v =+ parseJsonNatural v >>= \n -> pure (ProductNatural n)++-- | Serialises a 'MaxNatural' to a JSON number.+--+-- >>> encode (MaxNatural (nat 7))+-- "7"+instance ToJSON MaxNatural where+ toJSON =+ toJsonNatural+ toEncoding (MaxNatural n) =+ toEncoding n++-- | Parses a 'MaxNatural' from a JSON number, failing on negative values.+--+-- >>> decode "7" :: Maybe MaxNatural+-- Just (MaxNatural (Natural 7))+--+-- >>> decode "-1" :: Maybe MaxNatural+-- Nothing+instance FromJSON MaxNatural where+ parseJSON v =+ parseJsonNatural v >>= \n -> pure (MaxNatural n)++-- | Serialises a 'MinNatural' to a JSON number.+--+-- >>> encode (MinNatural (nat 3))+-- "3"+instance ToJSON MinNatural where+ toJSON =+ toJsonNatural+ toEncoding (MinNatural n) =+ toEncoding n++-- | Parses a 'MinNatural' from a JSON number, failing on negative values.+--+-- >>> decode "3" :: Maybe MinNatural+-- Just (MinNatural (Natural 3))+--+-- >>> decode "-1" :: Maybe MinNatural+-- Nothing+instance FromJSON MinNatural where+ parseJSON v =+ parseJsonNatural v >>= \n -> pure (MinNatural n)++-- | Prism matching zero.+--+-- >>> zero # ()+-- Natural 0+--+-- >>> nat 0 ^? zero+-- Just ()+--+-- >>> nat 3 ^? zero+-- Nothing+zero ::+ Prism'+ Natural+ ()+zero =+ prism'+ (\() -> Natural 0)+ (\(Natural n) -> if n == 0 then Just () else Nothing)++-- | The zero natural number.+--+-- >>> zero'+-- Natural 0+zero' ::+ Natural+zero' =+ zero # ()++-- | Prism between a natural and its predecessor.+--+-- >>> successor # nat 0+-- Natural 1+--+-- >>> successor # nat 4+-- Natural 5+--+-- >>> nat 5 ^? successor+-- Just (Natural 4)+--+-- >>> nat 0 ^? successor+-- Nothing+successor ::+ Prism'+ Natural+ Natural+successor =+ prism'+ (\(Natural n) -> Natural (n + 1))+ (\(Natural n) -> if n == 0 then Nothing else Just (Natural (n - 1)))++-- | The successor of a natural number.+--+-- >>> successor' (nat 0)+-- Natural 1+--+-- >>> successor' (nat 4)+-- Natural 5+successor' ::+ Natural ->+ Natural+successor' =+ (successor #)++-- | Add two natural numbers.+--+-- >>> plus (nat 3) (nat 4)+-- Natural 7+--+-- >>> plus (nat 0) (nat 5)+-- Natural 5+plus ::+ Natural ->+ Natural ->+ Natural+plus =+ (<>)++-- | Multiply two natural numbers.+--+-- >>> multiply (nat 3) (nat 4)+-- Natural 12+--+-- >>> multiply (nat 0) (nat 5)+-- Natural 0+multiply ::+ Natural ->+ Natural ->+ Natural+multiply x y =+ (_Wrapped # x <> (_Wrapped # y :: ProductNatural)) ^. _Wrapped++-- | Raise a natural to a natural power.+--+-- >>> power (nat 2) (nat 10)+-- Natural 1024+--+-- >>> power (nat 3) (nat 0)+-- Natural 1+power ::+ Natural ->+ Natural ->+ Natural+power (Natural x) (Natural y) =+ Natural (x ^ y)++-- | Return the natural if the prism matches, otherwise zero.+--+-- >>> zeroOr (5 :: Integer)+-- Natural 5+--+-- >>> zeroOr (-1 :: Integer)+-- Natural 0+zeroOr ::+ (AsNatural a) =>+ a ->+ Natural+zeroOr n =+ fromMaybe zero' (n ^? _Natural)++-- | Count the elements in a foldable structure.+--+-- >>> length [1,2,3 :: Int]+-- Natural 3+--+-- >>> length ([] :: [Int])+-- Natural 0+length ::+ (Foldable f) =>+ f a ->+ Natural+length =+ foldl' (const . successor') zero'++-- | Replicate a value a natural number of times.+--+-- >>> replicate (nat 3) 'x'+-- "xxx"+--+-- >>> replicate (nat 0) 'x'+-- ""+replicate ::+ Natural ->+ a ->+ [a]+replicate n =+ take n . repeat++-- | Take the first n elements.+--+-- >>> take (nat 2) [1,2,3,4,5 :: Int]+-- [1,2]+--+-- >>> take (nat 0) [1,2,3 :: Int]+-- []+--+-- >>> take (nat 5) [1,2 :: Int]+-- [1,2]+take ::+ Natural ->+ [a] ->+ [a]+take _ [] =+ []+take n (h : t) =+ case n ^? successor of+ Nothing ->+ []+ Just p ->+ h : take p t++-- | Drop the first n elements.+--+-- >>> drop (nat 2) [1,2,3,4,5 :: Int]+-- [3,4,5]+--+-- >>> drop (nat 0) [1,2,3 :: Int]+-- [1,2,3]+--+-- >>> drop (nat 5) [1,2 :: Int]+-- []+drop ::+ Natural ->+ [a] ->+ [a]+drop _ [] =+ []+drop n (h : t) =+ case n ^? successor of+ Nothing ->+ h : t+ Just p ->+ drop p t++-- | Split a list at position n.+--+-- >>> splitAt (nat 2) [1,2,3,4,5 :: Int]+-- ([1,2],[3,4,5])+splitAt ::+ Natural ->+ [a] ->+ ([a], [a])+splitAt n x =+ (take n x, drop n x)++-- | Index into a list.+--+-- >>> [10,20,30 :: Int] !! nat 0+-- Just 10+--+-- >>> [10,20,30 :: Int] !! nat 2+-- Just 30+--+-- >>> [10,20,30 :: Int] !! nat 5+-- Nothing+--+-- >>> ([] :: [Int]) !! nat 0+-- Nothing+(!!) ::+ [a] ->+ Natural ->+ Maybe a+[] !! _ =+ Nothing+(h : t) !! n =+ case n ^? successor of+ Nothing ->+ Just h+ Just p ->+ t !! p++-- | Find all indices where the predicate holds.+--+-- >>> findIndices (== 'a') "abacad"+-- [Natural 0,Natural 2,Natural 4]+--+-- >>> findIndices (== 'z') "abacad"+-- []+findIndices ::+ (a -> Bool) ->+ [a] ->+ [Natural]+findIndices p x =+ map snd (filter (p . fst) (zip x (iterate successor' zero')))++-- | Find the first index where the predicate holds.+--+-- >>> findIndex (== 'c') "abcde"+-- Just (Natural 2)+--+-- >>> findIndex (== 'z') "abcde"+-- Nothing+findIndex ::+ (a -> Bool) ->+ [a] ->+ Maybe Natural+findIndex p =+ listToMaybe . findIndices p++-- | Find all indices of a given element.+--+-- >>> elemIndices 'a' "banana"+-- [Natural 1,Natural 3,Natural 5]+elemIndices ::+ (Eq a) =>+ a ->+ [a] ->+ [Natural]+elemIndices =+ findIndices . (==)++-- | Find the first index of a given element.+--+-- >>> elemIndex 'n' "banana"+-- Just (Natural 2)+--+-- >>> elemIndex 'z' "banana"+-- Nothing+elemIndex ::+ (Eq a) =>+ a ->+ [a] ->+ Maybe Natural+elemIndex =+ findIndex . (==)++-- | Subtract two naturals, flooring at zero.+--+-- >>> minus (nat 5) (nat 3)+-- Natural 2+--+-- >>> minus (nat 3) (nat 5)+-- Natural 0+--+-- >>> minus (nat 3) (nat 3)+-- Natural 0+minus ::+ Natural ->+ Natural ->+ Natural+minus (Natural x) (Natural y) =+ Natural (if x < y then 0 else x - y)++-- | Iso between a natural and a list of units.+--+-- >>> nat 3 ^. list+-- [(),(),()]+--+-- >>> length (nat 3 ^. list)+-- Natural 3+list ::+ Iso'+ Natural+ [()]+list =+ iso+ (`replicate` ())+ length++----++-- | A positive integer (>= 1). Semigroup is multiplication.+--+-- >>> pos 3+-- Positive 3+--+-- >>> pos 3 <> pos 4+-- Positive 12+newtype Positive+ = Positive+ Integer+ deriving (Eq, Ord, Show)++-- |+--+-- >>> pos 3 <> pos 4+-- Positive 12+instance Semigroup Positive where+ Positive x <> Positive y =+ Positive (x * y)++class HasPositive a where+ positive ::+ Lens'+ a+ Positive++-- |+--+-- >>> pos 5 ^. positive+-- Positive 5+instance HasPositive Positive where+ positive =+ id++class AsPositive a where+ _Positive ::+ Prism'+ a+ Positive++-- |+--+-- >>> _Positive # pos 5 :: Positive+-- Positive 5+instance AsPositive Positive where+ _Positive =+ id++integralPrism1 ::+ (Integral a) =>+ Prism'+ a+ Positive+integralPrism1 =+ prism'+ (\(Positive n) -> fromIntegral n)+ (\n -> if n < 1 then Nothing else Just (Positive (fromIntegral n)))++-- |+--+-- >>> (5 :: Int) ^? _Positive+-- Just (Positive 5)+--+-- >>> (0 :: Int) ^? _Positive+-- Nothing+instance AsPositive Int where+ _Positive =+ integralPrism1++-- |+--+-- >>> (42 :: Integer) ^? _Positive+-- Just (Positive 42)+--+-- >>> (0 :: Integer) ^? _Positive+-- Nothing+instance AsPositive Integer where+ _Positive =+ integralPrism1++-- |+--+-- >>> (7 :: Word) ^? _Positive+-- Just (Positive 7)+--+-- >>> (0 :: Word) ^? _Positive+-- Nothing+instance AsPositive Word where+ _Positive =+ integralPrism1++-- |+--+-- >>> import Control.Applicative(Const(..))+-- >>> (Const 5 :: Const Integer Bool) ^? _Positive+-- Just (Positive 5)+instance (Integral a) => AsPositive (Const a b) where+ _Positive =+ integralPrism1++-- |+--+-- >>> import Data.Functor.Identity(Identity(..))+-- >>> (Identity 5 :: Identity Integer) ^? _Positive+-- Just (Positive 5)+instance (Integral a) => AsPositive (Identity a) where+ _Positive =+ integralPrism1++-- |+--+-- >>> SumPositive (pos 3) <> SumPositive (pos 4)+-- SumPositive (Positive 7)+newtype SumPositive+ = SumPositive+ Positive+ deriving (Eq, Ord, Show)++-- |+--+-- >>> SumPositive (pos 5) ^. positive+-- Positive 5+instance HasPositive SumPositive where+ positive =+ _Wrapped . positive++-- |+--+-- >>> SumPositive (pos 5) ^? _Positive+-- Just (Positive 5)+instance AsPositive SumPositive where+ _Positive =+ _Wrapped . _Positive++instance+ (SumPositive ~ a) =>+ Rewrapped SumPositive a++-- |+--+-- >>> SumPositive (pos 5) ^. _Wrapped'+-- Positive 5+instance Wrapped SumPositive where+ type Unwrapped SumPositive = Positive+ _Wrapped' =+ iso+ (\(SumPositive x) -> x)+ SumPositive++-- |+--+-- >>> SumPositive (pos 3) <> SumPositive (pos 4)+-- SumPositive (Positive 7)+instance Semigroup SumPositive where+ SumPositive (Positive x) <> SumPositive (Positive y) =+ SumPositive (Positive (x + y))++-- |+--+-- >>> MaxPositive (pos 3) <> MaxPositive (pos 7)+-- MaxPositive (Positive 7)+newtype MaxPositive+ = MaxPositive+ Positive+ deriving (Eq, Ord, Show)++-- |+--+-- >>> MaxPositive (pos 7) ^. positive+-- Positive 7+instance HasPositive MaxPositive where+ positive =+ _Wrapped . positive++-- |+--+-- >>> MaxPositive (pos 7) ^? _Positive+-- Just (Positive 7)+instance AsPositive MaxPositive where+ _Positive =+ _Wrapped . _Positive++instance+ (MaxPositive ~ a) =>+ Rewrapped MaxPositive a++-- |+--+-- >>> MaxPositive (pos 7) ^. _Wrapped'+-- Positive 7+instance Wrapped MaxPositive where+ type Unwrapped MaxPositive = Positive+ _Wrapped' =+ iso+ (\(MaxPositive x) -> x)+ MaxPositive++-- |+--+-- >>> MaxPositive (pos 3) <> MaxPositive (pos 7)+-- MaxPositive (Positive 7)+instance Semigroup MaxPositive where+ MaxPositive (Positive x) <> MaxPositive (Positive y) =+ MaxPositive (Positive (x `max` y))++-- |+--+-- >>> MinPositive (pos 3) <> MinPositive (pos 7)+-- MinPositive (Positive 3)+newtype MinPositive+ = MinPositive+ Positive+ deriving (Eq, Ord, Show)++-- |+--+-- >>> MinPositive (pos 3) ^. positive+-- Positive 3+instance HasPositive MinPositive where+ positive =+ _Wrapped . positive++-- |+--+-- >>> MinPositive (pos 3) ^? _Positive+-- Just (Positive 3)+instance AsPositive MinPositive where+ _Positive =+ _Wrapped . _Positive++instance+ (MinPositive ~ a) =>+ Rewrapped MinPositive a++-- |+--+-- >>> MinPositive (pos 3) ^. _Wrapped'+-- Positive 3+instance Wrapped MinPositive where+ type Unwrapped MinPositive = Positive+ _Wrapped' =+ iso+ (\(MinPositive x) -> x)+ MinPositive++-- |+--+-- >>> MinPositive (pos 3) <> MinPositive (pos 7)+-- MinPositive (Positive 3)+instance Semigroup MinPositive where+ MinPositive (Positive x) <> MinPositive (Positive y) =+ MinPositive (Positive (x `min` y))++-- | Serialises a 'Positive' to a JSON number.+--+-- >>> fromJSON (Number 1) :: Result Positive+-- Success (Positive 1)+--+-- >>> fromJSON (Number 42) :: Result Positive+-- Success (Positive 42)+--+-- >>> decode "42" :: Maybe Positive+-- Just (Positive 42)+--+-- >>> decode "1" :: Maybe Positive+-- Just (Positive 1)+--+-- >>> decode "0" :: Maybe Positive+-- Nothing+--+-- >>> decode "-1" :: Maybe Positive+-- Nothing+instance ToJSON Positive where+ toJSON =+ toJsonPositive+ toEncoding (Positive n) =+ toEncoding n++-- | Parses a 'Positive' from a JSON number, failing on non-positive values.+--+-- >>> decode "1" :: Maybe Positive+-- Just (Positive 1)+instance FromJSON Positive where+ parseJSON =+ parseJsonPositive++-- | Serialises any value with a 'HasPositive' instance to a JSON 'Value'.+--+-- >>> toJsonPositive (pos 42)+-- Number 42.0+--+-- >>> toJsonPositive (SumPositive (pos 7))+-- Number 7.0+--+-- >>> toJsonPositive (MaxPositive (pos 7))+-- Number 7.0+--+-- >>> toJsonPositive (MinPositive (pos 3))+-- Number 3.0+{-# SPECIALIZE toJsonPositive ::+ Positive ->+ Value+ #-}+{-# INLINE toJsonPositive #-}+toJsonPositive ::+ (HasPositive a) =>+ a ->+ Value+toJsonPositive a =+ let Positive n = a ^. positive+ in toJSON n++-- | Parses a JSON value into a 'Positive', failing on non-positive values.+--+-- >>> parse parseJsonPositive (Number 42)+-- Success (Positive 42)+--+-- >>> parse parseJsonPositive (Number 1)+-- Success (Positive 1)+--+-- >>> parse parseJsonPositive (Number 0)+-- Error "parse failed, Positive: expected positive integer"+--+-- >>> parse parseJsonPositive (Number (-1))+-- Error "parse failed, Positive: expected positive integer"+{-# INLINE parseJsonPositive #-}+parseJsonPositive ::+ Value ->+ Parser Positive+parseJsonPositive v =+ parseJSON v >>= \n ->+ if n < 1+ then fail "parse failed, Positive: expected positive integer"+ else pure (Positive n)++-- | Serialises a 'SumPositive' to a JSON number.+--+-- >>> encode (SumPositive (pos 7))+-- "7"+instance ToJSON SumPositive where+ toJSON =+ toJsonPositive+ toEncoding (SumPositive n) =+ toEncoding n++-- | Parses a 'SumPositive' from a JSON number, failing on non-positive values.+--+-- >>> decode "7" :: Maybe SumPositive+-- Just (SumPositive (Positive 7))+--+-- >>> decode "0" :: Maybe SumPositive+-- Nothing+instance FromJSON SumPositive where+ parseJSON v =+ parseJsonPositive v >>= \n -> pure (SumPositive n)++-- | Serialises a 'MaxPositive' to a JSON number.+--+-- >>> encode (MaxPositive (pos 7))+-- "7"+instance ToJSON MaxPositive where+ toJSON =+ toJsonPositive+ toEncoding (MaxPositive n) =+ toEncoding n++-- | Parses a 'MaxPositive' from a JSON number, failing on non-positive values.+--+-- >>> decode "7" :: Maybe MaxPositive+-- Just (MaxPositive (Positive 7))+--+-- >>> decode "0" :: Maybe MaxPositive+-- Nothing+instance FromJSON MaxPositive where+ parseJSON v =+ parseJsonPositive v >>= \n -> pure (MaxPositive n)++-- | Serialises a 'MinPositive' to a JSON number.+--+-- >>> encode (MinPositive (pos 3))+-- "3"+instance ToJSON MinPositive where+ toJSON =+ toJsonPositive+ toEncoding (MinPositive n) =+ toEncoding n++-- | Parses a 'MinPositive' from a JSON number, failing on non-positive values.+--+-- >>> decode "3" :: Maybe MinPositive+-- Just (MinPositive (Positive 3))+--+-- >>> decode "0" :: Maybe MinPositive+-- Nothing+instance FromJSON MinPositive where+ parseJSON v =+ parseJsonPositive v >>= \n -> pure (MinPositive n)++-- | Iso between a natural and maybe a positive.+--+-- >>> nat 5 ^. naturalPositive+-- Just (Positive 5)+--+-- >>> nat 0 ^. naturalPositive+-- Nothing+naturalPositive ::+ Iso' Natural (Maybe Positive)+naturalPositive =+ iso+ ( \(Natural n) ->+ if n == 0 then Nothing else Just (Positive n)+ )+ ( \x ->+ Natural+ ( case x of+ Nothing ->+ 0+ Just (Positive n) ->+ n+ )+ )++-- |+--+-- >>> nat 5 ^? _Positive+-- Just (Positive 5)+--+-- >>> nat 0 ^? _Positive+-- Nothing+instance AsPositive Natural where+ _Positive =+ prism'+ (\(Positive n) -> Natural n)+ (\(Natural n) -> if n == 0 then Nothing else Just (Positive n))++-- | Prism matching one.+--+-- >>> one # ()+-- Positive 1+--+-- >>> pos 1 ^? one+-- Just ()+--+-- >>> pos 3 ^? one+-- Nothing+one ::+ Prism'+ Positive+ ()+one =+ prism'+ (\() -> Positive 1)+ (\(Positive n) -> if n == 1 then Just () else Nothing)++-- | The positive number one.+--+-- >>> one'+-- Positive 1+one' ::+ Positive+one' =+ one # ()++-- | Prism between a positive and its predecessor.+--+-- >>> successor1 # pos 1+-- Positive 2+--+-- >>> successor1 # pos 4+-- Positive 5+--+-- >>> pos 5 ^? successor1+-- Just (Positive 4)+--+-- >>> pos 1 ^? successor1+-- Nothing+successor1 ::+ Prism'+ Positive+ Positive+successor1 =+ prism'+ (\(Positive n) -> Positive (n + 1))+ (\(Positive n) -> if n == 1 then Nothing else Just (Positive (n - 1)))++-- | The successor of a positive number.+--+-- >>> successor1' (pos 1)+-- Positive 2+--+-- >>> successor1' (pos 4)+-- Positive 5+successor1' ::+ Positive ->+ Positive+successor1' =+ (successor1 #)++-- | Iso between natural and positive (n <-> n+1).+--+-- >>> nat 0 ^. successorW+-- Positive 1+--+-- >>> nat 4 ^. successorW+-- Positive 5+--+-- >>> successorW # pos 1+-- Natural 0+--+-- >>> successorW # pos 5+-- Natural 4+successorW ::+ Iso'+ Natural+ Positive+successorW =+ iso+ (\(Natural n) -> Positive (n + 1))+ (\(Positive n) -> Natural (n - 1))++-- | Add two positive numbers.+--+-- >>> plus1 (pos 3) (pos 4)+-- Positive 7+plus1 ::+ Positive ->+ Positive ->+ Positive+plus1 x y =+ (_Wrapped # x <> (_Wrapped # y :: SumPositive)) ^. _Wrapped++-- | Multiply two positive numbers.+--+-- >>> multiply1 (pos 3) (pos 4)+-- Positive 12+multiply1 ::+ Positive ->+ Positive ->+ Positive+multiply1 =+ (<>)++-- | Raise a positive to a positive power.+--+-- >>> power1 (pos 2) (pos 10)+-- Positive 1024+--+-- >>> power1 (pos 3) (pos 2)+-- Positive 9+power1 ::+ Positive ->+ Positive ->+ Positive+power1 (Positive x) (Positive y) =+ Positive (x ^ y)++-- | Return the positive if the prism matches, otherwise one.+--+-- >>> oneOr (5 :: Integer)+-- Positive 5+--+-- >>> oneOr (0 :: Integer)+-- Positive 1+oneOr ::+ (AsPositive a) =>+ a ->+ Positive+oneOr n =+ fromMaybe one' (n ^? _Positive)++-- | Count the elements in a non-empty foldable.+--+-- >>> length1 ('a' :| "bc")+-- Positive 3+--+-- >>> length1 ('x' :| "")+-- Positive 1+length1 ::+ (Foldable1 f) =>+ f a ->+ Positive+length1 x =+ foldMap1 (const (SumPositive one')) x ^. _Wrapped++-- | Replicate a value a positive number of times.+--+-- >>> replicate1 (pos 3) 'x'+-- 'x' :| "xx"+--+-- >>> replicate1 (pos 1) 'y'+-- 'y' :| ""+replicate1 ::+ Positive ->+ a ->+ NonEmpty a+replicate1 n a =+ take1 n (a :| repeat a)++-- | Take the first n elements from a non-empty list.+--+-- >>> take1 (pos 2) (1 :| [2,3,4,5 :: Int])+-- 1 :| [2]+--+-- >>> take1 (pos 1) (1 :| [2,3 :: Int])+-- 1 :| []+take1 ::+ Positive ->+ NonEmpty a ->+ NonEmpty a+take1 n (h :| t) =+ h :| take (successorW # n) t++-- | Drop the first n elements from a non-empty list.+--+-- >>> drop1 (pos 2) (1 :| [2,3,4,5 :: Int])+-- [3,4,5]+--+-- >>> drop1 (pos 1) (1 :| [2,3 :: Int])+-- [2,3]+drop1 ::+ Positive ->+ NonEmpty a ->+ [a]+drop1 n (_ :| t) =+ drop (successorW # n) t++-- | Split a non-empty list at position n.+--+-- >>> splitAt1 (pos 2) (1 :| [2,3,4,5 :: Int])+-- (1 :| [2],[3,4,5])+splitAt1 ::+ Positive ->+ NonEmpty a ->+ (NonEmpty a, [a])+splitAt1 n x =+ (take1 n x, drop1 n x)++-- | Index into a non-empty list (1-based).+--+-- >>> (10 :| [20,30 :: Int]) !!! pos 1+-- Just 10+--+-- >>> (10 :| [20,30 :: Int]) !!! pos 3+-- Just 30+--+-- >>> (10 :| [20,30 :: Int]) !!! pos 5+-- Nothing+(!!!) ::+ NonEmpty a ->+ Positive ->+ Maybe a+(h :| t) !!! n =+ (h : t) !! (successorW # n)++-- | Find all 1-based indices where the predicate holds.+--+-- >>> findIndices1 (== 'a') ('a' :| "baca")+-- [Positive 1,Positive 3,Positive 5]+findIndices1 ::+ (a -> Bool) ->+ NonEmpty a ->+ [Positive]+findIndices1 p x =+ map snd (NonEmpty.filter (p . fst) (NonEmpty.zip x (NonEmpty.iterate successor1' one')))++-- | Find the first 1-based index where the predicate holds.+--+-- >>> findIndex1 (== 'c') ('a' :| "bcde")+-- Just (Positive 3)+--+-- >>> findIndex1 (== 'z') ('a' :| "bcde")+-- Nothing+findIndex1 ::+ (a -> Bool) ->+ NonEmpty a ->+ Maybe Positive+findIndex1 p =+ listToMaybe . findIndices1 p++-- | Find all 1-based indices of a given element.+--+-- >>> elemIndices1 'a' ('b' :| "anana")+-- [Positive 2,Positive 4,Positive 6]+elemIndices1 ::+ (Eq a) =>+ a ->+ NonEmpty a ->+ [Positive]+elemIndices1 =+ findIndices1 . (==)++-- | Find the first 1-based index of a given element.+--+-- >>> elemIndex1 'n' ('b' :| "anana")+-- Just (Positive 3)+--+-- >>> elemIndex1 'z' ('b' :| "anana")+-- Nothing+elemIndex1 ::+ (Eq a) =>+ a ->+ NonEmpty a ->+ Maybe Positive+elemIndex1 =+ findIndex1 . (==)++-- | Subtract two positives, flooring at one.+--+-- >>> minus1 (pos 5) (pos 3)+-- Positive 2+--+-- >>> minus1 (pos 3) (pos 5)+-- Positive 1+--+-- >>> minus1 (pos 3) (pos 3)+-- Positive 1+minus1 ::+ Positive ->+ Positive ->+ Positive+minus1 (Positive x) (Positive y) =+ Positive (if x <= y then 1 else x - y)++-- | Iso between a positive and a non-empty list of units.+--+-- >>> pos 3 ^. list1+-- () :| [(),()]+--+-- >>> length1 (pos 3 ^. list1)+-- Positive 3+list1 ::+ Iso'+ Positive+ (NonEmpty ())+list1 =+ iso+ (`replicate1` ())+ length1++-- | Convert natural to positive by adding one.+--+-- >>> plusone (nat 0)+-- Positive 1+--+-- >>> plusone (nat 4)+-- Positive 5+plusone ::+ Natural ->+ Positive+plusone =+ (^. successorW)++-- | Convert positive to natural by subtracting one.+--+-- >>> minusone (pos 1)+-- Natural 0+--+-- >>> minusone (pos 5)+-- Natural 4+minusone ::+ Positive ->+ Natural+minusone =+ (successorW #)++----++-- | A non-zero integer. 'True' for positive, 'False' for negative.+-- The 'Positive' gives the absolute value.+--+-- >>> NotZero True (pos 3)+-- NotZero True (Positive 3)+--+-- >>> NotZero False (pos 7)+-- NotZero False (Positive 7)+data NotZero+ = NotZero+ Bool+ Positive+ deriving (Eq, Show)++-- |+--+-- >>> compare (NotZero True (pos 3)) (NotZero True (pos 5))+-- LT+--+-- >>> compare (NotZero False (pos 3)) (NotZero False (pos 5))+-- GT+--+-- >>> compare (NotZero False (pos 1)) (NotZero True (pos 1))+-- LT+--+-- >>> compare (NotZero True (pos 1)) (NotZero False (pos 1))+-- GT+instance Ord NotZero where+ compare (NotZero False (Positive x)) (NotZero False (Positive y)) = compare y x+ compare (NotZero True (Positive x)) (NotZero True (Positive y)) = compare x y+ compare (NotZero False _) (NotZero True _) = compare (0 :: Integer) (1 :: Integer)+ compare (NotZero True _) (NotZero False _) = compare (1 :: Integer) (0 :: Integer)++-- | Semigroup under addition. Note: this is partial if the result would be zero.+-- Use 'plusNZ' for a total version.+--+-- >>> NotZero True (pos 3) <> NotZero True (pos 4)+-- NotZero True (Positive 7)+--+-- >>> NotZero False (pos 3) <> NotZero False (pos 4)+-- NotZero False (Positive 7)+--+-- >>> NotZero True (pos 5) <> NotZero False (pos 3)+-- NotZero True (Positive 2)+--+-- >>> NotZero False (pos 5) <> NotZero True (pos 3)+-- NotZero False (Positive 2)+instance Semigroup NotZero where+ NotZero s1 (Positive x) <> NotZero s2 (Positive y) =+ case (s1, s2) of+ (True, True) -> NotZero True (Positive (x + y))+ (False, False) -> NotZero False (Positive (x + y))+ (True, False)+ | x <= y -> NotZero False (Positive (y - x))+ | True -> NotZero True (Positive (x - y))+ (False, True)+ | y <= x -> NotZero False (Positive (x - y))+ | True -> NotZero True (Positive (y - x))++class HasNotZero a where+ notZero ::+ Lens'+ a+ NotZero++-- |+--+-- >>> NotZero True (pos 5) ^. notZero+-- NotZero True (Positive 5)+instance HasNotZero NotZero where+ notZero =+ id++-- |+--+-- >>> (7 :: Integer) ^? _NotZero+-- Just (NotZero True (Positive 7))+--+-- >>> (-3 :: Integer) ^? _NotZero+-- Just (NotZero False (Positive 3))+--+-- >>> (0 :: Integer) ^? _NotZero+-- Nothing+class AsNotZero a where+ _NotZero ::+ Prism'+ a+ NotZero++-- |+--+-- >>> _NotZero # NotZero True (pos 5) :: NotZero+-- NotZero True (Positive 5)+instance AsNotZero NotZero where+ _NotZero =+ id++integralPrismNZ ::+ (Integral a) =>+ Prism'+ a+ NotZero+integralPrismNZ =+ prism'+ (\(NotZero s (Positive n)) -> fromIntegral (if s then n else negate n))+ ( \n ->+ let i = fromIntegral n :: Integer+ in if i == 0+ then Nothing+ else Just (NotZero (i > 0) (Positive (abs i)))+ )+ where+ (>) a b = not (a <= b) && not (a == b)++-- |+--+-- >>> (5 :: Int) ^? _NotZero+-- Just (NotZero True (Positive 5))+--+-- >>> (-5 :: Int) ^? _NotZero+-- Just (NotZero False (Positive 5))+--+-- >>> (0 :: Int) ^? _NotZero+-- Nothing+instance AsNotZero Int where+ _NotZero =+ integralPrismNZ++-- |+--+-- >>> (42 :: Integer) ^? _NotZero+-- Just (NotZero True (Positive 42))+--+-- >>> (-42 :: Integer) ^? _NotZero+-- Just (NotZero False (Positive 42))+--+-- >>> (0 :: Integer) ^? _NotZero+-- Nothing+instance AsNotZero Integer where+ _NotZero =+ integralPrismNZ++-- |+--+-- >>> (1 :: Word) ^? _NotZero+-- Just (NotZero True (Positive 1))+--+-- >>> (0 :: Word) ^? _NotZero+-- Nothing+instance AsNotZero Word where+ _NotZero =+ integralPrismNZ++-- |+--+-- >>> import Control.Applicative(Const(..))+-- >>> (Const 5 :: Const Integer Bool) ^? _NotZero+-- Just (NotZero True (Positive 5))+instance (Integral a) => AsNotZero (Const a b) where+ _NotZero =+ integralPrismNZ++-- |+--+-- >>> import Data.Functor.Identity(Identity(..))+-- >>> (Identity (-3) :: Identity Integer) ^? _NotZero+-- Just (NotZero False (Positive 3))+instance (Integral a) => AsNotZero (Identity a) where+ _NotZero =+ integralPrismNZ++-- |+--+-- >>> SumNotZero (NotZero True (pos 3)) <> SumNotZero (NotZero True (pos 4))+-- SumNotZero (NotZero True (Positive 7))+newtype SumNotZero+ = SumNotZero+ NotZero+ deriving (Eq, Ord, Show)++-- |+--+-- >>> SumNotZero (NotZero True (pos 5)) ^. notZero+-- NotZero True (Positive 5)+instance HasNotZero SumNotZero where+ notZero =+ _Wrapped . notZero++-- |+--+-- >>> SumNotZero (NotZero True (pos 5)) ^? _NotZero+-- Just (NotZero True (Positive 5))+instance AsNotZero SumNotZero where+ _NotZero =+ _Wrapped . _NotZero++instance+ (SumNotZero ~ a) =>+ Rewrapped SumNotZero a++-- |+--+-- >>> SumNotZero (NotZero True (pos 5)) ^. _Wrapped'+-- NotZero True (Positive 5)+instance Wrapped SumNotZero where+ type Unwrapped SumNotZero = NotZero+ _Wrapped' =+ iso+ (\(SumNotZero x) -> x)+ SumNotZero++-- |+--+-- >>> SumNotZero (NotZero True (pos 3)) <> SumNotZero (NotZero True (pos 4))+-- SumNotZero (NotZero True (Positive 7))+instance Semigroup SumNotZero where+ SumNotZero x <> SumNotZero y =+ SumNotZero (x <> y)++-- |+--+-- >>> MaxNotZero (NotZero True (pos 3)) <> MaxNotZero (NotZero True (pos 7))+-- MaxNotZero (NotZero True (Positive 7))+--+-- >>> MaxNotZero (NotZero False (pos 3)) <> MaxNotZero (NotZero True (pos 1))+-- MaxNotZero (NotZero True (Positive 1))+newtype MaxNotZero+ = MaxNotZero+ NotZero+ deriving (Eq, Ord, Show)++-- |+--+-- >>> MaxNotZero (NotZero True (pos 7)) ^. notZero+-- NotZero True (Positive 7)+instance HasNotZero MaxNotZero where+ notZero =+ _Wrapped . notZero++-- |+--+-- >>> MaxNotZero (NotZero True (pos 7)) ^? _NotZero+-- Just (NotZero True (Positive 7))+instance AsNotZero MaxNotZero where+ _NotZero =+ _Wrapped . _NotZero++instance+ (MaxNotZero ~ a) =>+ Rewrapped MaxNotZero a++-- |+--+-- >>> MaxNotZero (NotZero True (pos 7)) ^. _Wrapped'+-- NotZero True (Positive 7)+instance Wrapped MaxNotZero where+ type Unwrapped MaxNotZero = NotZero+ _Wrapped' =+ iso+ (\(MaxNotZero x) -> x)+ MaxNotZero++-- |+--+-- >>> MaxNotZero (NotZero True (pos 3)) <> MaxNotZero (NotZero True (pos 7))+-- MaxNotZero (NotZero True (Positive 7))+instance Semigroup MaxNotZero where+ MaxNotZero x <> MaxNotZero y =+ MaxNotZero (max x y)++-- |+--+-- >>> MinNotZero (NotZero True (pos 3)) <> MinNotZero (NotZero True (pos 7))+-- MinNotZero (NotZero True (Positive 3))+--+-- >>> MinNotZero (NotZero False (pos 3)) <> MinNotZero (NotZero True (pos 1))+-- MinNotZero (NotZero False (Positive 3))+newtype MinNotZero+ = MinNotZero+ NotZero+ deriving (Eq, Ord, Show)++-- |+--+-- >>> MinNotZero (NotZero False (pos 3)) ^. notZero+-- NotZero False (Positive 3)+instance HasNotZero MinNotZero where+ notZero =+ _Wrapped . notZero++-- |+--+-- >>> MinNotZero (NotZero False (pos 3)) ^? _NotZero+-- Just (NotZero False (Positive 3))+instance AsNotZero MinNotZero where+ _NotZero =+ _Wrapped . _NotZero++instance+ (MinNotZero ~ a) =>+ Rewrapped MinNotZero a++-- |+--+-- >>> MinNotZero (NotZero False (pos 3)) ^. _Wrapped'+-- NotZero False (Positive 3)+instance Wrapped MinNotZero where+ type Unwrapped MinNotZero = NotZero+ _Wrapped' =+ iso+ (\(MinNotZero x) -> x)+ MinNotZero++-- |+--+-- >>> MinNotZero (NotZero True (pos 3)) <> MinNotZero (NotZero True (pos 7))+-- MinNotZero (NotZero True (Positive 3))+instance Semigroup MinNotZero where+ MinNotZero x <> MinNotZero y =+ MinNotZero (min x y)++-- | Serialises a 'NotZero' to a JSON number.+--+-- >>> fromJSON (Number 5) :: Result NotZero+-- Success (NotZero True (Positive 5))+--+-- >>> fromJSON (Number (-3)) :: Result NotZero+-- Success (NotZero False (Positive 3))+--+-- >>> decode "7" :: Maybe NotZero+-- Just (NotZero True (Positive 7))+--+-- >>> decode "-2" :: Maybe NotZero+-- Just (NotZero False (Positive 2))+--+-- >>> decode "0" :: Maybe NotZero+-- Nothing+instance ToJSON NotZero where+ toJSON =+ toJsonNotZero+ toEncoding nz =+ toEncoding (notZeroInteger nz)++-- | Parses a 'NotZero' from a JSON number, failing on zero.+--+-- >>> decode "5" :: Maybe NotZero+-- Just (NotZero True (Positive 5))+instance FromJSON NotZero where+ parseJSON =+ parseJsonNotZero++-- | Serialises any value with a 'HasNotZero' instance to a JSON 'Value'.+--+-- >>> toJsonNotZero (NotZero True (pos 5))+-- Number 5.0+--+-- >>> toJsonNotZero (NotZero False (pos 3))+-- Number (-3.0)+--+-- >>> toJsonNotZero (SumNotZero (NotZero True (pos 7)))+-- Number 7.0+--+-- >>> toJsonNotZero (MaxNotZero (NotZero False (pos 2)))+-- Number (-2.0)+--+-- >>> toJsonNotZero (MinNotZero (NotZero True (pos 1)))+-- Number 1.0+{-# SPECIALIZE toJsonNotZero ::+ NotZero ->+ Value+ #-}+{-# INLINE toJsonNotZero #-}+toJsonNotZero ::+ (HasNotZero a) =>+ a ->+ Value+toJsonNotZero a =+ toJSON (notZeroInteger (a ^. notZero))++-- | Parses a JSON value into a 'NotZero', failing on zero.+--+-- >>> parse parseJsonNotZero (Number 5)+-- Success (NotZero True (Positive 5))+--+-- >>> parse parseJsonNotZero (Number (-3))+-- Success (NotZero False (Positive 3))+--+-- >>> parse parseJsonNotZero (Number 0)+-- Error "parse failed, NotZero: expected non-zero integer"+{-# INLINE parseJsonNotZero #-}+parseJsonNotZero ::+ Value ->+ Parser NotZero+parseJsonNotZero v =+ parseJSON v >>= \n ->+ if n == 0+ then fail "parse failed, NotZero: expected non-zero integer"+ else+ pure+ ( if n < 0+ then NotZero False (Positive (negate n))+ else NotZero True (Positive n)+ )++-- | Serialises a 'SumNotZero' to a JSON number.+--+-- >>> encode (SumNotZero (NotZero True (pos 7)))+-- "7"+instance ToJSON SumNotZero where+ toJSON =+ toJsonNotZero+ toEncoding (SumNotZero nz) =+ toEncoding (notZeroInteger nz)++-- | Parses a 'SumNotZero' from a JSON number, failing on zero.+--+-- >>> decode "7" :: Maybe SumNotZero+-- Just (SumNotZero (NotZero True (Positive 7)))+--+-- >>> decode "0" :: Maybe SumNotZero+-- Nothing+instance FromJSON SumNotZero where+ parseJSON v =+ parseJsonNotZero v >>= \n -> pure (SumNotZero n)++-- | Serialises a 'MaxNotZero' to a JSON number.+--+-- >>> encode (MaxNotZero (NotZero False (pos 2)))+-- "-2"+instance ToJSON MaxNotZero where+ toJSON =+ toJsonNotZero+ toEncoding (MaxNotZero nz) =+ toEncoding (notZeroInteger nz)++-- | Parses a 'MaxNotZero' from a JSON number, failing on zero.+--+-- >>> decode "-2" :: Maybe MaxNotZero+-- Just (MaxNotZero (NotZero False (Positive 2)))+--+-- >>> decode "0" :: Maybe MaxNotZero+-- Nothing+instance FromJSON MaxNotZero where+ parseJSON v =+ parseJsonNotZero v >>= \n -> pure (MaxNotZero n)++-- | Serialises a 'MinNotZero' to a JSON number.+--+-- >>> encode (MinNotZero (NotZero True (pos 1)))+-- "1"+instance ToJSON MinNotZero where+ toJSON =+ toJsonNotZero+ toEncoding (MinNotZero nz) =+ toEncoding (notZeroInteger nz)++-- | Parses a 'MinNotZero' from a JSON number, failing on zero.+--+-- >>> decode "1" :: Maybe MinNotZero+-- Just (MinNotZero (NotZero True (Positive 1)))+--+-- >>> decode "0" :: Maybe MinNotZero+-- Nothing+instance FromJSON MinNotZero where+ parseJSON v =+ parseJsonNotZero v >>= \n -> pure (MinNotZero n)++-- | Embed a 'Positive' as a positive 'NotZero'.+--+-- >>> positiveNotZero (pos 5)+-- NotZero True (Positive 5)+positiveNotZero ::+ Positive ->+ NotZero+positiveNotZero =+ NotZero True++-- | Embed a 'Positive' as a negative 'NotZero'.+--+-- >>> negativeNotZero (pos 5)+-- NotZero False (Positive 5)+negativeNotZero ::+ Positive ->+ NotZero+negativeNotZero =+ NotZero False++-- | Extract the magnitude from a 'NotZero'.+--+-- >>> notZeroPositive (NotZero True (pos 5))+-- Positive 5+--+-- >>> notZeroPositive (NotZero False (pos 3))+-- Positive 3+notZeroPositive ::+ NotZero ->+ Positive+notZeroPositive (NotZero _ p) =+ p++-- | Convert a 'NotZero' to an 'Integer'.+--+-- >>> notZeroInteger (NotZero True (pos 5))+-- 5+--+-- >>> notZeroInteger (NotZero False (pos 3))+-- -3+notZeroInteger ::+ NotZero ->+ Integer+notZeroInteger (NotZero s (Positive n)) =+ if s then n else negate n++-- | Test if a 'NotZero' is positive.+--+-- >>> isPositive (NotZero True (pos 5))+-- True+--+-- >>> isPositive (NotZero False (pos 5))+-- False+isPositive ::+ NotZero ->+ Bool+isPositive (NotZero s _) =+ s++-- | Test if a 'NotZero' is negative.+--+-- >>> isNegative (NotZero False (pos 5))+-- True+--+-- >>> isNegative (NotZero True (pos 5))+-- False+isNegative ::+ NotZero ->+ Bool+isNegative (NotZero s _) =+ not s++-- | Negate a 'NotZero'.+--+-- >>> negateNZ (NotZero True (pos 5))+-- NotZero False (Positive 5)+--+-- >>> negateNZ (NotZero False (pos 3))+-- NotZero True (Positive 3)+negateNZ ::+ NotZero ->+ NotZero+negateNZ (NotZero s p) =+ NotZero (not s) p++-- | Absolute value as a 'Positive'.+--+-- >>> absoluteNZ (NotZero True (pos 5))+-- Positive 5+--+-- >>> absoluteNZ (NotZero False (pos 3))+-- Positive 3+absoluteNZ ::+ NotZero ->+ Positive+absoluteNZ =+ notZeroPositive++-- | Signum: positive one or negative one.+--+-- >>> signumNZ (NotZero True (pos 99))+-- NotZero True (Positive 1)+--+-- >>> signumNZ (NotZero False (pos 42))+-- NotZero False (Positive 1)+signumNZ ::+ NotZero ->+ NotZero+signumNZ (NotZero s _) =+ NotZero s one'++-- | Add two 'NotZero' values. Returns 'Nothing' if the result is zero.+--+-- >>> plusNZ (NotZero True (pos 3)) (NotZero True (pos 4))+-- Just (NotZero True (Positive 7))+--+-- >>> plusNZ (NotZero True (pos 3)) (NotZero False (pos 3))+-- Nothing+--+-- >>> plusNZ (NotZero True (pos 5)) (NotZero False (pos 3))+-- Just (NotZero True (Positive 2))+--+-- >>> plusNZ (NotZero False (pos 5)) (NotZero True (pos 3))+-- Just (NotZero False (Positive 2))+plusNZ ::+ NotZero ->+ NotZero ->+ Maybe NotZero+plusNZ (NotZero s1 (Positive x)) (NotZero s2 (Positive y)) =+ case (s1, s2) of+ (True, True) -> Just (NotZero True (Positive (x + y)))+ (False, False) -> Just (NotZero False (Positive (x + y)))+ (True, False)+ | x == y -> Nothing+ | x < y -> Just (NotZero False (Positive (y - x)))+ | True -> Just (NotZero True (Positive (x - y)))+ (False, True)+ | x == y -> Nothing+ | y < x -> Just (NotZero False (Positive (x - y)))+ | True -> Just (NotZero True (Positive (y - x)))++-- | Multiply two 'NotZero' values. Always non-zero.+--+-- >>> multiplyNZ (NotZero True (pos 3)) (NotZero True (pos 4))+-- NotZero True (Positive 12)+--+-- >>> multiplyNZ (NotZero False (pos 3)) (NotZero True (pos 4))+-- NotZero False (Positive 12)+--+-- >>> multiplyNZ (NotZero False (pos 3)) (NotZero False (pos 4))+-- NotZero True (Positive 12)+multiplyNZ ::+ NotZero ->+ NotZero ->+ NotZero+multiplyNZ (NotZero s1 (Positive x)) (NotZero s2 (Positive y)) =+ NotZero (s1 == s2) (Positive (x * y))++-- | Return the 'NotZero' if the prism matches, otherwise positive one.+--+-- >>> notZeroOr (5 :: Integer)+-- NotZero True (Positive 5)+--+-- >>> notZeroOr (0 :: Integer)+-- NotZero True (Positive 1)+--+-- >>> notZeroOr (-3 :: Integer)+-- NotZero False (Positive 3)+notZeroOr ::+ (AsNotZero a) =>+ a ->+ NotZero+notZeroOr n =+ fromMaybe (NotZero True one') (n ^? _NotZero)++-- | Prism from 'NotZero' to 'Positive' (matches only positive values).+--+-- >>> (NotZero True (pos 5)) ^? _Positive+-- Just (Positive 5)+--+-- >>> (NotZero False (pos 5)) ^? _Positive+-- Nothing+instance AsPositive NotZero where+ _Positive =+ prism'+ positiveNotZero+ (\(NotZero s p) -> if s then Just p else Nothing)
+ test/Main.hs view
@@ -0,0 +1,18 @@+{-# OPTIONS_GHC -Wall -Werror -Wno-orphans #-}++module Main (main) where++import System.Exit (exitWith)+import System.Process (rawSystem)++main :: IO ()+main =+ exitWith+ =<< rawSystem+ "cabal"+ [ "repl",+ "--with-compiler=doctest",+ "--repl-options=-w",+ "--repl-options=-Wdefault",+ "lib:natural"+ ]
− test/Tests.hs
@@ -1,2 +0,0 @@-main :: IO ()-main = putStrLn "test"