{-|
Module      : Stype count
Description : Statistical types
Copyright   : (c) NoviSci, Inc 2020
License     : BSD3
Maintainer  : bsaul@novisci.com

-}

{-# LANGUAGE Safe #-}
{-# LANGUAGE DeriveGeneric #-}

module Stype.Numeric.Count (
  Count(..)
) where

import safe GHC.Generics                 ( Generic )
import safe GHC.Num                      ( Natural )
import safe Data.Semiring                ( Semiring(..) )

{- | Just a type holding a 'GHC.Num.Natural' value.
-}
newtype Count = Count Natural
  deriving (Count -> Count -> Bool
(Count -> Count -> Bool) -> (Count -> Count -> Bool) -> Eq Count
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Count -> Count -> Bool
$c/= :: Count -> Count -> Bool
== :: Count -> Count -> Bool
$c== :: Count -> Count -> Bool
Eq, Int -> Count -> ShowS
[Count] -> ShowS
Count -> String
(Int -> Count -> ShowS)
-> (Count -> String) -> ([Count] -> ShowS) -> Show Count
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Count] -> ShowS
$cshowList :: [Count] -> ShowS
show :: Count -> String
$cshow :: Count -> String
showsPrec :: Int -> Count -> ShowS
$cshowsPrec :: Int -> Count -> ShowS
Show, Eq Count
Eq Count
-> (Count -> Count -> Ordering)
-> (Count -> Count -> Bool)
-> (Count -> Count -> Bool)
-> (Count -> Count -> Bool)
-> (Count -> Count -> Bool)
-> (Count -> Count -> Count)
-> (Count -> Count -> Count)
-> Ord Count
Count -> Count -> Bool
Count -> Count -> Ordering
Count -> Count -> Count
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 :: Count -> Count -> Count
$cmin :: Count -> Count -> Count
max :: Count -> Count -> Count
$cmax :: Count -> Count -> Count
>= :: Count -> Count -> Bool
$c>= :: Count -> Count -> Bool
> :: Count -> Count -> Bool
$c> :: Count -> Count -> Bool
<= :: Count -> Count -> Bool
$c<= :: Count -> Count -> Bool
< :: Count -> Count -> Bool
$c< :: Count -> Count -> Bool
compare :: Count -> Count -> Ordering
$ccompare :: Count -> Count -> Ordering
$cp1Ord :: Eq Count
Ord, (forall x. Count -> Rep Count x)
-> (forall x. Rep Count x -> Count) -> Generic Count
forall x. Rep Count x -> Count
forall x. Count -> Rep Count x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Count x -> Count
$cfrom :: forall x. Count -> Rep Count x
Generic)

instance Num Count where
  + :: Count -> Count -> Count
(+) (Count Natural
x) (Count Natural
y) = Natural -> Count
Count (Natural
x Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
y)
  * :: Count -> Count -> Count
(*) (Count Natural
x) (Count Natural
y) = Natural -> Count
Count (Natural
x Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
* Natural
y) 
  fromInteger :: Integer -> Count
fromInteger Integer
x = Natural -> Count
Count (Natural -> Count) -> Natural -> Count
forall a b. (a -> b) -> a -> b
$ Integer -> Natural
forall a. Num a => Integer -> a
fromInteger Integer
x
  abs :: Count -> Count
abs = Count -> Count
forall a. a -> a
id -- useless
  signum :: Count -> Count
signum Count
x = Natural -> Count
Count Natural
1 -- useless
  negate :: Count -> Count
negate = Count -> Count
forall a. a -> a
id -- useless

instance Semigroup Natural where
  <> :: Natural -> Natural -> Natural
(<>) Natural
x Natural
y = Natural
x Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
y

instance Monoid Natural where
  mempty :: Natural
mempty = Natural
0

instance Semiring Natural where
  one :: Natural
one = Natural
1
  <.> :: Natural -> Natural -> Natural
(<.>) = Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
(*)

instance Semigroup Count where
  <> :: Count -> Count -> Count
(<>) (Count Natural
x) (Count Natural
y) = Natural -> Count
Count (Natural
x Natural -> Natural -> Natural
forall a. Semigroup a => a -> a -> a
<> Natural
y)

instance Monoid Count where
  mempty :: Count
mempty = Natural -> Count
Count Natural
0

instance Semiring Count where
  one :: Count
one = Natural -> Count
Count Natural
1
  <.> :: Count -> Count -> Count
(<.>) = Count -> Count -> Count
forall a. Num a => a -> a -> a
(*)