natural 0.4.0.0 → 0.5.0.1
raw patch · 8 files changed
+2487/−1634 lines, 8 filesdep +naturaldep +tasty-benchdep −semigroupsdep ~aesonsetup-changedPVP ok
version bump matches the API change (PVP)
Dependencies added: natural, tasty-bench
Dependencies removed: semigroups
Dependency ranges changed: aeson
API changes (from Hackage documentation)
+ Natural: MaxNotZero :: NotZero -> MaxNotZero
+ Natural: MinNotZero :: NotZero -> MinNotZero
+ Natural: NotZero :: Bool -> Positive -> NotZero
+ Natural: SumNotZero :: NotZero -> SumNotZero
+ Natural: _NotZero :: AsNotZero a => Prism' a NotZero
+ Natural: absoluteNZ :: NotZero -> Positive
+ Natural: class AsNotZero a
+ Natural: class HasNotZero a
+ Natural: data NotZero
+ Natural: instance (Natural.MaxNotZero GHC.Types.~ a) => Control.Lens.Wrapped.Rewrapped Natural.MaxNotZero a
+ Natural: instance (Natural.MinNotZero GHC.Types.~ a) => Control.Lens.Wrapped.Rewrapped Natural.MinNotZero a
+ Natural: instance (Natural.SumNotZero GHC.Types.~ a) => Control.Lens.Wrapped.Rewrapped Natural.SumNotZero a
+ Natural: instance Control.Lens.Wrapped.Wrapped Natural.MaxNotZero
+ Natural: instance Control.Lens.Wrapped.Wrapped Natural.MinNotZero
+ Natural: instance Control.Lens.Wrapped.Wrapped Natural.SumNotZero
+ Natural: instance Data.Aeson.Types.FromJSON.FromJSON Natural.MaxNotZero
+ Natural: instance Data.Aeson.Types.FromJSON.FromJSON Natural.MinNotZero
+ Natural: instance Data.Aeson.Types.FromJSON.FromJSON Natural.NotZero
+ Natural: instance Data.Aeson.Types.FromJSON.FromJSON Natural.SumNotZero
+ Natural: instance Data.Aeson.Types.ToJSON.ToJSON Natural.MaxNotZero
+ Natural: instance Data.Aeson.Types.ToJSON.ToJSON Natural.MinNotZero
+ Natural: instance Data.Aeson.Types.ToJSON.ToJSON Natural.NotZero
+ Natural: instance Data.Aeson.Types.ToJSON.ToJSON Natural.SumNotZero
+ Natural: instance GHC.Base.Semigroup Natural.MaxNotZero
+ Natural: instance GHC.Base.Semigroup Natural.MinNotZero
+ Natural: instance GHC.Base.Semigroup Natural.NotZero
+ Natural: instance GHC.Base.Semigroup Natural.SumNotZero
+ Natural: instance GHC.Classes.Eq Natural.MaxNotZero
+ Natural: instance GHC.Classes.Eq Natural.MinNotZero
+ Natural: instance GHC.Classes.Eq Natural.NotZero
+ Natural: instance GHC.Classes.Eq Natural.SumNotZero
+ Natural: instance GHC.Classes.Ord Natural.MaxNotZero
+ Natural: instance GHC.Classes.Ord Natural.MinNotZero
+ Natural: instance GHC.Classes.Ord Natural.NotZero
+ Natural: instance GHC.Classes.Ord Natural.SumNotZero
+ Natural: instance GHC.Real.Integral a => Natural.AsNotZero (Data.Functor.Const.Const a b)
+ Natural: instance GHC.Real.Integral a => Natural.AsNotZero (Data.Functor.Identity.Identity a)
+ Natural: instance GHC.Show.Show Natural.MaxNotZero
+ Natural: instance GHC.Show.Show Natural.MinNotZero
+ Natural: instance GHC.Show.Show Natural.NotZero
+ Natural: instance GHC.Show.Show Natural.SumNotZero
+ Natural: instance Natural.AsNotZero GHC.Num.Integer.Integer
+ Natural: instance Natural.AsNotZero GHC.Types.Int
+ Natural: instance Natural.AsNotZero GHC.Types.Word
+ Natural: instance Natural.AsNotZero Natural.MaxNotZero
+ Natural: instance Natural.AsNotZero Natural.MinNotZero
+ Natural: instance Natural.AsNotZero Natural.NotZero
+ Natural: instance Natural.AsNotZero Natural.SumNotZero
+ Natural: instance Natural.AsPositive Natural.NotZero
+ Natural: instance Natural.HasNotZero Natural.MaxNotZero
+ Natural: instance Natural.HasNotZero Natural.MinNotZero
+ Natural: instance Natural.HasNotZero Natural.NotZero
+ Natural: instance Natural.HasNotZero Natural.SumNotZero
+ Natural: isNegative :: NotZero -> Bool
+ Natural: isPositive :: NotZero -> Bool
+ Natural: multiplyNZ :: NotZero -> NotZero -> NotZero
+ Natural: negateNZ :: NotZero -> NotZero
+ Natural: negativeNotZero :: Positive -> NotZero
+ Natural: newtype MaxNotZero
+ Natural: newtype MinNotZero
+ Natural: newtype SumNotZero
+ Natural: notZeroInteger :: NotZero -> Integer
+ Natural: notZeroOr :: AsNotZero a => a -> NotZero
+ Natural: notZeroPositive :: NotZero -> Positive
+ Natural: parseJsonNotZero :: Value -> Parser NotZero
+ Natural: plusNZ :: NotZero -> NotZero -> Maybe NotZero
+ Natural: positiveNotZero :: Positive -> NotZero
+ Natural: signumNZ :: NotZero -> NotZero
+ Natural: toJsonNotZero :: HasNotZero a => a -> Value
- Natural: notZero :: Prism' Natural Positive
+ Natural: notZero :: HasNotZero a => Lens' a NotZero
Files
- LICENCE +2/−2
- README.md +92/−0
- Setup.hs +7/−1
- benchmarks/Main.hs +24/−0
- changelog.md +35/−0
- natural.cabal +54/−30
- src/Natural.hs +2272/−1600
- test/Main.hs +1/−1
LICENCE view
@@ -1,4 +1,4 @@-Copyright (c) 2020-2026, 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,38 @@+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`).
natural.cabal view
@@ -1,45 +1,69 @@ cabal-version: 2.4 name: natural-version: 0.4.0.0+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: BSD-3-Clause 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-2026 System F-category: Control+author: Tony Morris <tmorris@tmorris.net>+maintainer: Tony Morris <tmorris@tmorris.net>+category: Data build-type: Simple extra-doc-files: changelog.md-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+ , 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- , aeson >= 2.2 && < 3- , 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 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- default-language: Haskell2010- ghc-options: -Wall+ , 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
@@ -11,1603 +11,2275 @@ ProductNatural (..), MaxNatural (..), MinNatural (..),- toJsonNatural,- parseJsonNatural,- 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 (..),- toJsonPositive,- parseJsonPositive,- naturalPositive,- one,- one',- successor1,- successor1',- successorW,- plus1,- multiply1,- power1,- oneOr,- notZero,- length1,- replicate1,- take1,- drop1,- splitAt1,- (!!!),- findIndices1,- findIndex1,- elemIndices1,- elemIndex1,- minus1,- list1,- plusone,- minusone,- )-where--import Control.Applicative (Const, pure)-import Control.Category (id, (.))-import Control.Lens (Iso', Lens', Prism', Rewrapped, Wrapped (Unwrapped, _Wrapped'), iso, prism', view, (#), (^.), (^?), _Wrapped)-import Control.Monad ((>>=))-import Data.Aeson.Types- ( FromJSON (parseJSON),- Parser,- ToJSON (toEncoding, toJSON),- Value,- )-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 (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 ((<), (<=)), 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, fail, fromIntegral, (*), (+), (-), (^))---- $setup--- >>> import Data.Aeson--- >>> import Data.Aeson.Types (parse)--- >>> :set -XOverloadedStrings---- | A natural number (non-negative integer: 0, 1, 2, ...).------ >>> Natural 0--- Natural 0------ >>> Natural 42--- Natural 42-newtype Natural- = Natural- Integer- deriving (Eq, Ord, Show)---- | Natural numbers form a semigroup under addition.------ >>> Natural 3 <> Natural 4--- Natural 7-instance Semigroup Natural where- Natural x <> Natural y =- Natural (x + y)---- | The additive monoid of natural numbers with identity 0.------ >>> mempty :: Natural--- Natural 0------ >>> mappend (Natural 3) (Natural 4)--- Natural 7-instance Monoid Natural where- mappend =- (<>)- mempty =- Natural 0---- | Typeclass for types that have a 'Natural' lens.------ >>> Natural 5 ^. natural--- Natural 5-class HasNatural a where- natural ::- Lens'- a- Natural---- | >>> Natural 5 ^. natural--- Natural 5-instance HasNatural Natural where- natural =- id---- | Typeclass for types that can be converted to/from 'Natural' via a prism.------ >>> (5 :: Integer) ^? _Natural--- Just (Natural 5)------ >>> (-1 :: Integer) ^? _Natural--- Nothing-class AsNatural a where- _Natural ::- Prism'- a- Natural---- | >>> Natural 5 ^? _Natural--- Just (Natural 5)-instance AsNatural Natural where- _Natural =- id---- | Prism for converting an integral value to a 'Natural'.------ >>> (5 :: Integer) ^? integralPrism--- Just (Natural 5)------ >>> (-1 :: Integer) ^? integralPrism--- Nothing-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---- | >>> (5 :: Integer) ^? _Natural--- Just (Natural 5)------ >>> (-1 :: Integer) ^? _Natural--- Nothing-instance AsNatural Integer where- _Natural =- integralPrism---- | >>> (5 :: Word) ^? _Natural--- Just (Natural 5)-instance AsNatural Word where- _Natural =- integralPrism---- | >>> (Const 5 :: Const Integer Bool) ^? _Natural--- Just (Natural 5)-instance (Integral a) => AsNatural (Const a b) where- _Natural =- integralPrism---- | >>> (Identity 5 :: Identity Integer) ^? _Natural--- Just (Natural 5)-instance (Integral a) => AsNatural (Identity a) where- _Natural =- integralPrism---- | Natural numbers under multiplication.------ >>> ProductNatural (Natural 3) <> ProductNatural (Natural 4)--- ProductNatural (Natural 12)------ >>> mempty :: ProductNatural--- ProductNatural (Natural 1)-newtype ProductNatural- = ProductNatural- Natural- deriving (Eq, Ord, Show)---- | >>> ProductNatural (Natural 5) ^. natural--- Natural 5-instance HasNatural ProductNatural where- natural =- _Wrapped . natural---- | >>> ProductNatural (Natural 5) ^? _Natural--- Just (Natural 5)-instance AsNatural ProductNatural where- _Natural =- _Wrapped . _Natural--instance- (ProductNatural ~ a) =>- Rewrapped ProductNatural a---- | >>> ProductNatural (Natural 5) ^. _Wrapped'--- Natural 5-instance Wrapped ProductNatural where- type Unwrapped ProductNatural = Natural- _Wrapped' =- iso- (\(ProductNatural x) -> x)- ProductNatural---- | >>> ProductNatural (Natural 3) <> ProductNatural (Natural 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)---- | Natural numbers under maximum.------ >>> MaxNatural (Natural 3) <> MaxNatural (Natural 7)--- MaxNatural (Natural 7)-newtype MaxNatural- = MaxNatural- Natural- deriving (Eq, Ord, Show)---- | >>> MaxNatural (Natural 5) ^. natural--- Natural 5-instance HasNatural MaxNatural where- natural =- _Wrapped . natural---- | >>> MaxNatural (Natural 5) ^? _Natural--- Just (Natural 5)-instance AsNatural MaxNatural where- _Natural =- _Wrapped . _Natural--instance- (MaxNatural ~ a) =>- Rewrapped MaxNatural a---- | >>> MaxNatural (Natural 5) ^. _Wrapped'--- Natural 5-instance Wrapped MaxNatural where- type Unwrapped MaxNatural = Natural- _Wrapped' =- iso- (\(MaxNatural x) -> x)- MaxNatural---- | >>> MaxNatural (Natural 3) <> MaxNatural (Natural 7)--- MaxNatural (Natural 7)-instance Semigroup MaxNatural where- MaxNatural (Natural x) <> MaxNatural (Natural y) =- MaxNatural (Natural (x `max` y))---- | Natural numbers under minimum.------ >>> MinNatural (Natural 3) <> MinNatural (Natural 7)--- MinNatural (Natural 3)-newtype MinNatural- = MinNatural- Natural- deriving (Eq, Ord, Show)---- | >>> MinNatural (Natural 5) ^. natural--- Natural 5-instance HasNatural MinNatural where- natural =- _Wrapped . natural---- | >>> MinNatural (Natural 5) ^? _Natural--- Just (Natural 5)-instance AsNatural MinNatural where- _Natural =- _Wrapped . _Natural--instance- (MinNatural ~ a) =>- Rewrapped MinNatural a---- | >>> MinNatural (Natural 5) ^. _Wrapped'--- Natural 5-instance Wrapped MinNatural where- type Unwrapped MinNatural = Natural- _Wrapped' =- iso- (\(MinNatural x) -> x)- MinNatural---- | >>> MinNatural (Natural 3) <> MinNatural (Natural 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.------ >>> toJSON (Natural 0)--- Number 0.0------ >>> toJSON (Natural 42)--- Number 42.0------ >>> encode (Natural 0)--- "0"------ >>> encode (Natural 42)--- "42"-instance ToJSON Natural where- toJSON =- toJsonNatural- toEncoding (Natural n) =- toEncoding n---- | Serialises any value with a 'HasNatural' instance to a JSON 'Value'.------ >>> toJsonNatural (Natural 42)--- Number 42.0------ >>> toJsonNatural (ProductNatural (Natural 12))--- Number 12.0------ >>> toJsonNatural (MaxNatural (Natural 7))--- Number 7.0------ >>> toJsonNatural (MinNatural (Natural 3))--- Number 3.0-{-# SPECIALIZE toJsonNatural ::- Natural ->- Value- #-}-{-# INLINE toJsonNatural #-}-toJsonNatural ::- (HasNatural a) =>- a ->- Value-toJsonNatural a =- let Natural n = view natural a- in toJSON n---- | Parses a 'Natural' from a JSON number, failing on negative values.------ >>> 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 FromJSON Natural where- parseJSON =- parseJsonNatural---- | 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 (Natural 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 (Natural 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 (Natural 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)---- | A prism for the zero natural number.------ >>> zero # ()--- Natural 0------ >>> Natural 0 ^? zero--- Just ()------ >>> Natural 5 ^? 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 # ()---- | A prism for the successor of a natural number.------ >>> successor # Natural 0--- Natural 1------ >>> successor # Natural 4--- Natural 5------ >>> Natural 5 ^? successor--- Just (Natural 4)------ >>> Natural 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' (Natural 0)--- Natural 1------ >>> successor' (Natural 4)--- Natural 5-successor' ::- Natural ->- Natural-successor' =- (successor #)---- | Add two natural numbers.------ >>> plus (Natural 3) (Natural 4)--- Natural 7------ >>> plus (Natural 0) (Natural 5)--- Natural 5-plus ::- Natural ->- Natural ->- Natural-plus =- (<>)---- | Multiply two natural numbers.------ >>> multiply (Natural 3) (Natural 4)--- Natural 12------ >>> multiply (Natural 0) (Natural 5)--- Natural 0-multiply ::- Natural ->- Natural ->- Natural-multiply x y =- (_Wrapped # x <> (_Wrapped # y :: ProductNatural)) ^. _Wrapped---- | Raise a natural number to a power.------ >>> power (Natural 2) (Natural 10)--- Natural 1024------ >>> power (Natural 5) (Natural 0)--- Natural 1-power ::- Natural ->- Natural ->- Natural-power (Natural x) (Natural y) =- Natural (x ^ y)---- | Convert to 'Natural', defaulting to zero if the value is not a valid natural.------ >>> zeroOr (5 :: Integer)--- Natural 5------ >>> zeroOr (-1 :: Integer)--- Natural 0-zeroOr ::- (AsNatural a) =>- a ->- Natural-zeroOr n =- fromMaybe zero' (n ^? _Natural)---- | The length of a foldable structure as a 'Natural'.------ >>> 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 (Natural 3) 'x'--- "xxx"------ >>> replicate (Natural 0) 'x'--- ""-replicate ::- Natural ->- a ->- [a]-replicate n =- take n . repeat---- | Take a natural number of elements from a list.------ >>> take (Natural 2) [1, 2, 3 :: Int]--- [1,2]------ >>> take (Natural 0) [1, 2, 3 :: Int]--- []------ >>> take (Natural 5) [1, 2, 3 :: Int]--- [1,2,3]-take ::- Natural ->- [a] ->- [a]-take _ [] =- []-take n (h : t) =- case n ^? successor of- Nothing ->- []- Just p ->- h : take p t---- | Drop a natural number of elements from a list.------ >>> drop (Natural 2) [1, 2, 3, 4 :: Int]--- [3,4]------ >>> drop (Natural 0) [1, 2, 3 :: Int]--- [1,2,3]------ >>> drop (Natural 5) [1, 2, 3 :: 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 a natural index.------ >>> splitAt (Natural 2) [1, 2, 3, 4 :: Int]--- ([1,2],[3,4])------ >>> splitAt (Natural 0) [1, 2, 3 :: Int]--- ([],[1,2,3])------ >>> splitAt (Natural 5) [1, 2, 3 :: Int]--- ([1,2,3],[])-splitAt ::- Natural ->- [a] ->- ([a], [a])-splitAt n x =- (take n x, drop n x)---- | Safe list indexing by 'Natural'.------ >>> ([] :: [Int]) !! Natural 0--- Nothing------ >>> [1, 2, 3 :: Int] !! Natural 0--- Just 1-(!!) ::- [a] ->- Natural ->- Maybe a-[] !! _ =- Nothing-(h : t) !! n = case n ^? successor of- Nothing -> Just h- Just p -> t !! p---- | Find all indices where a predicate holds.------ >>> findIndices (== 'a') "abacus"--- [Natural 0,Natural 2]------ >>> findIndices (== 'z') "abc"--- []-findIndices ::- (a -> Bool) ->- [a] ->- [Natural]-findIndices p x =- map snd (filter (p . fst) (zip x (iterate successor' zero')))---- | Find the first index where a predicate holds.------ >>> findIndex (== 'a') "banana"--- Just (Natural 1)------ >>> findIndex (== 'z') "banana"--- Nothing-findIndex ::- (a -> Bool) ->- [a] ->- Maybe Natural-findIndex p =- listToMaybe . findIndices p---- | Find all indices of an element.------ >>> elemIndices 'a' "abacus"--- [Natural 0,Natural 2]------ >>> elemIndices 'z' "abc"--- []-elemIndices ::- (Eq a) =>- a ->- [a] ->- [Natural]-elemIndices =- findIndices . (==)---- | Find the first index of an element.------ >>> elemIndex 'a' "banana"--- Just (Natural 1)------ >>> elemIndex 'z' "banana"--- Nothing-elemIndex ::- (Eq a) =>- a ->- [a] ->- Maybe Natural-elemIndex =- findIndex . (==)---- | Subtract two natural numbers, flooring at zero.------ >>> minus (Natural 5) (Natural 3)--- Natural 2------ >>> minus (Natural 3) (Natural 5)--- Natural 0-minus ::- Natural ->- Natural ->- Natural-minus (Natural x) (Natural y) =- Natural (if x < y then 0 else x - y)---- | An isomorphism between 'Natural' and @[()]@.------ >>> Natural 3 ^. list--- [(),(),()]------ >>> Natural 0 ^. list--- []------ >>> list # [(), (), ()]--- Natural 3-list ::- Iso'- Natural- [()]-list =- iso- (`replicate` ())- length---------- | A positive integer (strictly positive: 1, 2, 3, ...).------ >>> Positive 1--- Positive 1------ >>> Positive 42--- Positive 42-newtype Positive- = Positive- Integer- deriving (Eq, Ord, Show)---- | Positive numbers form a semigroup under addition.------ >>> Positive 3 <> Positive 4--- Positive 7-instance Semigroup Positive where- Positive x <> Positive y =- Positive (x + y)---- | Typeclass for types that have a 'Positive' lens.------ >>> Positive 5 ^. positive--- Positive 5-class HasPositive a where- positive ::- Lens'- a- Positive---- | >>> Positive 5 ^. positive--- Positive 5-instance HasPositive Positive where- positive =- id---- | Typeclass for types that can be converted to/from 'Positive' via a prism.------ >>> (5 :: Integer) ^? _Positive--- Just (Positive 5)------ >>> (0 :: Integer) ^? _Positive--- Nothing-class AsPositive a where- _Positive ::- Prism'- a- Positive---- | >>> Positive 5 ^? _Positive--- Just (Positive 5)-instance AsPositive Positive where- _Positive =- id---- | Prism for converting an integral value to a 'Positive'.------ >>> (5 :: Integer) ^? integralPrism1--- Just (Positive 5)------ >>> (0 :: Integer) ^? integralPrism1--- Nothing-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---- | >>> (5 :: Integer) ^? _Positive--- Just (Positive 5)------ >>> (0 :: Integer) ^? _Positive--- Nothing-instance AsPositive Integer where- _Positive =- integralPrism1---- | >>> (5 :: Word) ^? _Positive--- Just (Positive 5)------ >>> (0 :: Word) ^? _Positive--- Nothing-instance AsPositive Word where- _Positive =- integralPrism1---- | >>> (Const 5 :: Const Integer Bool) ^? _Positive--- Just (Positive 5)-instance (Integral a) => AsPositive (Const a b) where- _Positive =- integralPrism1---- | >>> (Identity 5 :: Identity Integer) ^? _Positive--- Just (Positive 5)-instance (Integral a) => AsPositive (Identity a) where- _Positive =- integralPrism1---- | Positive numbers under addition.------ >>> SumPositive (Positive 3) <> SumPositive (Positive 4)--- SumPositive (Positive 7)-newtype SumPositive- = SumPositive- Positive- deriving (Eq, Ord, Show)---- | >>> SumPositive (Positive 5) ^. positive--- Positive 5-instance HasPositive SumPositive where- positive =- _Wrapped . positive---- | >>> SumPositive (Positive 5) ^? _Positive--- Just (Positive 5)-instance AsPositive SumPositive where- _Positive =- _Wrapped . _Positive--instance- (SumPositive ~ a) =>- Rewrapped SumPositive a---- | >>> SumPositive (Positive 5) ^. _Wrapped'--- Positive 5-instance Wrapped SumPositive where- type Unwrapped SumPositive = Positive- _Wrapped' =- iso- (\(SumPositive x) -> x)- SumPositive---- | >>> SumPositive (Positive 3) <> SumPositive (Positive 4)--- SumPositive (Positive 7)-instance Semigroup SumPositive where- SumPositive (Positive x) <> SumPositive (Positive y) =- SumPositive (Positive (x + y))---- | Positive numbers under maximum.------ >>> MaxPositive (Positive 3) <> MaxPositive (Positive 7)--- MaxPositive (Positive 7)-newtype MaxPositive- = MaxPositive- Positive- deriving (Eq, Ord, Show)---- | >>> MaxPositive (Positive 5) ^. positive--- Positive 5-instance HasPositive MaxPositive where- positive =- _Wrapped . positive---- | >>> MaxPositive (Positive 5) ^? _Positive--- Just (Positive 5)-instance AsPositive MaxPositive where- _Positive =- _Wrapped . _Positive--instance- (MaxPositive ~ a) =>- Rewrapped MaxPositive a---- | >>> MaxPositive (Positive 5) ^. _Wrapped'--- Positive 5-instance Wrapped MaxPositive where- type Unwrapped MaxPositive = Positive- _Wrapped' =- iso- (\(MaxPositive x) -> x)- MaxPositive---- | >>> MaxPositive (Positive 3) <> MaxPositive (Positive 7)--- MaxPositive (Positive 7)-instance Semigroup MaxPositive where- MaxPositive (Positive x) <> MaxPositive (Positive y) =- MaxPositive (Positive (x `max` y))---- | Positive numbers under minimum.------ >>> MinPositive (Positive 3) <> MinPositive (Positive 7)--- MinPositive (Positive 3)-newtype MinPositive- = MinPositive- Positive- deriving (Eq, Ord, Show)---- | >>> MinPositive (Positive 5) ^. positive--- Positive 5-instance HasPositive MinPositive where- positive =- _Wrapped . positive---- | >>> MinPositive (Positive 5) ^? _Positive--- Just (Positive 5)-instance AsPositive MinPositive where- _Positive =- _Wrapped . _Positive--instance- (MinPositive ~ a) =>- Rewrapped MinPositive a---- | >>> MinPositive (Positive 5) ^. _Wrapped'--- Positive 5-instance Wrapped MinPositive where- type Unwrapped MinPositive = Positive- _Wrapped' =- iso- (\(MinPositive x) -> x)- MinPositive---- | >>> MinPositive (Positive 3) <> MinPositive (Positive 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.------ >>> toJSON (Positive 1)--- Number 1.0------ >>> toJSON (Positive 42)--- Number 42.0------ >>> encode (Positive 1)--- "1"------ >>> encode (Positive 42)--- "42"-instance ToJSON Positive where- toJSON =- toJsonPositive- toEncoding (Positive n) =- toEncoding n---- | Serialises any value with a 'HasPositive' instance to a JSON 'Value'.------ >>> toJsonPositive (Positive 42)--- Number 42.0------ >>> toJsonPositive (SumPositive (Positive 7))--- Number 7.0------ >>> toJsonPositive (MaxPositive (Positive 7))--- Number 7.0------ >>> toJsonPositive (MinPositive (Positive 3))--- Number 3.0-{-# SPECIALIZE toJsonPositive ::- Positive ->- Value- #-}-{-# INLINE toJsonPositive #-}-toJsonPositive ::- (HasPositive a) =>- a ->- Value-toJsonPositive a =- let Positive n = view positive a- in toJSON n---- | Parses a 'Positive' from a JSON number, failing on non-positive values.------ >>> 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 FromJSON Positive where- parseJSON =- parseJsonPositive---- | 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 (Positive 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 (Positive 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 (Positive 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)---- | An isomorphism between 'Natural' and 'Maybe Positive'.------ >>> Natural 0 ^. naturalPositive--- Nothing------ >>> Natural 5 ^. naturalPositive--- Just (Positive 5)------ >>> naturalPositive # Nothing--- Natural 0------ >>> naturalPositive # Just (Positive 3)--- Natural 3-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- )- )---- | >>> Natural 5 ^? _Positive--- Just (Positive 5)------ >>> Natural 0 ^? _Positive--- Nothing-instance AsPositive Natural where- _Positive =- prism'- (\(Positive n) -> Natural n)- (\(Natural n) -> if n == 0 then Nothing else Just (Positive n))---- | A prism for the value one.------ >>> one # ()--- Positive 1------ >>> Positive 1 ^? one--- Just ()------ >>> Positive 5 ^? 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 # ()---- | A prism for the successor of a positive number.------ >>> successor1 # Positive 1--- Positive 2------ >>> successor1 # Positive 4--- Positive 5------ >>> Positive 5 ^? successor1--- Just (Positive 4)------ >>> Positive 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' (Positive 1)--- Positive 2------ >>> successor1' (Positive 4)--- Positive 5-successor1' ::- Positive ->- Positive-successor1' =- (successor1 #)---- | An isomorphism between 'Natural' and 'Positive' by adding/subtracting one.------ >>> Natural 0 ^. successorW--- Positive 1------ >>> Natural 4 ^. successorW--- Positive 5------ >>> successorW # Positive 1--- Natural 0------ >>> successorW # Positive 5--- Natural 4-successorW ::- Iso'- Natural- Positive-successorW =- iso- (\(Natural n) -> Positive (n + 1))- (\(Positive n) -> Natural (n - 1))---- | Add two positive numbers.------ >>> plus1 (Positive 3) (Positive 4)--- Positive 7------ >>> plus1 (Positive 1) (Positive 1)--- Positive 2-plus1 ::- Positive ->- Positive ->- Positive-plus1 x y =- (_Wrapped # x <> (_Wrapped # y :: SumPositive)) ^. _Wrapped---- | Multiply two positive numbers.------ >>> multiply1 (Positive 2) (Positive 2)--- Positive 4------ >>> multiply1 (Positive 3) (Positive 4)--- Positive 12-multiply1 ::- Positive ->- Positive ->- Positive-multiply1 (Positive x) (Positive y) =- Positive (x * y)---- | Raise a positive number to a power.------ >>> power1 (Positive 2) (Positive 10)--- Positive 1024------ >>> power1 (Positive 5) (Positive 1)--- Positive 5-power1 ::- Positive ->- Positive ->- Positive-power1 (Positive x) (Positive y) =- Positive (x ^ y)---- | Convert to 'Positive', defaulting to one if the value is not a valid positive.------ >>> oneOr (5 :: Integer)--- Positive 5------ >>> oneOr (0 :: Integer)--- Positive 1-oneOr ::- (AsPositive a) =>- a ->- Positive-oneOr n =- fromMaybe one' (n ^? _Positive)---- | A prism from 'Natural' to 'Positive', succeeding when the natural is not zero.------ >>> notZero # Positive 5--- Natural 5------ >>> Natural 5 ^? notZero--- Just (Positive 5)------ >>> Natural 0 ^? notZero--- Nothing-notZero ::- Prism'- Natural- Positive-notZero =- prism'- (\(Positive n) -> Natural n)- (\(Natural n) -> if n == 0 then Nothing else Just (Positive n))---- | The length of a non-empty foldable structure as a 'Positive'.------ >>> length1 (1 :| [2, 3 :: Int])--- Positive 3------ >>> length1 (1 :| ([] :: [Int]))--- Positive 1-length1 ::- (Foldable1 f) =>- f a ->- Positive-length1 x =- foldMap1 (const (SumPositive one')) x ^. _Wrapped---- | Replicate a value a positive number of times into a 'NonEmpty'.------ >>> replicate1 (Positive 3) 'x'--- 'x' :| "xx"------ >>> replicate1 (Positive 1) 'x'--- 'x' :| ""-replicate1 ::- Positive ->- a ->- NonEmpty a-replicate1 n a =- take1 n (a :| repeat a)---- | Take a positive number of elements from a 'NonEmpty'.------ >>> take1 (Positive 2) (1 :| [2, 3 :: Int])--- 1 :| [2]------ >>> take1 (Positive 1) (1 :| [2, 3 :: Int])--- 1 :| []-take1 ::- Positive ->- NonEmpty a ->- NonEmpty a-take1 n (h :| t) =- h :| take (successorW # n) t---- | Drop a positive number of elements from a 'NonEmpty'.------ >>> drop1 (Positive 1) (1 :| [2, 3 :: Int])--- [2,3]------ >>> drop1 (Positive 2) (1 :| [2, 3 :: Int])--- [3]-drop1 ::- Positive ->- NonEmpty a ->- [a]-drop1 n (_ :| t) =- drop (successorW # n) t---- | Split a 'NonEmpty' at a positive index.------ >>> splitAt1 (Positive 2) (1 :| [2, 3, 4 :: Int])--- (1 :| [2],[3,4])------ >>> splitAt1 (Positive 1) (1 :| [2, 3, 4 :: Int])--- (1 :| [],[2,3,4])-splitAt1 ::- Positive ->- NonEmpty a ->- (NonEmpty a, [a])-splitAt1 n x =- (take1 n x, drop1 n x)---- | Safe indexing into a 'NonEmpty' by 'Positive'.------ >>> (1 :| []) !!! Positive 1--- Just 1------ >>> (1 :| [2, 3 :: Int]) !!! Positive 1--- Just 1------ >>> (1 :| [2, 3 :: Int]) !!! Positive 4--- Nothing-(!!!) ::- NonEmpty a ->- Positive ->- Maybe a-(h :| t) !!! n =- (h : t) !! (successorW # n)---- | Find all indices where a predicate holds in a 'NonEmpty'.------ >>> findIndices1 (== 'a') ('a' :| "bac")--- [Positive 1,Positive 3]------ >>> findIndices1 (== 'z') ('a' :| "bc")--- []-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 index where a predicate holds in a 'NonEmpty'.------ >>> findIndex1 (== 'a') ('b' :| "ana")--- Just (Positive 2)------ >>> findIndex1 (== 'z') ('b' :| "ana")--- Nothing-findIndex1 ::- (a -> Bool) ->- NonEmpty a ->- Maybe Positive-findIndex1 p =- listToMaybe . findIndices1 p---- | Find all indices of an element in a 'NonEmpty'.------ >>> elemIndices1 'a' ('a' :| "bac")--- [Positive 1,Positive 3]------ >>> elemIndices1 'z' ('a' :| "bc")--- []-elemIndices1 ::- (Eq a) =>- a ->- NonEmpty a ->- [Positive]-elemIndices1 =- findIndices1 . (==)---- | Find the first index of an element in a 'NonEmpty'.------ >>> elemIndex1 'a' ('b' :| "ana")--- Just (Positive 2)------ >>> elemIndex1 'z' ('b' :| "ana")--- Nothing-elemIndex1 ::- (Eq a) =>- a ->- NonEmpty a ->- Maybe Positive-elemIndex1 =- findIndex1 . (==)---- | Subtract two positive numbers, flooring at one.------ >>> minus1 (Positive 5) (Positive 3)--- Positive 2------ >>> minus1 (Positive 3) (Positive 5)--- Positive 1-minus1 ::- Positive ->- Positive ->- Positive-minus1 (Positive x) (Positive y) =- Positive (if x <= y then 1 else x - y)---- | An isomorphism between 'Positive' and @'NonEmpty' ()@.------ >>> Positive 3 ^. list1--- () :| [(),()]------ >>> Positive 1 ^. list1--- () :| []------ >>> list1 # (() :| [()])--- Positive 2-list1 ::- Iso'- Positive- (NonEmpty ())-list1 =- iso- (`replicate1` ())- length1---- | Convert a 'Natural' to its successor 'Positive'.------ >>> plusone (Natural 0)--- Positive 1------ >>> plusone (Natural 4)--- Positive 5-plusone ::- Natural ->- Positive-plusone =- (^. successorW)---- | Convert a 'Positive' to its predecessor 'Natural'.------ >>> minusone (Positive 1)--- Natural 0------ >>> minusone (Positive 5)--- Natural 4-minusone ::- Positive ->- Natural-minusone =- (successorW #)+ 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
@@ -1,6 +1,6 @@ {-# OPTIONS_GHC -Wall -Werror -Wno-orphans #-} -module Main where+module Main (main) where import System.Exit (exitWith) import System.Process (rawSystem)