{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}

module ROC.ID.Serial
  ( Serial (..)
  , randomSerial
  ) where

import Control.Monad.Random.Class
    ( MonadRandom (..) )
import Data.Vector.Sized
    ( Vector )
import GHC.Generics
    ( Generic )

import ROC.ID.Digit
import ROC.ID.Utilities

import qualified Data.Vector.Sized as V

-- | A 7-digit serial number, as found within an ROC identification number.
--
-- A serial number is unique for a gender and location.
--
-- To generate a random 'Serial' number, use the 'randomSerial' function.
--
newtype Serial = Serial (Vector 7 Digit)
  deriving (Serial -> Serial -> Bool
(Serial -> Serial -> Bool)
-> (Serial -> Serial -> Bool) -> Eq Serial
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Serial -> Serial -> Bool
== :: Serial -> Serial -> Bool
$c/= :: Serial -> Serial -> Bool
/= :: Serial -> Serial -> Bool
Eq, (forall x. Serial -> Rep Serial x)
-> (forall x. Rep Serial x -> Serial) -> Generic Serial
forall x. Rep Serial x -> Serial
forall x. Serial -> Rep Serial x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Serial -> Rep Serial x
from :: forall x. Serial -> Rep Serial x
$cto :: forall x. Rep Serial x -> Serial
to :: forall x. Rep Serial x -> Serial
Generic, Eq Serial
Eq Serial =>
(Serial -> Serial -> Ordering)
-> (Serial -> Serial -> Bool)
-> (Serial -> Serial -> Bool)
-> (Serial -> Serial -> Bool)
-> (Serial -> Serial -> Bool)
-> (Serial -> Serial -> Serial)
-> (Serial -> Serial -> Serial)
-> Ord Serial
Serial -> Serial -> Bool
Serial -> Serial -> Ordering
Serial -> Serial -> Serial
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
$ccompare :: Serial -> Serial -> Ordering
compare :: Serial -> Serial -> Ordering
$c< :: Serial -> Serial -> Bool
< :: Serial -> Serial -> Bool
$c<= :: Serial -> Serial -> Bool
<= :: Serial -> Serial -> Bool
$c> :: Serial -> Serial -> Bool
> :: Serial -> Serial -> Bool
$c>= :: Serial -> Serial -> Bool
>= :: Serial -> Serial -> Bool
$cmax :: Serial -> Serial -> Serial
max :: Serial -> Serial -> Serial
$cmin :: Serial -> Serial -> Serial
min :: Serial -> Serial -> Serial
Ord, Int -> Serial -> ShowS
[Serial] -> ShowS
Serial -> String
(Int -> Serial -> ShowS)
-> (Serial -> String) -> ([Serial] -> ShowS) -> Show Serial
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Serial -> ShowS
showsPrec :: Int -> Serial -> ShowS
$cshow :: Serial -> String
show :: Serial -> String
$cshowList :: [Serial] -> ShowS
showList :: [Serial] -> ShowS
Show)

-- | Generate a random 'Serial' number.
--
randomSerial :: MonadRandom m => m Serial
randomSerial :: forall (m :: * -> *). MonadRandom m => m Serial
randomSerial = Vector 7 Digit -> Serial
Serial (Vector 7 Digit -> Serial) -> m (Vector 7 Digit) -> m Serial
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Digit -> m (Vector 7 Digit)
forall (n :: Nat) (m :: * -> *) a.
(KnownNat n, Monad m) =>
m a -> m (Vector n a)
V.replicateM m Digit
forall a (m :: * -> *). (MonadRandom m, Bounded a, Enum a) => m a
randomBoundedEnum