packages feed

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 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)