natural-0.5.0.1: src/Natural.hs

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Natural
  ( Natural,
    HasNatural (..),
    AsNatural (..),
    ProductNatural (..),
    MaxNatural (..),
    MinNatural (..),
    zero,
    zero',
    successor,
    successor',
    plus,
    multiply,
    power,
    zeroOr,
    length,
    replicate,
    take,
    drop,
    splitAt,
    (!!),
    findIndices,
    findIndex,
    elemIndices,
    elemIndex,
    minus,
    list,
    Positive,
    HasPositive (..),
    AsPositive (..),
    SumPositive (..),
    MaxPositive (..),
    MinPositive (..),
    naturalPositive,
    one,
    one',
    successor1,
    successor1',
    successorW,
    plus1,
    multiply1,
    power1,
    oneOr,
    length1,
    replicate1,
    take1,
    drop1,
    splitAt1,
    (!!!),
    findIndices1,
    findIndex1,
    elemIndices1,
    elemIndex1,
    minus1,
    list1,
    plusone,
    minusone,
    NotZero (..),
    HasNotZero (..),
    AsNotZero (..),
    SumNotZero (..),
    MaxNotZero (..),
    MinNotZero (..),
    positiveNotZero,
    negativeNotZero,
    notZeroPositive,
    notZeroInteger,
    isPositive,
    isNegative,
    negateNZ,
    absoluteNZ,
    signumNZ,
    plusNZ,
    multiplyNZ,
    notZeroOr,
    toJsonNatural,
    parseJsonNatural,
    toJsonPositive,
    parseJsonPositive,
    toJsonNotZero,
    parseJsonNotZero,
  )
where

import Control.Applicative (Const, pure)
import Control.Category (id, (.))
import Control.Lens (Iso', Lens', Prism', Rewrapped, Wrapped (Unwrapped, _Wrapped'), iso, prism', (#), (^.), (^?), _Wrapped)
import Control.Monad (fail, (>>=))
import Data.Aeson.Types
  ( FromJSON (parseJSON),
    Parser,
    ToJSON (toEncoding, toJSON),
    Value,
  )
import Data.Bool (Bool (False, True), not, (&&))
import Data.Eq (Eq ((==)))
import Data.Foldable (Foldable (foldl'))
import Data.Function (const)
import Data.Functor.Identity (Identity)
import Data.Int (Int)
import Data.List (filter, iterate, map, repeat, zip)
import Data.List.NonEmpty (NonEmpty ((:|)))
import qualified Data.List.NonEmpty as NonEmpty (filter, iterate, zip)
import Data.Maybe (Maybe (Just, Nothing), fromMaybe, listToMaybe)
import Data.Monoid (Monoid (mappend, mempty))
import Data.Ord (Ord (compare, (<), (<=)), max, min)
import Data.Semigroup (Semigroup ((<>)))
import Data.Semigroup.Foldable (Foldable1 (foldMap1))
import Data.Tuple (fst, snd)
import Data.Word (Word)
import Prelude (Integer, Integral, Show, abs, fromIntegral, negate, (*), (+), (-), (^))

-- $setup
-- >>> :set -XOverloadedStrings
-- >>> import Control.Lens((^?), (^.), (#), _Wrapped', _Wrapped)
-- >>> import Data.Aeson(encode, decode, fromJSON, Result(..))
-- >>> import Data.Aeson.Types(parse, Value(Number))
-- >>> import Data.List.NonEmpty(NonEmpty(..))
-- >>> import Data.Maybe(fromJust)
-- >>> let nat n = fromJust ((n :: Integer) ^? _Natural)
-- >>> let pos n = fromJust ((n :: Integer) ^? _Positive)

-- | A natural number (>= 0) represented as a newtype over 'Integer'.
--
-- >>> nat 0
-- Natural 0
--
-- >>> nat 5
-- Natural 5
newtype Natural
  = Natural
      Integer
  deriving (Eq, Ord, Show)

-- |
--
-- >>> nat 3 <> nat 4
-- Natural 7
--
-- >>> nat 0 <> nat 5
-- Natural 5
instance Semigroup Natural where
  Natural x <> Natural y =
    Natural (x + y)

-- |
--
-- >>> mempty :: Natural
-- Natural 0
instance Monoid Natural where
  mappend =
    (<>)
  mempty =
    Natural 0

class HasNatural a where
  natural ::
    Lens'
      a
      Natural

-- |
--
-- >>> (nat 5) ^. natural
-- Natural 5
instance HasNatural Natural where
  natural =
    id

class AsNatural a where
  _Natural ::
    Prism'
      a
      Natural

-- |
--
-- >>> _Natural # nat 5 :: Natural
-- Natural 5
instance AsNatural Natural where
  _Natural =
    id

integralPrism ::
  (Integral a) =>
  Prism'
    a
    Natural
integralPrism =
  prism'
    (\(Natural n) -> fromIntegral n)
    (\n -> if n < 0 then Nothing else Just (Natural (fromIntegral n)))

-- |
--
-- >>> (5 :: Int) ^? _Natural
-- Just (Natural 5)
--
-- >>> (-1 :: Int) ^? _Natural
-- Nothing
instance AsNatural Int where
  _Natural =
    integralPrism

-- |
--
-- >>> (42 :: Integer) ^? _Natural
-- Just (Natural 42)
--
-- >>> (-1 :: Integer) ^? _Natural
-- Nothing
instance AsNatural Integer where
  _Natural =
    integralPrism

-- |
--
-- >>> (7 :: Word) ^? _Natural
-- Just (Natural 7)
instance AsNatural Word where
  _Natural =
    integralPrism

-- |
--
-- >>> import Data.Functor.Identity(Identity(..))
-- >>> import Control.Applicative(Const(..))
-- >>> (Const 5 :: Const Integer Bool) ^? _Natural
-- Just (Natural 5)
instance (Integral a) => AsNatural (Const a b) where
  _Natural =
    integralPrism

-- |
--
-- >>> import Data.Functor.Identity(Identity(..))
-- >>> (Identity 5 :: Identity Integer) ^? _Natural
-- Just (Natural 5)
instance (Integral a) => AsNatural (Identity a) where
  _Natural =
    integralPrism

-- |
--
-- >>> ProductNatural (nat 3) <> ProductNatural (nat 4)
-- ProductNatural (Natural 12)
--
-- >>> mempty :: ProductNatural
-- ProductNatural (Natural 1)
newtype ProductNatural
  = ProductNatural
      Natural
  deriving (Eq, Ord, Show)

-- |
--
-- >>> ProductNatural (nat 5) ^. natural
-- Natural 5
instance HasNatural ProductNatural where
  natural =
    _Wrapped . natural

-- |
--
-- >>> ProductNatural (nat 5) ^? _Natural
-- Just (Natural 5)
instance AsNatural ProductNatural where
  _Natural =
    _Wrapped . _Natural

instance
  (ProductNatural ~ a) =>
  Rewrapped ProductNatural a

-- |
--
-- >>> ProductNatural (nat 5) ^. _Wrapped'
-- Natural 5
instance Wrapped ProductNatural where
  type Unwrapped ProductNatural = Natural
  _Wrapped' =
    iso
      (\(ProductNatural x) -> x)
      ProductNatural

-- |
--
-- >>> ProductNatural (nat 3) <> ProductNatural (nat 4)
-- ProductNatural (Natural 12)
instance Semigroup ProductNatural where
  ProductNatural (Natural x) <> ProductNatural (Natural y) =
    ProductNatural (Natural (x * y))

-- |
--
-- >>> mempty :: ProductNatural
-- ProductNatural (Natural 1)
instance Monoid ProductNatural where
  mappend =
    (<>)
  mempty =
    ProductNatural (Natural 1)

-- |
--
-- >>> MaxNatural (nat 3) <> MaxNatural (nat 7)
-- MaxNatural (Natural 7)
newtype MaxNatural
  = MaxNatural
      Natural
  deriving (Eq, Ord, Show)

-- |
--
-- >>> MaxNatural (nat 7) ^. natural
-- Natural 7
instance HasNatural MaxNatural where
  natural =
    _Wrapped . natural

-- |
--
-- >>> MaxNatural (nat 7) ^? _Natural
-- Just (Natural 7)
instance AsNatural MaxNatural where
  _Natural =
    _Wrapped . _Natural

instance
  (MaxNatural ~ a) =>
  Rewrapped MaxNatural a

-- |
--
-- >>> MaxNatural (nat 7) ^. _Wrapped'
-- Natural 7
instance Wrapped MaxNatural where
  type Unwrapped MaxNatural = Natural
  _Wrapped' =
    iso
      (\(MaxNatural x) -> x)
      MaxNatural

-- |
--
-- >>> MaxNatural (nat 3) <> MaxNatural (nat 7)
-- MaxNatural (Natural 7)
instance Semigroup MaxNatural where
  MaxNatural (Natural x) <> MaxNatural (Natural y) =
    MaxNatural (Natural (x `max` y))

-- |
--
-- >>> MinNatural (nat 3) <> MinNatural (nat 7)
-- MinNatural (Natural 3)
newtype MinNatural
  = MinNatural
      Natural
  deriving (Eq, Ord, Show)

-- |
--
-- >>> MinNatural (nat 3) ^. natural
-- Natural 3
instance HasNatural MinNatural where
  natural =
    _Wrapped . natural

-- |
--
-- >>> MinNatural (nat 3) ^? _Natural
-- Just (Natural 3)
instance AsNatural MinNatural where
  _Natural =
    _Wrapped . _Natural

instance
  (MinNatural ~ a) =>
  Rewrapped MinNatural a

-- |
--
-- >>> MinNatural (nat 3) ^. _Wrapped'
-- Natural 3
instance Wrapped MinNatural where
  type Unwrapped MinNatural = Natural
  _Wrapped' =
    iso
      (\(MinNatural x) -> x)
      MinNatural

-- |
--
-- >>> MinNatural (nat 3) <> MinNatural (nat 7)
-- MinNatural (Natural 3)
instance Semigroup MinNatural where
  MinNatural (Natural x) <> MinNatural (Natural y) =
    MinNatural (Natural (x `min` y))

-- | Serialises a 'Natural' to a JSON number.
--
-- >>> fromJSON (Number 0) :: Result Natural
-- Success (Natural 0)
--
-- >>> fromJSON (Number 42) :: Result Natural
-- Success (Natural 42)
--
-- >>> decode "42" :: Maybe Natural
-- Just (Natural 42)
--
-- >>> decode "0" :: Maybe Natural
-- Just (Natural 0)
--
-- >>> decode "-1" :: Maybe Natural
-- Nothing
instance ToJSON Natural where
  toJSON =
    toJsonNatural
  toEncoding (Natural n) =
    toEncoding n

-- | Parses a 'Natural' from a JSON number, failing on negative values.
--
-- >>> decode "0" :: Maybe Natural
-- Just (Natural 0)
instance FromJSON Natural where
  parseJSON =
    parseJsonNatural

-- | Serialises any value with a 'HasNatural' instance to a JSON 'Value'.
--
-- >>> toJsonNatural (nat 42)
-- Number 42.0
--
-- >>> toJsonNatural (ProductNatural (nat 12))
-- Number 12.0
--
-- >>> toJsonNatural (MaxNatural (nat 7))
-- Number 7.0
--
-- >>> toJsonNatural (MinNatural (nat 3))
-- Number 3.0
{-# SPECIALIZE toJsonNatural ::
  Natural ->
  Value
  #-}
{-# INLINE toJsonNatural #-}
toJsonNatural ::
  (HasNatural a) =>
  a ->
  Value
toJsonNatural a =
  let Natural n = a ^. natural
   in toJSON n

-- | Parses a JSON value into a 'Natural', failing on negative values.
--
-- >>> parse parseJsonNatural (Number 42)
-- Success (Natural 42)
--
-- >>> parse parseJsonNatural (Number 0)
-- Success (Natural 0)
--
-- >>> parse parseJsonNatural (Number (-1))
-- Error "parse failed, Natural: expected non-negative integer"
{-# INLINE parseJsonNatural #-}
parseJsonNatural ::
  Value ->
  Parser Natural
parseJsonNatural v =
  parseJSON v >>= \n ->
    if n < 0
      then fail "parse failed, Natural: expected non-negative integer"
      else pure (Natural n)

-- | Serialises a 'ProductNatural' to a JSON number.
--
-- >>> encode (ProductNatural (nat 12))
-- "12"
instance ToJSON ProductNatural where
  toJSON =
    toJsonNatural
  toEncoding (ProductNatural n) =
    toEncoding n

-- | Parses a 'ProductNatural' from a JSON number, failing on negative values.
--
-- >>> decode "12" :: Maybe ProductNatural
-- Just (ProductNatural (Natural 12))
--
-- >>> decode "-1" :: Maybe ProductNatural
-- Nothing
instance FromJSON ProductNatural where
  parseJSON v =
    parseJsonNatural v >>= \n -> pure (ProductNatural n)

-- | Serialises a 'MaxNatural' to a JSON number.
--
-- >>> encode (MaxNatural (nat 7))
-- "7"
instance ToJSON MaxNatural where
  toJSON =
    toJsonNatural
  toEncoding (MaxNatural n) =
    toEncoding n

-- | Parses a 'MaxNatural' from a JSON number, failing on negative values.
--
-- >>> decode "7" :: Maybe MaxNatural
-- Just (MaxNatural (Natural 7))
--
-- >>> decode "-1" :: Maybe MaxNatural
-- Nothing
instance FromJSON MaxNatural where
  parseJSON v =
    parseJsonNatural v >>= \n -> pure (MaxNatural n)

-- | Serialises a 'MinNatural' to a JSON number.
--
-- >>> encode (MinNatural (nat 3))
-- "3"
instance ToJSON MinNatural where
  toJSON =
    toJsonNatural
  toEncoding (MinNatural n) =
    toEncoding n

-- | Parses a 'MinNatural' from a JSON number, failing on negative values.
--
-- >>> decode "3" :: Maybe MinNatural
-- Just (MinNatural (Natural 3))
--
-- >>> decode "-1" :: Maybe MinNatural
-- Nothing
instance FromJSON MinNatural where
  parseJSON v =
    parseJsonNatural v >>= \n -> pure (MinNatural n)

-- | Prism matching zero.
--
-- >>> zero # ()
-- Natural 0
--
-- >>> nat 0 ^? zero
-- Just ()
--
-- >>> nat 3 ^? zero
-- Nothing
zero ::
  Prism'
    Natural
    ()
zero =
  prism'
    (\() -> Natural 0)
    (\(Natural n) -> if n == 0 then Just () else Nothing)

-- | The zero natural number.
--
-- >>> zero'
-- Natural 0
zero' ::
  Natural
zero' =
  zero # ()

-- | Prism between a natural and its predecessor.
--
-- >>> successor # nat 0
-- Natural 1
--
-- >>> successor # nat 4
-- Natural 5
--
-- >>> nat 5 ^? successor
-- Just (Natural 4)
--
-- >>> nat 0 ^? successor
-- Nothing
successor ::
  Prism'
    Natural
    Natural
successor =
  prism'
    (\(Natural n) -> Natural (n + 1))
    (\(Natural n) -> if n == 0 then Nothing else Just (Natural (n - 1)))

-- | The successor of a natural number.
--
-- >>> successor' (nat 0)
-- Natural 1
--
-- >>> successor' (nat 4)
-- Natural 5
successor' ::
  Natural ->
  Natural
successor' =
  (successor #)

-- | Add two natural numbers.
--
-- >>> plus (nat 3) (nat 4)
-- Natural 7
--
-- >>> plus (nat 0) (nat 5)
-- Natural 5
plus ::
  Natural ->
  Natural ->
  Natural
plus =
  (<>)

-- | Multiply two natural numbers.
--
-- >>> multiply (nat 3) (nat 4)
-- Natural 12
--
-- >>> multiply (nat 0) (nat 5)
-- Natural 0
multiply ::
  Natural ->
  Natural ->
  Natural
multiply x y =
  (_Wrapped # x <> (_Wrapped # y :: ProductNatural)) ^. _Wrapped

-- | Raise a natural to a natural power.
--
-- >>> power (nat 2) (nat 10)
-- Natural 1024
--
-- >>> power (nat 3) (nat 0)
-- Natural 1
power ::
  Natural ->
  Natural ->
  Natural
power (Natural x) (Natural y) =
  Natural (x ^ y)

-- | Return the natural if the prism matches, otherwise zero.
--
-- >>> zeroOr (5 :: Integer)
-- Natural 5
--
-- >>> zeroOr (-1 :: Integer)
-- Natural 0
zeroOr ::
  (AsNatural a) =>
  a ->
  Natural
zeroOr n =
  fromMaybe zero' (n ^? _Natural)

-- | Count the elements in a foldable structure.
--
-- >>> length [1,2,3 :: Int]
-- Natural 3
--
-- >>> length ([] :: [Int])
-- Natural 0
length ::
  (Foldable f) =>
  f a ->
  Natural
length =
  foldl' (const . successor') zero'

-- | Replicate a value a natural number of times.
--
-- >>> replicate (nat 3) 'x'
-- "xxx"
--
-- >>> replicate (nat 0) 'x'
-- ""
replicate ::
  Natural ->
  a ->
  [a]
replicate n =
  take n . repeat

-- | Take the first n elements.
--
-- >>> take (nat 2) [1,2,3,4,5 :: Int]
-- [1,2]
--
-- >>> take (nat 0) [1,2,3 :: Int]
-- []
--
-- >>> take (nat 5) [1,2 :: Int]
-- [1,2]
take ::
  Natural ->
  [a] ->
  [a]
take _ [] =
  []
take n (h : t) =
  case n ^? successor of
    Nothing ->
      []
    Just p ->
      h : take p t

-- | Drop the first n elements.
--
-- >>> drop (nat 2) [1,2,3,4,5 :: Int]
-- [3,4,5]
--
-- >>> drop (nat 0) [1,2,3 :: Int]
-- [1,2,3]
--
-- >>> drop (nat 5) [1,2 :: Int]
-- []
drop ::
  Natural ->
  [a] ->
  [a]
drop _ [] =
  []
drop n (h : t) =
  case n ^? successor of
    Nothing ->
      h : t
    Just p ->
      drop p t

-- | Split a list at position n.
--
-- >>> splitAt (nat 2) [1,2,3,4,5 :: Int]
-- ([1,2],[3,4,5])
splitAt ::
  Natural ->
  [a] ->
  ([a], [a])
splitAt n x =
  (take n x, drop n x)

-- | Index into a list.
--
-- >>> [10,20,30 :: Int] !! nat 0
-- Just 10
--
-- >>> [10,20,30 :: Int] !! nat 2
-- Just 30
--
-- >>> [10,20,30 :: Int] !! nat 5
-- Nothing
--
-- >>> ([] :: [Int]) !! nat 0
-- Nothing
(!!) ::
  [a] ->
  Natural ->
  Maybe a
[] !! _ =
  Nothing
(h : t) !! n =
  case n ^? successor of
    Nothing ->
      Just h
    Just p ->
      t !! p

-- | Find all indices where the predicate holds.
--
-- >>> findIndices (== 'a') "abacad"
-- [Natural 0,Natural 2,Natural 4]
--
-- >>> findIndices (== 'z') "abacad"
-- []
findIndices ::
  (a -> Bool) ->
  [a] ->
  [Natural]
findIndices p x =
  map snd (filter (p . fst) (zip x (iterate successor' zero')))

-- | Find the first index where the predicate holds.
--
-- >>> findIndex (== 'c') "abcde"
-- Just (Natural 2)
--
-- >>> findIndex (== 'z') "abcde"
-- Nothing
findIndex ::
  (a -> Bool) ->
  [a] ->
  Maybe Natural
findIndex p =
  listToMaybe . findIndices p

-- | Find all indices of a given element.
--
-- >>> elemIndices 'a' "banana"
-- [Natural 1,Natural 3,Natural 5]
elemIndices ::
  (Eq a) =>
  a ->
  [a] ->
  [Natural]
elemIndices =
  findIndices . (==)

-- | Find the first index of a given element.
--
-- >>> elemIndex 'n' "banana"
-- Just (Natural 2)
--
-- >>> elemIndex 'z' "banana"
-- Nothing
elemIndex ::
  (Eq a) =>
  a ->
  [a] ->
  Maybe Natural
elemIndex =
  findIndex . (==)

-- | Subtract two naturals, flooring at zero.
--
-- >>> minus (nat 5) (nat 3)
-- Natural 2
--
-- >>> minus (nat 3) (nat 5)
-- Natural 0
--
-- >>> minus (nat 3) (nat 3)
-- Natural 0
minus ::
  Natural ->
  Natural ->
  Natural
minus (Natural x) (Natural y) =
  Natural (if x < y then 0 else x - y)

-- | Iso between a natural and a list of units.
--
-- >>> nat 3 ^. list
-- [(),(),()]
--
-- >>> length (nat 3 ^. list)
-- Natural 3
list ::
  Iso'
    Natural
    [()]
list =
  iso
    (`replicate` ())
    length

----

-- | A positive integer (>= 1). Semigroup is multiplication.
--
-- >>> pos 3
-- Positive 3
--
-- >>> pos 3 <> pos 4
-- Positive 12
newtype Positive
  = Positive
      Integer
  deriving (Eq, Ord, Show)

-- |
--
-- >>> pos 3 <> pos 4
-- Positive 12
instance Semigroup Positive where
  Positive x <> Positive y =
    Positive (x * y)

class HasPositive a where
  positive ::
    Lens'
      a
      Positive

-- |
--
-- >>> pos 5 ^. positive
-- Positive 5
instance HasPositive Positive where
  positive =
    id

class AsPositive a where
  _Positive ::
    Prism'
      a
      Positive

-- |
--
-- >>> _Positive # pos 5 :: Positive
-- Positive 5
instance AsPositive Positive where
  _Positive =
    id

integralPrism1 ::
  (Integral a) =>
  Prism'
    a
    Positive
integralPrism1 =
  prism'
    (\(Positive n) -> fromIntegral n)
    (\n -> if n < 1 then Nothing else Just (Positive (fromIntegral n)))

-- |
--
-- >>> (5 :: Int) ^? _Positive
-- Just (Positive 5)
--
-- >>> (0 :: Int) ^? _Positive
-- Nothing
instance AsPositive Int where
  _Positive =
    integralPrism1

-- |
--
-- >>> (42 :: Integer) ^? _Positive
-- Just (Positive 42)
--
-- >>> (0 :: Integer) ^? _Positive
-- Nothing
instance AsPositive Integer where
  _Positive =
    integralPrism1

-- |
--
-- >>> (7 :: Word) ^? _Positive
-- Just (Positive 7)
--
-- >>> (0 :: Word) ^? _Positive
-- Nothing
instance AsPositive Word where
  _Positive =
    integralPrism1

-- |
--
-- >>> import Control.Applicative(Const(..))
-- >>> (Const 5 :: Const Integer Bool) ^? _Positive
-- Just (Positive 5)
instance (Integral a) => AsPositive (Const a b) where
  _Positive =
    integralPrism1

-- |
--
-- >>> import Data.Functor.Identity(Identity(..))
-- >>> (Identity 5 :: Identity Integer) ^? _Positive
-- Just (Positive 5)
instance (Integral a) => AsPositive (Identity a) where
  _Positive =
    integralPrism1

-- |
--
-- >>> SumPositive (pos 3) <> SumPositive (pos 4)
-- SumPositive (Positive 7)
newtype SumPositive
  = SumPositive
      Positive
  deriving (Eq, Ord, Show)

-- |
--
-- >>> SumPositive (pos 5) ^. positive
-- Positive 5
instance HasPositive SumPositive where
  positive =
    _Wrapped . positive

-- |
--
-- >>> SumPositive (pos 5) ^? _Positive
-- Just (Positive 5)
instance AsPositive SumPositive where
  _Positive =
    _Wrapped . _Positive

instance
  (SumPositive ~ a) =>
  Rewrapped SumPositive a

-- |
--
-- >>> SumPositive (pos 5) ^. _Wrapped'
-- Positive 5
instance Wrapped SumPositive where
  type Unwrapped SumPositive = Positive
  _Wrapped' =
    iso
      (\(SumPositive x) -> x)
      SumPositive

-- |
--
-- >>> SumPositive (pos 3) <> SumPositive (pos 4)
-- SumPositive (Positive 7)
instance Semigroup SumPositive where
  SumPositive (Positive x) <> SumPositive (Positive y) =
    SumPositive (Positive (x + y))

-- |
--
-- >>> MaxPositive (pos 3) <> MaxPositive (pos 7)
-- MaxPositive (Positive 7)
newtype MaxPositive
  = MaxPositive
      Positive
  deriving (Eq, Ord, Show)

-- |
--
-- >>> MaxPositive (pos 7) ^. positive
-- Positive 7
instance HasPositive MaxPositive where
  positive =
    _Wrapped . positive

-- |
--
-- >>> MaxPositive (pos 7) ^? _Positive
-- Just (Positive 7)
instance AsPositive MaxPositive where
  _Positive =
    _Wrapped . _Positive

instance
  (MaxPositive ~ a) =>
  Rewrapped MaxPositive a

-- |
--
-- >>> MaxPositive (pos 7) ^. _Wrapped'
-- Positive 7
instance Wrapped MaxPositive where
  type Unwrapped MaxPositive = Positive
  _Wrapped' =
    iso
      (\(MaxPositive x) -> x)
      MaxPositive

-- |
--
-- >>> MaxPositive (pos 3) <> MaxPositive (pos 7)
-- MaxPositive (Positive 7)
instance Semigroup MaxPositive where
  MaxPositive (Positive x) <> MaxPositive (Positive y) =
    MaxPositive (Positive (x `max` y))

-- |
--
-- >>> MinPositive (pos 3) <> MinPositive (pos 7)
-- MinPositive (Positive 3)
newtype MinPositive
  = MinPositive
      Positive
  deriving (Eq, Ord, Show)

-- |
--
-- >>> MinPositive (pos 3) ^. positive
-- Positive 3
instance HasPositive MinPositive where
  positive =
    _Wrapped . positive

-- |
--
-- >>> MinPositive (pos 3) ^? _Positive
-- Just (Positive 3)
instance AsPositive MinPositive where
  _Positive =
    _Wrapped . _Positive

instance
  (MinPositive ~ a) =>
  Rewrapped MinPositive a

-- |
--
-- >>> MinPositive (pos 3) ^. _Wrapped'
-- Positive 3
instance Wrapped MinPositive where
  type Unwrapped MinPositive = Positive
  _Wrapped' =
    iso
      (\(MinPositive x) -> x)
      MinPositive

-- |
--
-- >>> MinPositive (pos 3) <> MinPositive (pos 7)
-- MinPositive (Positive 3)
instance Semigroup MinPositive where
  MinPositive (Positive x) <> MinPositive (Positive y) =
    MinPositive (Positive (x `min` y))

-- | Serialises a 'Positive' to a JSON number.
--
-- >>> fromJSON (Number 1) :: Result Positive
-- Success (Positive 1)
--
-- >>> fromJSON (Number 42) :: Result Positive
-- Success (Positive 42)
--
-- >>> decode "42" :: Maybe Positive
-- Just (Positive 42)
--
-- >>> decode "1" :: Maybe Positive
-- Just (Positive 1)
--
-- >>> decode "0" :: Maybe Positive
-- Nothing
--
-- >>> decode "-1" :: Maybe Positive
-- Nothing
instance ToJSON Positive where
  toJSON =
    toJsonPositive
  toEncoding (Positive n) =
    toEncoding n

-- | Parses a 'Positive' from a JSON number, failing on non-positive values.
--
-- >>> decode "1" :: Maybe Positive
-- Just (Positive 1)
instance FromJSON Positive where
  parseJSON =
    parseJsonPositive

-- | Serialises any value with a 'HasPositive' instance to a JSON 'Value'.
--
-- >>> toJsonPositive (pos 42)
-- Number 42.0
--
-- >>> toJsonPositive (SumPositive (pos 7))
-- Number 7.0
--
-- >>> toJsonPositive (MaxPositive (pos 7))
-- Number 7.0
--
-- >>> toJsonPositive (MinPositive (pos 3))
-- Number 3.0
{-# SPECIALIZE toJsonPositive ::
  Positive ->
  Value
  #-}
{-# INLINE toJsonPositive #-}
toJsonPositive ::
  (HasPositive a) =>
  a ->
  Value
toJsonPositive a =
  let Positive n = a ^. positive
   in toJSON n

-- | Parses a JSON value into a 'Positive', failing on non-positive values.
--
-- >>> parse parseJsonPositive (Number 42)
-- Success (Positive 42)
--
-- >>> parse parseJsonPositive (Number 1)
-- Success (Positive 1)
--
-- >>> parse parseJsonPositive (Number 0)
-- Error "parse failed, Positive: expected positive integer"
--
-- >>> parse parseJsonPositive (Number (-1))
-- Error "parse failed, Positive: expected positive integer"
{-# INLINE parseJsonPositive #-}
parseJsonPositive ::
  Value ->
  Parser Positive
parseJsonPositive v =
  parseJSON v >>= \n ->
    if n < 1
      then fail "parse failed, Positive: expected positive integer"
      else pure (Positive n)

-- | Serialises a 'SumPositive' to a JSON number.
--
-- >>> encode (SumPositive (pos 7))
-- "7"
instance ToJSON SumPositive where
  toJSON =
    toJsonPositive
  toEncoding (SumPositive n) =
    toEncoding n

-- | Parses a 'SumPositive' from a JSON number, failing on non-positive values.
--
-- >>> decode "7" :: Maybe SumPositive
-- Just (SumPositive (Positive 7))
--
-- >>> decode "0" :: Maybe SumPositive
-- Nothing
instance FromJSON SumPositive where
  parseJSON v =
    parseJsonPositive v >>= \n -> pure (SumPositive n)

-- | Serialises a 'MaxPositive' to a JSON number.
--
-- >>> encode (MaxPositive (pos 7))
-- "7"
instance ToJSON MaxPositive where
  toJSON =
    toJsonPositive
  toEncoding (MaxPositive n) =
    toEncoding n

-- | Parses a 'MaxPositive' from a JSON number, failing on non-positive values.
--
-- >>> decode "7" :: Maybe MaxPositive
-- Just (MaxPositive (Positive 7))
--
-- >>> decode "0" :: Maybe MaxPositive
-- Nothing
instance FromJSON MaxPositive where
  parseJSON v =
    parseJsonPositive v >>= \n -> pure (MaxPositive n)

-- | Serialises a 'MinPositive' to a JSON number.
--
-- >>> encode (MinPositive (pos 3))
-- "3"
instance ToJSON MinPositive where
  toJSON =
    toJsonPositive
  toEncoding (MinPositive n) =
    toEncoding n

-- | Parses a 'MinPositive' from a JSON number, failing on non-positive values.
--
-- >>> decode "3" :: Maybe MinPositive
-- Just (MinPositive (Positive 3))
--
-- >>> decode "0" :: Maybe MinPositive
-- Nothing
instance FromJSON MinPositive where
  parseJSON v =
    parseJsonPositive v >>= \n -> pure (MinPositive n)

-- | Iso between a natural and maybe a positive.
--
-- >>> nat 5 ^. naturalPositive
-- Just (Positive 5)
--
-- >>> nat 0 ^. naturalPositive
-- Nothing
naturalPositive ::
  Iso' Natural (Maybe Positive)
naturalPositive =
  iso
    ( \(Natural n) ->
        if n == 0 then Nothing else Just (Positive n)
    )
    ( \x ->
        Natural
          ( case x of
              Nothing ->
                0
              Just (Positive n) ->
                n
          )
    )

-- |
--
-- >>> nat 5 ^? _Positive
-- Just (Positive 5)
--
-- >>> nat 0 ^? _Positive
-- Nothing
instance AsPositive Natural where
  _Positive =
    prism'
      (\(Positive n) -> Natural n)
      (\(Natural n) -> if n == 0 then Nothing else Just (Positive n))

-- | Prism matching one.
--
-- >>> one # ()
-- Positive 1
--
-- >>> pos 1 ^? one
-- Just ()
--
-- >>> pos 3 ^? one
-- Nothing
one ::
  Prism'
    Positive
    ()
one =
  prism'
    (\() -> Positive 1)
    (\(Positive n) -> if n == 1 then Just () else Nothing)

-- | The positive number one.
--
-- >>> one'
-- Positive 1
one' ::
  Positive
one' =
  one # ()

-- | Prism between a positive and its predecessor.
--
-- >>> successor1 # pos 1
-- Positive 2
--
-- >>> successor1 # pos 4
-- Positive 5
--
-- >>> pos 5 ^? successor1
-- Just (Positive 4)
--
-- >>> pos 1 ^? successor1
-- Nothing
successor1 ::
  Prism'
    Positive
    Positive
successor1 =
  prism'
    (\(Positive n) -> Positive (n + 1))
    (\(Positive n) -> if n == 1 then Nothing else Just (Positive (n - 1)))

-- | The successor of a positive number.
--
-- >>> successor1' (pos 1)
-- Positive 2
--
-- >>> successor1' (pos 4)
-- Positive 5
successor1' ::
  Positive ->
  Positive
successor1' =
  (successor1 #)

-- | Iso between natural and positive (n <-> n+1).
--
-- >>> nat 0 ^. successorW
-- Positive 1
--
-- >>> nat 4 ^. successorW
-- Positive 5
--
-- >>> successorW # pos 1
-- Natural 0
--
-- >>> successorW # pos 5
-- Natural 4
successorW ::
  Iso'
    Natural
    Positive
successorW =
  iso
    (\(Natural n) -> Positive (n + 1))
    (\(Positive n) -> Natural (n - 1))

-- | Add two positive numbers.
--
-- >>> plus1 (pos 3) (pos 4)
-- Positive 7
plus1 ::
  Positive ->
  Positive ->
  Positive
plus1 x y =
  (_Wrapped # x <> (_Wrapped # y :: SumPositive)) ^. _Wrapped

-- | Multiply two positive numbers.
--
-- >>> multiply1 (pos 3) (pos 4)
-- Positive 12
multiply1 ::
  Positive ->
  Positive ->
  Positive
multiply1 =
  (<>)

-- | Raise a positive to a positive power.
--
-- >>> power1 (pos 2) (pos 10)
-- Positive 1024
--
-- >>> power1 (pos 3) (pos 2)
-- Positive 9
power1 ::
  Positive ->
  Positive ->
  Positive
power1 (Positive x) (Positive y) =
  Positive (x ^ y)

-- | Return the positive if the prism matches, otherwise one.
--
-- >>> oneOr (5 :: Integer)
-- Positive 5
--
-- >>> oneOr (0 :: Integer)
-- Positive 1
oneOr ::
  (AsPositive a) =>
  a ->
  Positive
oneOr n =
  fromMaybe one' (n ^? _Positive)

-- | Count the elements in a non-empty foldable.
--
-- >>> length1 ('a' :| "bc")
-- Positive 3
--
-- >>> length1 ('x' :| "")
-- Positive 1
length1 ::
  (Foldable1 f) =>
  f a ->
  Positive
length1 x =
  foldMap1 (const (SumPositive one')) x ^. _Wrapped

-- | Replicate a value a positive number of times.
--
-- >>> replicate1 (pos 3) 'x'
-- 'x' :| "xx"
--
-- >>> replicate1 (pos 1) 'y'
-- 'y' :| ""
replicate1 ::
  Positive ->
  a ->
  NonEmpty a
replicate1 n a =
  take1 n (a :| repeat a)

-- | Take the first n elements from a non-empty list.
--
-- >>> take1 (pos 2) (1 :| [2,3,4,5 :: Int])
-- 1 :| [2]
--
-- >>> take1 (pos 1) (1 :| [2,3 :: Int])
-- 1 :| []
take1 ::
  Positive ->
  NonEmpty a ->
  NonEmpty a
take1 n (h :| t) =
  h :| take (successorW # n) t

-- | Drop the first n elements from a non-empty list.
--
-- >>> drop1 (pos 2) (1 :| [2,3,4,5 :: Int])
-- [3,4,5]
--
-- >>> drop1 (pos 1) (1 :| [2,3 :: Int])
-- [2,3]
drop1 ::
  Positive ->
  NonEmpty a ->
  [a]
drop1 n (_ :| t) =
  drop (successorW # n) t

-- | Split a non-empty list at position n.
--
-- >>> splitAt1 (pos 2) (1 :| [2,3,4,5 :: Int])
-- (1 :| [2],[3,4,5])
splitAt1 ::
  Positive ->
  NonEmpty a ->
  (NonEmpty a, [a])
splitAt1 n x =
  (take1 n x, drop1 n x)

-- | Index into a non-empty list (1-based).
--
-- >>> (10 :| [20,30 :: Int]) !!! pos 1
-- Just 10
--
-- >>> (10 :| [20,30 :: Int]) !!! pos 3
-- Just 30
--
-- >>> (10 :| [20,30 :: Int]) !!! pos 5
-- Nothing
(!!!) ::
  NonEmpty a ->
  Positive ->
  Maybe a
(h :| t) !!! n =
  (h : t) !! (successorW # n)

-- | Find all 1-based indices where the predicate holds.
--
-- >>> findIndices1 (== 'a') ('a' :| "baca")
-- [Positive 1,Positive 3,Positive 5]
findIndices1 ::
  (a -> Bool) ->
  NonEmpty a ->
  [Positive]
findIndices1 p x =
  map snd (NonEmpty.filter (p . fst) (NonEmpty.zip x (NonEmpty.iterate successor1' one')))

-- | Find the first 1-based index where the predicate holds.
--
-- >>> findIndex1 (== 'c') ('a' :| "bcde")
-- Just (Positive 3)
--
-- >>> findIndex1 (== 'z') ('a' :| "bcde")
-- Nothing
findIndex1 ::
  (a -> Bool) ->
  NonEmpty a ->
  Maybe Positive
findIndex1 p =
  listToMaybe . findIndices1 p

-- | Find all 1-based indices of a given element.
--
-- >>> elemIndices1 'a' ('b' :| "anana")
-- [Positive 2,Positive 4,Positive 6]
elemIndices1 ::
  (Eq a) =>
  a ->
  NonEmpty a ->
  [Positive]
elemIndices1 =
  findIndices1 . (==)

-- | Find the first 1-based index of a given element.
--
-- >>> elemIndex1 'n' ('b' :| "anana")
-- Just (Positive 3)
--
-- >>> elemIndex1 'z' ('b' :| "anana")
-- Nothing
elemIndex1 ::
  (Eq a) =>
  a ->
  NonEmpty a ->
  Maybe Positive
elemIndex1 =
  findIndex1 . (==)

-- | Subtract two positives, flooring at one.
--
-- >>> minus1 (pos 5) (pos 3)
-- Positive 2
--
-- >>> minus1 (pos 3) (pos 5)
-- Positive 1
--
-- >>> minus1 (pos 3) (pos 3)
-- Positive 1
minus1 ::
  Positive ->
  Positive ->
  Positive
minus1 (Positive x) (Positive y) =
  Positive (if x <= y then 1 else x - y)

-- | Iso between a positive and a non-empty list of units.
--
-- >>> pos 3 ^. list1
-- () :| [(),()]
--
-- >>> length1 (pos 3 ^. list1)
-- Positive 3
list1 ::
  Iso'
    Positive
    (NonEmpty ())
list1 =
  iso
    (`replicate1` ())
    length1

-- | Convert natural to positive by adding one.
--
-- >>> plusone (nat 0)
-- Positive 1
--
-- >>> plusone (nat 4)
-- Positive 5
plusone ::
  Natural ->
  Positive
plusone =
  (^. successorW)

-- | Convert positive to natural by subtracting one.
--
-- >>> minusone (pos 1)
-- Natural 0
--
-- >>> minusone (pos 5)
-- Natural 4
minusone ::
  Positive ->
  Natural
minusone =
  (successorW #)

----

-- | A non-zero integer. 'True' for positive, 'False' for negative.
-- The 'Positive' gives the absolute value.
--
-- >>> NotZero True (pos 3)
-- NotZero True (Positive 3)
--
-- >>> NotZero False (pos 7)
-- NotZero False (Positive 7)
data NotZero
  = NotZero
      Bool
      Positive
  deriving (Eq, Show)

-- |
--
-- >>> compare (NotZero True (pos 3)) (NotZero True (pos 5))
-- LT
--
-- >>> compare (NotZero False (pos 3)) (NotZero False (pos 5))
-- GT
--
-- >>> compare (NotZero False (pos 1)) (NotZero True (pos 1))
-- LT
--
-- >>> compare (NotZero True (pos 1)) (NotZero False (pos 1))
-- GT
instance Ord NotZero where
  compare (NotZero False (Positive x)) (NotZero False (Positive y)) = compare y x
  compare (NotZero True (Positive x)) (NotZero True (Positive y)) = compare x y
  compare (NotZero False _) (NotZero True _) = compare (0 :: Integer) (1 :: Integer)
  compare (NotZero True _) (NotZero False _) = compare (1 :: Integer) (0 :: Integer)

-- | Semigroup under addition. Note: this is partial if the result would be zero.
-- Use 'plusNZ' for a total version.
--
-- >>> NotZero True (pos 3) <> NotZero True (pos 4)
-- NotZero True (Positive 7)
--
-- >>> NotZero False (pos 3) <> NotZero False (pos 4)
-- NotZero False (Positive 7)
--
-- >>> NotZero True (pos 5) <> NotZero False (pos 3)
-- NotZero True (Positive 2)
--
-- >>> NotZero False (pos 5) <> NotZero True (pos 3)
-- NotZero False (Positive 2)
instance Semigroup NotZero where
  NotZero s1 (Positive x) <> NotZero s2 (Positive y) =
    case (s1, s2) of
      (True, True) -> NotZero True (Positive (x + y))
      (False, False) -> NotZero False (Positive (x + y))
      (True, False)
        | x <= y -> NotZero False (Positive (y - x))
        | True -> NotZero True (Positive (x - y))
      (False, True)
        | y <= x -> NotZero False (Positive (x - y))
        | True -> NotZero True (Positive (y - x))

class HasNotZero a where
  notZero ::
    Lens'
      a
      NotZero

-- |
--
-- >>> NotZero True (pos 5) ^. notZero
-- NotZero True (Positive 5)
instance HasNotZero NotZero where
  notZero =
    id

-- |
--
-- >>> (7 :: Integer) ^? _NotZero
-- Just (NotZero True (Positive 7))
--
-- >>> (-3 :: Integer) ^? _NotZero
-- Just (NotZero False (Positive 3))
--
-- >>> (0 :: Integer) ^? _NotZero
-- Nothing
class AsNotZero a where
  _NotZero ::
    Prism'
      a
      NotZero

-- |
--
-- >>> _NotZero # NotZero True (pos 5) :: NotZero
-- NotZero True (Positive 5)
instance AsNotZero NotZero where
  _NotZero =
    id

integralPrismNZ ::
  (Integral a) =>
  Prism'
    a
    NotZero
integralPrismNZ =
  prism'
    (\(NotZero s (Positive n)) -> fromIntegral (if s then n else negate n))
    ( \n ->
        let i = fromIntegral n :: Integer
         in if i == 0
              then Nothing
              else Just (NotZero (i > 0) (Positive (abs i)))
    )
  where
    (>) a b = not (a <= b) && not (a == b)

-- |
--
-- >>> (5 :: Int) ^? _NotZero
-- Just (NotZero True (Positive 5))
--
-- >>> (-5 :: Int) ^? _NotZero
-- Just (NotZero False (Positive 5))
--
-- >>> (0 :: Int) ^? _NotZero
-- Nothing
instance AsNotZero Int where
  _NotZero =
    integralPrismNZ

-- |
--
-- >>> (42 :: Integer) ^? _NotZero
-- Just (NotZero True (Positive 42))
--
-- >>> (-42 :: Integer) ^? _NotZero
-- Just (NotZero False (Positive 42))
--
-- >>> (0 :: Integer) ^? _NotZero
-- Nothing
instance AsNotZero Integer where
  _NotZero =
    integralPrismNZ

-- |
--
-- >>> (1 :: Word) ^? _NotZero
-- Just (NotZero True (Positive 1))
--
-- >>> (0 :: Word) ^? _NotZero
-- Nothing
instance AsNotZero Word where
  _NotZero =
    integralPrismNZ

-- |
--
-- >>> import Control.Applicative(Const(..))
-- >>> (Const 5 :: Const Integer Bool) ^? _NotZero
-- Just (NotZero True (Positive 5))
instance (Integral a) => AsNotZero (Const a b) where
  _NotZero =
    integralPrismNZ

-- |
--
-- >>> import Data.Functor.Identity(Identity(..))
-- >>> (Identity (-3) :: Identity Integer) ^? _NotZero
-- Just (NotZero False (Positive 3))
instance (Integral a) => AsNotZero (Identity a) where
  _NotZero =
    integralPrismNZ

-- |
--
-- >>> SumNotZero (NotZero True (pos 3)) <> SumNotZero (NotZero True (pos 4))
-- SumNotZero (NotZero True (Positive 7))
newtype SumNotZero
  = SumNotZero
      NotZero
  deriving (Eq, Ord, Show)

-- |
--
-- >>> SumNotZero (NotZero True (pos 5)) ^. notZero
-- NotZero True (Positive 5)
instance HasNotZero SumNotZero where
  notZero =
    _Wrapped . notZero

-- |
--
-- >>> SumNotZero (NotZero True (pos 5)) ^? _NotZero
-- Just (NotZero True (Positive 5))
instance AsNotZero SumNotZero where
  _NotZero =
    _Wrapped . _NotZero

instance
  (SumNotZero ~ a) =>
  Rewrapped SumNotZero a

-- |
--
-- >>> SumNotZero (NotZero True (pos 5)) ^. _Wrapped'
-- NotZero True (Positive 5)
instance Wrapped SumNotZero where
  type Unwrapped SumNotZero = NotZero
  _Wrapped' =
    iso
      (\(SumNotZero x) -> x)
      SumNotZero

-- |
--
-- >>> SumNotZero (NotZero True (pos 3)) <> SumNotZero (NotZero True (pos 4))
-- SumNotZero (NotZero True (Positive 7))
instance Semigroup SumNotZero where
  SumNotZero x <> SumNotZero y =
    SumNotZero (x <> y)

-- |
--
-- >>> MaxNotZero (NotZero True (pos 3)) <> MaxNotZero (NotZero True (pos 7))
-- MaxNotZero (NotZero True (Positive 7))
--
-- >>> MaxNotZero (NotZero False (pos 3)) <> MaxNotZero (NotZero True (pos 1))
-- MaxNotZero (NotZero True (Positive 1))
newtype MaxNotZero
  = MaxNotZero
      NotZero
  deriving (Eq, Ord, Show)

-- |
--
-- >>> MaxNotZero (NotZero True (pos 7)) ^. notZero
-- NotZero True (Positive 7)
instance HasNotZero MaxNotZero where
  notZero =
    _Wrapped . notZero

-- |
--
-- >>> MaxNotZero (NotZero True (pos 7)) ^? _NotZero
-- Just (NotZero True (Positive 7))
instance AsNotZero MaxNotZero where
  _NotZero =
    _Wrapped . _NotZero

instance
  (MaxNotZero ~ a) =>
  Rewrapped MaxNotZero a

-- |
--
-- >>> MaxNotZero (NotZero True (pos 7)) ^. _Wrapped'
-- NotZero True (Positive 7)
instance Wrapped MaxNotZero where
  type Unwrapped MaxNotZero = NotZero
  _Wrapped' =
    iso
      (\(MaxNotZero x) -> x)
      MaxNotZero

-- |
--
-- >>> MaxNotZero (NotZero True (pos 3)) <> MaxNotZero (NotZero True (pos 7))
-- MaxNotZero (NotZero True (Positive 7))
instance Semigroup MaxNotZero where
  MaxNotZero x <> MaxNotZero y =
    MaxNotZero (max x y)

-- |
--
-- >>> MinNotZero (NotZero True (pos 3)) <> MinNotZero (NotZero True (pos 7))
-- MinNotZero (NotZero True (Positive 3))
--
-- >>> MinNotZero (NotZero False (pos 3)) <> MinNotZero (NotZero True (pos 1))
-- MinNotZero (NotZero False (Positive 3))
newtype MinNotZero
  = MinNotZero
      NotZero
  deriving (Eq, Ord, Show)

-- |
--
-- >>> MinNotZero (NotZero False (pos 3)) ^. notZero
-- NotZero False (Positive 3)
instance HasNotZero MinNotZero where
  notZero =
    _Wrapped . notZero

-- |
--
-- >>> MinNotZero (NotZero False (pos 3)) ^? _NotZero
-- Just (NotZero False (Positive 3))
instance AsNotZero MinNotZero where
  _NotZero =
    _Wrapped . _NotZero

instance
  (MinNotZero ~ a) =>
  Rewrapped MinNotZero a

-- |
--
-- >>> MinNotZero (NotZero False (pos 3)) ^. _Wrapped'
-- NotZero False (Positive 3)
instance Wrapped MinNotZero where
  type Unwrapped MinNotZero = NotZero
  _Wrapped' =
    iso
      (\(MinNotZero x) -> x)
      MinNotZero

-- |
--
-- >>> MinNotZero (NotZero True (pos 3)) <> MinNotZero (NotZero True (pos 7))
-- MinNotZero (NotZero True (Positive 3))
instance Semigroup MinNotZero where
  MinNotZero x <> MinNotZero y =
    MinNotZero (min x y)

-- | Serialises a 'NotZero' to a JSON number.
--
-- >>> fromJSON (Number 5) :: Result NotZero
-- Success (NotZero True (Positive 5))
--
-- >>> fromJSON (Number (-3)) :: Result NotZero
-- Success (NotZero False (Positive 3))
--
-- >>> decode "7" :: Maybe NotZero
-- Just (NotZero True (Positive 7))
--
-- >>> decode "-2" :: Maybe NotZero
-- Just (NotZero False (Positive 2))
--
-- >>> decode "0" :: Maybe NotZero
-- Nothing
instance ToJSON NotZero where
  toJSON =
    toJsonNotZero
  toEncoding nz =
    toEncoding (notZeroInteger nz)

-- | Parses a 'NotZero' from a JSON number, failing on zero.
--
-- >>> decode "5" :: Maybe NotZero
-- Just (NotZero True (Positive 5))
instance FromJSON NotZero where
  parseJSON =
    parseJsonNotZero

-- | Serialises any value with a 'HasNotZero' instance to a JSON 'Value'.
--
-- >>> toJsonNotZero (NotZero True (pos 5))
-- Number 5.0
--
-- >>> toJsonNotZero (NotZero False (pos 3))
-- Number (-3.0)
--
-- >>> toJsonNotZero (SumNotZero (NotZero True (pos 7)))
-- Number 7.0
--
-- >>> toJsonNotZero (MaxNotZero (NotZero False (pos 2)))
-- Number (-2.0)
--
-- >>> toJsonNotZero (MinNotZero (NotZero True (pos 1)))
-- Number 1.0
{-# SPECIALIZE toJsonNotZero ::
  NotZero ->
  Value
  #-}
{-# INLINE toJsonNotZero #-}
toJsonNotZero ::
  (HasNotZero a) =>
  a ->
  Value
toJsonNotZero a =
  toJSON (notZeroInteger (a ^. notZero))

-- | Parses a JSON value into a 'NotZero', failing on zero.
--
-- >>> parse parseJsonNotZero (Number 5)
-- Success (NotZero True (Positive 5))
--
-- >>> parse parseJsonNotZero (Number (-3))
-- Success (NotZero False (Positive 3))
--
-- >>> parse parseJsonNotZero (Number 0)
-- Error "parse failed, NotZero: expected non-zero integer"
{-# INLINE parseJsonNotZero #-}
parseJsonNotZero ::
  Value ->
  Parser NotZero
parseJsonNotZero v =
  parseJSON v >>= \n ->
    if n == 0
      then fail "parse failed, NotZero: expected non-zero integer"
      else
        pure
          ( if n < 0
              then NotZero False (Positive (negate n))
              else NotZero True (Positive n)
          )

-- | Serialises a 'SumNotZero' to a JSON number.
--
-- >>> encode (SumNotZero (NotZero True (pos 7)))
-- "7"
instance ToJSON SumNotZero where
  toJSON =
    toJsonNotZero
  toEncoding (SumNotZero nz) =
    toEncoding (notZeroInteger nz)

-- | Parses a 'SumNotZero' from a JSON number, failing on zero.
--
-- >>> decode "7" :: Maybe SumNotZero
-- Just (SumNotZero (NotZero True (Positive 7)))
--
-- >>> decode "0" :: Maybe SumNotZero
-- Nothing
instance FromJSON SumNotZero where
  parseJSON v =
    parseJsonNotZero v >>= \n -> pure (SumNotZero n)

-- | Serialises a 'MaxNotZero' to a JSON number.
--
-- >>> encode (MaxNotZero (NotZero False (pos 2)))
-- "-2"
instance ToJSON MaxNotZero where
  toJSON =
    toJsonNotZero
  toEncoding (MaxNotZero nz) =
    toEncoding (notZeroInteger nz)

-- | Parses a 'MaxNotZero' from a JSON number, failing on zero.
--
-- >>> decode "-2" :: Maybe MaxNotZero
-- Just (MaxNotZero (NotZero False (Positive 2)))
--
-- >>> decode "0" :: Maybe MaxNotZero
-- Nothing
instance FromJSON MaxNotZero where
  parseJSON v =
    parseJsonNotZero v >>= \n -> pure (MaxNotZero n)

-- | Serialises a 'MinNotZero' to a JSON number.
--
-- >>> encode (MinNotZero (NotZero True (pos 1)))
-- "1"
instance ToJSON MinNotZero where
  toJSON =
    toJsonNotZero
  toEncoding (MinNotZero nz) =
    toEncoding (notZeroInteger nz)

-- | Parses a 'MinNotZero' from a JSON number, failing on zero.
--
-- >>> decode "1" :: Maybe MinNotZero
-- Just (MinNotZero (NotZero True (Positive 1)))
--
-- >>> decode "0" :: Maybe MinNotZero
-- Nothing
instance FromJSON MinNotZero where
  parseJSON v =
    parseJsonNotZero v >>= \n -> pure (MinNotZero n)

-- | Embed a 'Positive' as a positive 'NotZero'.
--
-- >>> positiveNotZero (pos 5)
-- NotZero True (Positive 5)
positiveNotZero ::
  Positive ->
  NotZero
positiveNotZero =
  NotZero True

-- | Embed a 'Positive' as a negative 'NotZero'.
--
-- >>> negativeNotZero (pos 5)
-- NotZero False (Positive 5)
negativeNotZero ::
  Positive ->
  NotZero
negativeNotZero =
  NotZero False

-- | Extract the magnitude from a 'NotZero'.
--
-- >>> notZeroPositive (NotZero True (pos 5))
-- Positive 5
--
-- >>> notZeroPositive (NotZero False (pos 3))
-- Positive 3
notZeroPositive ::
  NotZero ->
  Positive
notZeroPositive (NotZero _ p) =
  p

-- | Convert a 'NotZero' to an 'Integer'.
--
-- >>> notZeroInteger (NotZero True (pos 5))
-- 5
--
-- >>> notZeroInteger (NotZero False (pos 3))
-- -3
notZeroInteger ::
  NotZero ->
  Integer
notZeroInteger (NotZero s (Positive n)) =
  if s then n else negate n

-- | Test if a 'NotZero' is positive.
--
-- >>> isPositive (NotZero True (pos 5))
-- True
--
-- >>> isPositive (NotZero False (pos 5))
-- False
isPositive ::
  NotZero ->
  Bool
isPositive (NotZero s _) =
  s

-- | Test if a 'NotZero' is negative.
--
-- >>> isNegative (NotZero False (pos 5))
-- True
--
-- >>> isNegative (NotZero True (pos 5))
-- False
isNegative ::
  NotZero ->
  Bool
isNegative (NotZero s _) =
  not s

-- | Negate a 'NotZero'.
--
-- >>> negateNZ (NotZero True (pos 5))
-- NotZero False (Positive 5)
--
-- >>> negateNZ (NotZero False (pos 3))
-- NotZero True (Positive 3)
negateNZ ::
  NotZero ->
  NotZero
negateNZ (NotZero s p) =
  NotZero (not s) p

-- | Absolute value as a 'Positive'.
--
-- >>> absoluteNZ (NotZero True (pos 5))
-- Positive 5
--
-- >>> absoluteNZ (NotZero False (pos 3))
-- Positive 3
absoluteNZ ::
  NotZero ->
  Positive
absoluteNZ =
  notZeroPositive

-- | Signum: positive one or negative one.
--
-- >>> signumNZ (NotZero True (pos 99))
-- NotZero True (Positive 1)
--
-- >>> signumNZ (NotZero False (pos 42))
-- NotZero False (Positive 1)
signumNZ ::
  NotZero ->
  NotZero
signumNZ (NotZero s _) =
  NotZero s one'

-- | Add two 'NotZero' values. Returns 'Nothing' if the result is zero.
--
-- >>> plusNZ (NotZero True (pos 3)) (NotZero True (pos 4))
-- Just (NotZero True (Positive 7))
--
-- >>> plusNZ (NotZero True (pos 3)) (NotZero False (pos 3))
-- Nothing
--
-- >>> plusNZ (NotZero True (pos 5)) (NotZero False (pos 3))
-- Just (NotZero True (Positive 2))
--
-- >>> plusNZ (NotZero False (pos 5)) (NotZero True (pos 3))
-- Just (NotZero False (Positive 2))
plusNZ ::
  NotZero ->
  NotZero ->
  Maybe NotZero
plusNZ (NotZero s1 (Positive x)) (NotZero s2 (Positive y)) =
  case (s1, s2) of
    (True, True) -> Just (NotZero True (Positive (x + y)))
    (False, False) -> Just (NotZero False (Positive (x + y)))
    (True, False)
      | x == y -> Nothing
      | x < y -> Just (NotZero False (Positive (y - x)))
      | True -> Just (NotZero True (Positive (x - y)))
    (False, True)
      | x == y -> Nothing
      | y < x -> Just (NotZero False (Positive (x - y)))
      | True -> Just (NotZero True (Positive (y - x)))

-- | Multiply two 'NotZero' values. Always non-zero.
--
-- >>> multiplyNZ (NotZero True (pos 3)) (NotZero True (pos 4))
-- NotZero True (Positive 12)
--
-- >>> multiplyNZ (NotZero False (pos 3)) (NotZero True (pos 4))
-- NotZero False (Positive 12)
--
-- >>> multiplyNZ (NotZero False (pos 3)) (NotZero False (pos 4))
-- NotZero True (Positive 12)
multiplyNZ ::
  NotZero ->
  NotZero ->
  NotZero
multiplyNZ (NotZero s1 (Positive x)) (NotZero s2 (Positive y)) =
  NotZero (s1 == s2) (Positive (x * y))

-- | Return the 'NotZero' if the prism matches, otherwise positive one.
--
-- >>> notZeroOr (5 :: Integer)
-- NotZero True (Positive 5)
--
-- >>> notZeroOr (0 :: Integer)
-- NotZero True (Positive 1)
--
-- >>> notZeroOr (-3 :: Integer)
-- NotZero False (Positive 3)
notZeroOr ::
  (AsNotZero a) =>
  a ->
  NotZero
notZeroOr n =
  fromMaybe (NotZero True one') (n ^? _NotZero)

-- | Prism from 'NotZero' to 'Positive' (matches only positive values).
--
-- >>> (NotZero True (pos 5)) ^? _Positive
-- Just (Positive 5)
--
-- >>> (NotZero False (pos 5)) ^? _Positive
-- Nothing
instance AsPositive NotZero where
  _Positive =
    prism'
      positiveNotZero
      (\(NotZero s p) -> if s then Just p else Nothing)