natural 0.3.0.7 → 0.4.0.0
raw patch · 6 files changed
+1668/−776 lines, 6 filesdep +aesondep +processdep −QuickCheckdep −checkersdep −hedgehogPVP ok
version bump matches the API change (PVP)
Dependencies added: aeson, process
Dependencies removed: QuickCheck, checkers, hedgehog, natural, tasty, tasty-hedgehog, tasty-hunit, tasty-quickcheck, transformers
API changes (from Hackage documentation)
- Natural: instance GHC.Base.Monoid Natural.Positive
- Natural: square :: Natural -> Natural -> Natural
- Natural: square1 :: Positive -> Positive -> Positive
+ Natural: instance Data.Aeson.Types.FromJSON.FromJSON Natural.MaxNatural
+ Natural: instance Data.Aeson.Types.FromJSON.FromJSON Natural.MaxPositive
+ Natural: instance Data.Aeson.Types.FromJSON.FromJSON Natural.MinNatural
+ Natural: instance Data.Aeson.Types.FromJSON.FromJSON Natural.MinPositive
+ Natural: instance Data.Aeson.Types.FromJSON.FromJSON Natural.Natural
+ Natural: instance Data.Aeson.Types.FromJSON.FromJSON Natural.Positive
+ Natural: instance Data.Aeson.Types.FromJSON.FromJSON Natural.ProductNatural
+ Natural: instance Data.Aeson.Types.FromJSON.FromJSON Natural.SumPositive
+ Natural: instance Data.Aeson.Types.ToJSON.ToJSON Natural.MaxNatural
+ Natural: instance Data.Aeson.Types.ToJSON.ToJSON Natural.MaxPositive
+ Natural: instance Data.Aeson.Types.ToJSON.ToJSON Natural.MinNatural
+ Natural: instance Data.Aeson.Types.ToJSON.ToJSON Natural.MinPositive
+ Natural: instance Data.Aeson.Types.ToJSON.ToJSON Natural.Natural
+ Natural: instance Data.Aeson.Types.ToJSON.ToJSON Natural.Positive
+ Natural: instance Data.Aeson.Types.ToJSON.ToJSON Natural.ProductNatural
+ Natural: instance Data.Aeson.Types.ToJSON.ToJSON Natural.SumPositive
+ Natural: parseJsonNatural :: Value -> Parser Natural
+ Natural: parseJsonPositive :: Value -> Parser Positive
+ Natural: power :: Natural -> Natural -> Natural
+ Natural: power1 :: Positive -> Positive -> Positive
+ Natural: toJsonNatural :: HasNatural a => a -> Value
+ Natural: toJsonPositive :: HasPositive a => a -> Value
Files
- LICENCE +1/−1
- changelog.md +13/−0
- natural.cabal +25/−34
- src/Natural.hs +1611/−739
- test/Main.hs +18/−0
- test/Tests.hs +0/−2
LICENCE view
@@ -1,4 +1,4 @@-Copyright (c) 2020-2025, System F+Copyright (c) 2020-2026, System F All rights reserved.
changelog.md view
@@ -1,3 +1,16 @@+0.4.0.0++* Add `ToJSON` and `FromJSON` instances for `Natural`, `Positive`, and all newtype wrappers (`ProductNatural`, `MaxNatural`, `MinNatural`, `SumPositive`, `MaxPositive`, `MinPositive`).+* Add `toJsonNatural`, `parseJsonNatural`, `toJsonPositive`, `parseJsonPositive` functions.+* Add `aeson` dependency.+* Rename `square` to `power` and `square1` to `power1`.+* Fix `(!!)` which previously returned `Nothing` for all inputs.+* Fix `(!!!)` which previously returned `Nothing` for all inputs.+* Fix `multiply1` which was performing addition instead of multiplication.+* Fix `minus1` off-by-one when arguments are equal.+* Remove invalid `Monoid Positive` instance (`mempty` was `Positive 0`).+* Add Haddock documentation and doctests.+ 0.3.0.7 * Update version bounds
natural.cabal view
@@ -1,24 +1,22 @@--- documentation, see http://haskell.org/cabal/users-guide/--name: natural-version: 0.3.0.7-synopsis: Natural number+cabal-version: 2.4+name: natural+version: 0.4.0.0+synopsis: Natural number description: Natural number . <<https://logo.systemf.com.au/systemf-450x450.png>>-license: BSD3-license-file: LICENCE-author: Queensland Functional Programming Lab <oᴉ˙ldɟb@llǝʞsɐɥ>-maintainer: Queensland Functional Programming Lab <oᴉ˙ldɟb@llǝʞsɐɥ>-copyright: Copyright (C) 2020-2025 System F-category: Control-build-type: Simple-extra-source-files: changelog.md-cabal-version: >=1.10-homepage: https://github.com/system-f/natural-bug-reports: https://github.com/system-f/natural/issues-tested-with: GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.3, GHC == 8.6.1, GHC == 8.8.1, GHC == 8.6.5, GHC == 8.10.1, GHC == 9.4.8+license: BSD-3-Clause+license-file: LICENCE+author: 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+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 source-repository head type: git@@ -27,6 +25,7 @@ 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@@ -35,20 +34,12 @@ if impl(ghc<8.0.1) build-depends: semigroups >= 0.9 && < 1 -test-suite tests- build-depends: QuickCheck >= 2.9.2 && < 2.15- , base >= 4.8 && < 6- , checkers >= 0.4.6 && < 0.6- , hedgehog >= 0.5 && < 1.1- , lens >= 4.15 && < 6- , tasty >= 0.11 && < 1.3- , tasty-hunit >= 0.9 && < 0.11- , tasty-hedgehog >= 0.1 && < 1.1- , tasty-quickcheck >= 0.8.4 && < 0.11- , transformers >= 0.4.1 && < 0.6- , natural- type: exitcode-stdio-1.0- main-is: Tests.hs- hs-source-dirs: test- default-language: Haskell2010- ghc-options: -Wall+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
src/Natural.hs view
@@ -1,741 +1,1613 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}--module Natural (- Natural-, HasNatural(..)-, AsNatural(..)-, ProductNatural(..)-, MaxNatural(..)-, MinNatural(..)-, zero-, zero'-, successor-, successor'-, plus-, multiply-, square-, zeroOr-, length-, replicate-, take-, drop-, splitAt-, (!!)-, findIndices-, findIndex-, elemIndices-, elemIndex-, minus-, list-, Positive-, HasPositive(..)-, AsPositive(..)-, SumPositive(..)-, MaxPositive(..)-, MinPositive(..)-, naturalPositive-, one-, one'-, successor1-, successor1'-, successorW-, plus1-, multiply1-, square1-, oneOr-, notZero-, length1-, replicate1-, take1-, drop1-, splitAt1-, (!!!)-, findIndices1-, findIndex1-, elemIndices1-, elemIndex1-, minus1-, list1-, plusone-, minusone-) where--import Control.Applicative(Const)-import Control.Category((.), id)-import Control.Lens(Wrapped(_Wrapped', Unwrapped), Rewrapped, Prism', Lens', Iso', (^?), ( # ), (^.), _Wrapped, prism', iso)-import Control.Monad((>>=))-import Data.Bool(Bool)-import Data.Eq(Eq((==)))-import Data.Foldable(Foldable(foldl))-import Data.Function(const)-import Data.Functor.Identity(Identity)-import Data.Int(Int)-import Data.List(iterate, zip, filter, map, repeat)-import Data.List.NonEmpty(NonEmpty((:|)))-import qualified Data.List.NonEmpty as NonEmpty(iterate, zip, filter)-import Data.Maybe(listToMaybe, Maybe(Just, Nothing), fromMaybe)-import Data.Monoid(Monoid(mappend, mempty))-import Data.Ord(Ord((<)), min, max)-import Data.Semigroup(Semigroup((<>)))-import Data.Semigroup.Foldable(Foldable1(foldMap1))-import Data.Tuple(fst, snd)-import Data.Word(Word)-import Prelude(Show, Integral, Integer, (-), (+), (*), (^), fromIntegral)--newtype Natural =- Natural- Integer- deriving (Eq, Ord, Show)--instance Semigroup Natural where- Natural x <> Natural y =- Natural (x + y)--instance Monoid Natural where- mappend =- (<>)- mempty =- Natural 0--class HasNatural a where- natural ::- Lens'- a- Natural--instance HasNatural Natural where- natural =- id--class AsNatural a where- _Natural ::- Prism'- a- Natural--instance AsNatural Natural where- _Natural =- id--integralPrism ::- Integral a =>- Prism'- a- Natural-integralPrism =- prism'- (\(Natural n) -> fromIntegral n)- (\n -> if n < 0 then Nothing else Just (Natural (fromIntegral n)))--instance AsNatural Int where- _Natural =- integralPrism--instance AsNatural Integer where- _Natural =- integralPrism--instance AsNatural Word where- _Natural =- integralPrism--instance Integral a => AsNatural (Const a b) where- _Natural =- integralPrism--instance Integral a => AsNatural (Identity a) where- _Natural =- integralPrism--newtype ProductNatural =- ProductNatural- Natural- deriving (Eq, Ord, Show)--instance HasNatural ProductNatural where- natural =- _Wrapped . natural--instance AsNatural ProductNatural where- _Natural =- _Wrapped . _Natural--instance ProductNatural ~ a =>- Rewrapped ProductNatural a--instance Wrapped ProductNatural where- type Unwrapped ProductNatural = Natural- _Wrapped' =- iso- (\(ProductNatural x) -> x)- ProductNatural--instance Semigroup ProductNatural where- ProductNatural (Natural x) <> ProductNatural (Natural y) =- ProductNatural (Natural (x * y))--instance Monoid ProductNatural where- mappend =- (<>)- mempty =- ProductNatural (Natural 1)--newtype MaxNatural =- MaxNatural- Natural- deriving (Eq, Ord, Show)--instance HasNatural MaxNatural where- natural =- _Wrapped . natural--instance AsNatural MaxNatural where- _Natural =- _Wrapped . _Natural--instance MaxNatural ~ a =>- Rewrapped MaxNatural a--instance Wrapped MaxNatural where- type Unwrapped MaxNatural = Natural- _Wrapped' =- iso- (\(MaxNatural x) -> x)- MaxNatural--instance Semigroup MaxNatural where- MaxNatural (Natural x) <> MaxNatural (Natural y) =- MaxNatural (Natural (x `max` y))--newtype MinNatural =- MinNatural- Natural- deriving (Eq, Ord, Show)--instance HasNatural MinNatural where- natural =- _Wrapped . natural--instance AsNatural MinNatural where- _Natural =- _Wrapped . _Natural--instance MinNatural ~ a =>- Rewrapped MinNatural a--instance Wrapped MinNatural where- type Unwrapped MinNatural = Natural- _Wrapped' =- iso- (\(MinNatural x) -> x)- MinNatural--instance Semigroup MinNatural where- MinNatural (Natural x) <> MinNatural (Natural y) =- MinNatural (Natural (x `min` y))--zero ::- Prism'- Natural- ()-zero =- prism'- (\() -> Natural 0)- (\(Natural n) -> if n == 0 then Just () else Nothing)--zero' ::- Natural-zero' =- zero # ()--successor ::- Prism'- Natural- Natural-successor =- prism'- (\(Natural n) -> Natural (n + 1))- (\(Natural n) -> if n == 0 then Nothing else Just (Natural (n - 1)))--successor' ::- Natural- -> Natural-successor' =- (successor #)--plus ::- Natural- -> Natural- -> Natural-plus =- (<>)--multiply ::- Natural- -> Natural- -> Natural-multiply x y =- (_Wrapped # x <> (_Wrapped # y :: ProductNatural)) ^. _Wrapped--square ::- Natural- -> Natural- -> Natural-square (Natural x) (Natural y) =- Natural (x ^ y)--zeroOr ::- AsNatural a =>- a- -> Natural-zeroOr n =- fromMaybe zero' (n ^? _Natural)--length ::- Foldable f =>- f a- -> Natural-length =- foldl (const . successor') zero'--replicate ::- Natural- -> a- -> [a]-replicate n =- take n . repeat--take ::- Natural- -> [a]- -> [a]-take _ [] =- []-take n (h:t) =- case n ^? successor of- Nothing ->- []- Just p ->- h : take p t--drop ::- Natural- -> [a]- -> [a]-drop _ [] =- []-drop n (h:t) =- case n ^? successor of- Nothing ->- h:t- Just p ->- drop p t--splitAt ::- Natural- -> [a]- -> ([a], [a])-splitAt n x =- (take n x, drop n x)--(!!) ::- [a]- -> Natural- -> Maybe a-[] !! _ =- Nothing-(_:t) !! n =- (n ^? successor) >>= (t !!)--findIndices ::- (a -> Bool)- -> [a]- -> [Natural]-findIndices p x =- map snd (filter (p . fst) (zip x (iterate successor' zero')))--findIndex ::- (a -> Bool)- -> [a]- -> Maybe Natural-findIndex p =- listToMaybe . findIndices p--elemIndices ::- Eq a =>- a- -> [a]- -> [Natural]-elemIndices =- findIndices . (==)--elemIndex ::- Eq a =>- a- -> [a]- -> Maybe Natural-elemIndex =- findIndex . (==)--minus ::- Natural- -> Natural- -> Natural-minus (Natural x) (Natural y) =- Natural (if x < y then 0 else x - y)--list ::- Iso'- Natural- [()]-list =- iso- (\n -> replicate n ())- length--------newtype Positive =- Positive- Integer- deriving (Eq, Ord, Show)--instance Semigroup Positive where- Positive x <> Positive y =- Positive (x + y)--instance Monoid Positive where- mappend =- (<>)- mempty =- Positive 0--class HasPositive a where- positive ::- Lens'- a- Positive--instance HasPositive Positive where- positive =- id--class AsPositive a where- _Positive ::- Prism'- a- Positive--instance AsPositive Positive where- _Positive =- id--integralPrism1 ::- Integral a =>- Prism'- a- Positive-integralPrism1 =- prism'- (\(Positive n) -> fromIntegral n)- (\n -> if n < 1 then Nothing else Just (Positive (fromIntegral n)))--instance AsPositive Int where- _Positive =- integralPrism1--instance AsPositive Integer where- _Positive =- integralPrism1--instance AsPositive Word where- _Positive =- integralPrism1--instance Integral a => AsPositive (Const a b) where- _Positive =- integralPrism1--instance Integral a => AsPositive (Identity a) where- _Positive =- integralPrism1--newtype SumPositive =- SumPositive- Positive- deriving (Eq, Ord, Show)--instance HasPositive SumPositive where- positive =- _Wrapped . positive--instance AsPositive SumPositive where- _Positive =- _Wrapped . _Positive--instance SumPositive ~ a =>- Rewrapped SumPositive a--instance Wrapped SumPositive where- type Unwrapped SumPositive = Positive- _Wrapped' =- iso- (\(SumPositive x) -> x)- SumPositive--instance Semigroup SumPositive where- SumPositive (Positive x) <> SumPositive (Positive y) =- SumPositive (Positive (x + y))--newtype MaxPositive =- MaxPositive- Positive- deriving (Eq, Ord, Show)--instance HasPositive MaxPositive where- positive =- _Wrapped . positive--instance AsPositive MaxPositive where- _Positive =- _Wrapped . _Positive--instance MaxPositive ~ a =>- Rewrapped MaxPositive a--instance Wrapped MaxPositive where- type Unwrapped MaxPositive = Positive- _Wrapped' =- iso- (\(MaxPositive x) -> x)- MaxPositive--instance Semigroup MaxPositive where- MaxPositive (Positive x) <> MaxPositive (Positive y) =- MaxPositive (Positive (x `max` y))--newtype MinPositive =- MinPositive- Positive- deriving (Eq, Ord, Show)--instance HasPositive MinPositive where- positive =- _Wrapped . positive--instance AsPositive MinPositive where- _Positive =- _Wrapped . _Positive--instance MinPositive ~ a =>- Rewrapped MinPositive a--instance Wrapped MinPositive where- type Unwrapped MinPositive = Positive- _Wrapped' =- iso- (\(MinPositive x) -> x)- MinPositive--instance Semigroup MinPositive where- MinPositive (Positive x) <> MinPositive (Positive y) =- MinPositive (Positive (x `min` y))--naturalPositive ::- Iso' Natural (Maybe Positive)-naturalPositive =- iso- (\(Natural n) ->- if n == 0 then Nothing else Just (Positive n))- (\x -> Natural (- case x of- Nothing ->- 0- Just (Positive n) ->- n)- )--instance AsPositive Natural where- _Positive =- prism'- (\(Positive n) -> Natural n)- (\(Natural n) -> if n == 0 then Nothing else Just (Positive n))--one ::- Prism'- Positive- ()-one =- prism'- (\() -> Positive 1)- (\(Positive n) -> if n == 1 then Just () else Nothing)--one' ::- Positive-one' =- one # ()--successor1 ::- Prism'- Positive- Positive-successor1 =- prism'- (\(Positive n) -> Positive (n + 1))- (\(Positive n) -> if n == 1 then Nothing else Just (Positive (n - 1)))--successor1' ::- Positive- -> Positive-successor1' =- (successor1 #)--successorW ::- Iso'- Natural- Positive-successorW =- iso- (\(Natural n) -> Positive (n + 1))- (\(Positive n) -> Natural (n - 1))--plus1 ::- Positive- -> Positive- -> Positive-plus1 x y =- (_Wrapped # x <> (_Wrapped # y :: SumPositive)) ^. _Wrapped--multiply1 ::- Positive- -> Positive- -> Positive-multiply1 =- (<>)--square1 ::- Positive- -> Positive- -> Positive-square1 (Positive x) (Positive y) =- Positive (x ^ y)--oneOr ::- AsPositive a =>- a- -> Positive-oneOr n =- fromMaybe one' (n ^? _Positive)--notZero ::- Prism'- Natural- Positive-notZero =- prism'- (\(Positive n) -> Natural n)- (\(Natural n) -> if n == 0 then Nothing else Just (Positive n))--length1 ::- Foldable1 f =>- f a- -> Positive-length1 x =- foldMap1 (const (SumPositive one')) x ^. _Wrapped--replicate1 ::- Positive- -> a- -> NonEmpty a-replicate1 n a =- take1 n (a :| repeat a)--take1 ::- Positive- -> NonEmpty a- -> NonEmpty a-take1 n (h:|t) =- h :| take (successorW # n) t--drop1 ::- Positive- -> NonEmpty a- -> [a]-drop1 n (_:|t) =- drop (successorW # n) t--splitAt1 ::- Positive- -> NonEmpty a- -> (NonEmpty a, [a])-splitAt1 n x =- (take1 n x, drop1 n x)--(!!!) ::- NonEmpty a- -> Positive- -> Maybe a-(_:|t) !!! n =- t !! (successorW # n)--findIndices1 ::- (a -> Bool)- -> NonEmpty a- -> [Positive]-findIndices1 p x =- map snd (NonEmpty.filter (p . fst) (NonEmpty.zip x (NonEmpty.iterate successor1' one')))--findIndex1 ::- (a -> Bool)- -> NonEmpty a- -> Maybe Positive-findIndex1 p =- listToMaybe . findIndices1 p--elemIndices1 ::- Eq a =>- a- -> NonEmpty a- -> [Positive]-elemIndices1 =- findIndices1 . (==)--elemIndex1 ::- Eq a =>- a- -> NonEmpty a- -> Maybe Positive-elemIndex1 =- findIndex1 . (==)--minus1 ::- Positive- -> Positive- -> Positive-minus1 (Positive x) (Positive y) =- Positive (if x < y then 1 else x - y)--list1 ::- Iso'- Positive- (NonEmpty ())-list1 =- iso- (\n -> replicate1 n ())- length1--plusone ::- Natural- -> Positive-plusone =- (^. successorW)--minusone ::- Positive- -> Natural+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE NoImplicitPrelude #-}++module Natural+ ( Natural,+ HasNatural (..),+ AsNatural (..),+ 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 #)
+ test/Main.hs view
@@ -0,0 +1,18 @@+{-# OPTIONS_GHC -Wall -Werror -Wno-orphans #-}++module Main where++import System.Exit (exitWith)+import System.Process (rawSystem)++main :: IO ()+main =+ exitWith+ =<< rawSystem+ "cabal"+ [ "repl",+ "--with-compiler=doctest",+ "--repl-options=-w",+ "--repl-options=-Wdefault",+ "lib:natural"+ ]
− test/Tests.hs
@@ -1,2 +0,0 @@-main :: IO ()-main = putStrLn "test"