-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

-- | Definition of 'Positive' type and related utilities.
module Util.Positive
  ( Positive (..)
  , mkPositive
  , lengthNE
  , replicateNE
  ) where

import Data.Aeson (FromJSON, ToJSON)
import Data.Data (Data)
import Fmt (Buildable, pretty)

import Util.Instances ()

-- | Integer values starting from 1.
--
-- We define our own datatype in order to have 'Data' instance for it,
-- which can not be derived for third-party types without exported constructor.
newtype Positive = PositiveUnsafe { Positive -> Natural
unPositive :: Natural }
  deriving stock (Positive -> Positive -> Bool
(Positive -> Positive -> Bool)
-> (Positive -> Positive -> Bool) -> Eq Positive
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Positive -> Positive -> Bool
$c/= :: Positive -> Positive -> Bool
== :: Positive -> Positive -> Bool
$c== :: Positive -> Positive -> Bool
Eq, Eq Positive
Eq Positive =>
(Positive -> Positive -> Ordering)
-> (Positive -> Positive -> Bool)
-> (Positive -> Positive -> Bool)
-> (Positive -> Positive -> Bool)
-> (Positive -> Positive -> Bool)
-> (Positive -> Positive -> Positive)
-> (Positive -> Positive -> Positive)
-> Ord Positive
Positive -> Positive -> Bool
Positive -> Positive -> Ordering
Positive -> Positive -> Positive
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Positive -> Positive -> Positive
$cmin :: Positive -> Positive -> Positive
max :: Positive -> Positive -> Positive
$cmax :: Positive -> Positive -> Positive
>= :: Positive -> Positive -> Bool
$c>= :: Positive -> Positive -> Bool
> :: Positive -> Positive -> Bool
$c> :: Positive -> Positive -> Bool
<= :: Positive -> Positive -> Bool
$c<= :: Positive -> Positive -> Bool
< :: Positive -> Positive -> Bool
$c< :: Positive -> Positive -> Bool
compare :: Positive -> Positive -> Ordering
$ccompare :: Positive -> Positive -> Ordering
$cp1Ord :: Eq Positive
Ord, Typeable Positive
DataType
Constr
Typeable Positive =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Positive -> c Positive)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Positive)
-> (Positive -> Constr)
-> (Positive -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Positive))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Positive))
-> ((forall b. Data b => b -> b) -> Positive -> Positive)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Positive -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Positive -> r)
-> (forall u. (forall d. Data d => d -> u) -> Positive -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Positive -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Positive -> m Positive)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Positive -> m Positive)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Positive -> m Positive)
-> Data Positive
Positive -> DataType
Positive -> Constr
(forall b. Data b => b -> b) -> Positive -> Positive
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Positive -> c Positive
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Positive
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Positive -> u
forall u. (forall d. Data d => d -> u) -> Positive -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Positive -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Positive -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Positive -> m Positive
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Positive -> m Positive
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Positive
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Positive -> c Positive
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Positive)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Positive)
$cPositiveUnsafe :: Constr
$tPositive :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Positive -> m Positive
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Positive -> m Positive
gmapMp :: (forall d. Data d => d -> m d) -> Positive -> m Positive
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Positive -> m Positive
gmapM :: (forall d. Data d => d -> m d) -> Positive -> m Positive
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Positive -> m Positive
gmapQi :: Int -> (forall d. Data d => d -> u) -> Positive -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Positive -> u
gmapQ :: (forall d. Data d => d -> u) -> Positive -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Positive -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Positive -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Positive -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Positive -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Positive -> r
gmapT :: (forall b. Data b => b -> b) -> Positive -> Positive
$cgmapT :: (forall b. Data b => b -> b) -> Positive -> Positive
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Positive)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Positive)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Positive)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Positive)
dataTypeOf :: Positive -> DataType
$cdataTypeOf :: Positive -> DataType
toConstr :: Positive -> Constr
$ctoConstr :: Positive -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Positive
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Positive
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Positive -> c Positive
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Positive -> c Positive
$cp1Data :: Typeable Positive
Data, (forall x. Positive -> Rep Positive x)
-> (forall x. Rep Positive x -> Positive) -> Generic Positive
forall x. Rep Positive x -> Positive
forall x. Positive -> Rep Positive x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Positive x -> Positive
$cfrom :: forall x. Positive -> Rep Positive x
Generic)
  deriving newtype (Int -> Positive -> ShowS
[Positive] -> ShowS
Positive -> String
(Int -> Positive -> ShowS)
-> (Positive -> String) -> ([Positive] -> ShowS) -> Show Positive
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Positive] -> ShowS
$cshowList :: [Positive] -> ShowS
show :: Positive -> String
$cshow :: Positive -> String
showsPrec :: Int -> Positive -> ShowS
$cshowsPrec :: Int -> Positive -> ShowS
Show, Positive -> Builder
(Positive -> Builder) -> Buildable Positive
forall p. (p -> Builder) -> Buildable p
build :: Positive -> Builder
$cbuild :: Positive -> Builder
Buildable, [Positive] -> Encoding
[Positive] -> Value
Positive -> Encoding
Positive -> Value
(Positive -> Value)
-> (Positive -> Encoding)
-> ([Positive] -> Value)
-> ([Positive] -> Encoding)
-> ToJSON Positive
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Positive] -> Encoding
$ctoEncodingList :: [Positive] -> Encoding
toJSONList :: [Positive] -> Value
$ctoJSONList :: [Positive] -> Value
toEncoding :: Positive -> Encoding
$ctoEncoding :: Positive -> Encoding
toJSON :: Positive -> Value
$ctoJSON :: Positive -> Value
ToJSON, Value -> Parser [Positive]
Value -> Parser Positive
(Value -> Parser Positive)
-> (Value -> Parser [Positive]) -> FromJSON Positive
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Positive]
$cparseJSONList :: Value -> Parser [Positive]
parseJSON :: Value -> Parser Positive
$cparseJSON :: Value -> Parser Positive
FromJSON)

instance NFData Positive

mkPositive :: (Integral i, Buildable i) => i -> Either Text Positive
mkPositive :: i -> Either Text Positive
mkPositive a :: i
a
  | i
a i -> i -> Bool
forall a. Ord a => a -> a -> Bool
> 0     = Positive -> Either Text Positive
forall a b. b -> Either a b
Right (Positive -> Either Text Positive)
-> Positive -> Either Text Positive
forall a b. (a -> b) -> a -> b
$ Natural -> Positive
PositiveUnsafe (i -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
a)
  | Bool
otherwise = Text -> Either Text Positive
forall a b. a -> Either a b
Left (Text -> Either Text Positive) -> Text -> Either Text Positive
forall a b. (a -> b) -> a -> b
$ "Number is not positive: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> i -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty i
a

-- | Count length of non-empty list.
lengthNE :: NonEmpty a -> Positive
lengthNE :: NonEmpty a -> Positive
lengthNE = Natural -> Positive
PositiveUnsafe (Natural -> Positive)
-> (NonEmpty a -> Natural) -> NonEmpty a -> Positive
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Natural) -> (NonEmpty a -> Int) -> NonEmpty a -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty a -> Int
forall t. Container t => t -> Int
length

-- | Produce a non empty list consisting of the given value.
replicateNE :: Positive -> a -> NonEmpty a
replicateNE :: Positive -> a -> NonEmpty a
replicateNE (PositiveUnsafe i :: Natural
i) a :: a
a = a
a a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| Int -> a -> [a]
forall a. Int -> a -> [a]
replicate (Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) a
a