{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE TypeApplications #-}

{- |
Module      : Primus.Num1
Description : similar to 'Num' class but with failure handling
Copyright   : (c) Grant Weyburne, 2022
License     : BSD-3
-}
module Primus.Num1 (
  Num1 (..),
  withOp,
  withOp2,
  withOp3,
  withOp4,
) where

import Control.Applicative
import Control.Monad
import Data.Int
import Data.Kind
import Data.Pos
import Data.Word
import GHC.Natural
import Primus.Enum
import Primus.Error

-- | run a function of one integer against the underlying 'Num1' type
withOp :: Num1 a => (Integer -> Integer) -> a -> Either String a
withOp :: (Integer -> Integer) -> a -> Either String a
withOp Integer -> Integer
f a
a = a -> Integer -> Either String a
forall a. Num1 a => a -> Integer -> Either String a
fromInteger1 a
a (Integer -> Integer
f (a -> Integer
forall a. Num1 a => a -> Integer
toInteger1 a
a))

-- | run a function of two integers against the underlying 'Num1' types
withOp2 :: Num1 a => (Integer -> Integer -> Integer) -> a -> a -> Either String a
withOp2 :: (Integer -> Integer -> Integer) -> a -> a -> Either String a
withOp2 Integer -> Integer -> Integer
f a
a a
b = a -> Integer -> Either String a
forall a. Num1 a => a -> Integer -> Either String a
fromInteger1 a
a (Integer -> Integer -> Integer
f (a -> Integer
forall a. Num1 a => a -> Integer
toInteger1 a
a) (a -> Integer
forall a. Num1 a => a -> Integer
toInteger1 a
b))

-- | run a function of three integers against the underlying 'Num1' types
withOp3 :: Num1 a => (Integer -> Integer -> Integer -> Integer) -> a -> a -> a -> Either String a
withOp3 :: (Integer -> Integer -> Integer -> Integer)
-> a -> a -> a -> Either String a
withOp3 Integer -> Integer -> Integer -> Integer
f a
a a
b a
c =
  a -> Integer -> Either String a
forall a. Num1 a => a -> Integer -> Either String a
fromInteger1 a
a (Integer -> Integer -> Integer -> Integer
f (a -> Integer
forall a. Num1 a => a -> Integer
toInteger1 a
a) (a -> Integer
forall a. Num1 a => a -> Integer
toInteger1 a
b) (a -> Integer
forall a. Num1 a => a -> Integer
toInteger1 a
c))

-- | run a function of four integers against the underlying 'Num1' types
withOp4 :: Num1 a => (Integer -> Integer -> Integer -> Integer -> Integer) -> a -> a -> a -> a -> Either String a
withOp4 :: (Integer -> Integer -> Integer -> Integer -> Integer)
-> a -> a -> a -> a -> Either String a
withOp4 Integer -> Integer -> Integer -> Integer -> Integer
f a
a a
b a
c a
d =
  a -> Integer -> Either String a
forall a. Num1 a => a -> Integer -> Either String a
fromInteger1 a
a (Integer -> Integer -> Integer -> Integer -> Integer
f (a -> Integer
forall a. Num1 a => a -> Integer
toInteger1 a
a) (a -> Integer
forall a. Num1 a => a -> Integer
toInteger1 a
b) (a -> Integer
forall a. Num1 a => a -> Integer
toInteger1 a
c) (a -> Integer
forall a. Num1 a => a -> Integer
toInteger1 a
d))

{- | lifted version of Num class for handling failure
 minimal definition requires 'toInteger1' and 'fromInteger1' unless leveraging default signatures
-}
type Num1 :: Type -> Constraint
class Num1 a where
  -- | required method for converting from "a" to an 'Integer'
  toInteger1 :: a -> Integer
  default toInteger1 :: Enum a => a -> Integer
  toInteger1 = Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> (a -> Int) -> a -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Enum a => a -> Int
forall a. Enum a => a -> Int
fromEnum @a

  -- | required method for trying to convert from an 'Integer' to "a"
  fromInteger1 :: a -> Integer -> Either String a
  default fromInteger1 :: (Bounded a, Enum a) => a -> Integer -> Either String a
  fromInteger1 = (Integer -> Either String a) -> a -> Integer -> Either String a
forall a b. a -> b -> a
const Integer -> Either String a
forall a. (Enum a, Bounded a) => Integer -> Either String a
integerToEnumSafe

  (.+)
    , (.-)
    , (.*) ::
      Either String a ->
      Either String a ->
      Either String a
  (.+) = Either String (Either String a) -> Either String a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Either String (Either String a) -> Either String a)
-> (Either String a
    -> Either String a -> Either String (Either String a))
-> Either String a
-> Either String a
-> Either String a
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.@ (a -> a -> Either String a)
-> Either String a
-> Either String a
-> Either String (Either String a)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (String -> Either String a -> Either String a
forall a. String -> Either String a -> Either String a
lmsg String
"(.+)" (Either String a -> Either String a)
-> (a -> a -> Either String a) -> a -> a -> Either String a
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.@ (Integer -> Integer -> Integer) -> a -> a -> Either String a
forall a.
Num1 a =>
(Integer -> Integer -> Integer) -> a -> a -> Either String a
withOp2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+))
  (.-) = Either String (Either String a) -> Either String a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Either String (Either String a) -> Either String a)
-> (Either String a
    -> Either String a -> Either String (Either String a))
-> Either String a
-> Either String a
-> Either String a
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.@ (a -> a -> Either String a)
-> Either String a
-> Either String a
-> Either String (Either String a)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (String -> Either String a -> Either String a
forall a. String -> Either String a -> Either String a
lmsg String
"(.-)" (Either String a -> Either String a)
-> (a -> a -> Either String a) -> a -> a -> Either String a
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.@ (Integer -> Integer -> Integer) -> a -> a -> Either String a
forall a.
Num1 a =>
(Integer -> Integer -> Integer) -> a -> a -> Either String a
withOp2 (-))
  (.*) = Either String (Either String a) -> Either String a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Either String (Either String a) -> Either String a)
-> (Either String a
    -> Either String a -> Either String (Either String a))
-> Either String a
-> Either String a
-> Either String a
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.@ (a -> a -> Either String a)
-> Either String a
-> Either String a
-> Either String (Either String a)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (String -> Either String a -> Either String a
forall a. String -> Either String a -> Either String a
lmsg String
"(.*)" (Either String a -> Either String a)
-> (a -> a -> Either String a) -> a -> a -> Either String a
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.@ (Integer -> Integer -> Integer) -> a -> a -> Either String a
forall a.
Num1 a =>
(Integer -> Integer -> Integer) -> a -> a -> Either String a
withOp2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(*))
  negate1
    , abs1
    , signum1
    , succ1
    , pred1 ::
      Either String a ->
      Either String a
  negate1 = (a -> Either String a) -> Either String a -> Either String a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
(=<<) (String -> Either String a -> Either String a
forall a. String -> Either String a -> Either String a
lmsg String
"negate1" (Either String a -> Either String a)
-> (a -> Either String a) -> a -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer) -> a -> Either String a
forall a. Num1 a => (Integer -> Integer) -> a -> Either String a
withOp Integer -> Integer
forall a. Num a => a -> a
negate)
  signum1 = (a -> Either String a) -> Either String a -> Either String a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
(=<<) (String -> Either String a -> Either String a
forall a. String -> Either String a -> Either String a
lmsg String
"signum1" (Either String a -> Either String a)
-> (a -> Either String a) -> a -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer) -> a -> Either String a
forall a. Num1 a => (Integer -> Integer) -> a -> Either String a
withOp Integer -> Integer
forall a. Num a => a -> a
signum)
  abs1 = (a -> Either String a) -> Either String a -> Either String a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
(=<<) (String -> Either String a -> Either String a
forall a. String -> Either String a -> Either String a
lmsg String
"abs1" (Either String a -> Either String a)
-> (a -> Either String a) -> a -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer) -> a -> Either String a
forall a. Num1 a => (Integer -> Integer) -> a -> Either String a
withOp Integer -> Integer
forall a. Num a => a -> a
abs)
  succ1 = (a -> Either String a) -> Either String a -> Either String a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
(=<<) (String -> Either String a -> Either String a
forall a. String -> Either String a -> Either String a
lmsg String
"succ1" (Either String a -> Either String a)
-> (a -> Either String a) -> a -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer) -> a -> Either String a
forall a. Num1 a => (Integer -> Integer) -> a -> Either String a
withOp Integer -> Integer
forall a. Enum a => a -> a
succ)
  pred1 = (a -> Either String a) -> Either String a -> Either String a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
(=<<) (String -> Either String a -> Either String a
forall a. String -> Either String a -> Either String a
lmsg String
"pred1" (Either String a -> Either String a)
-> (a -> Either String a) -> a -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer) -> a -> Either String a
forall a. Num1 a => (Integer -> Integer) -> a -> Either String a
withOp Integer -> Integer
forall a. Enum a => a -> a
pred)

infixl 7 .*
infixl 6 .+
infixl 6 .-

instance Num1 Natural where
  fromInteger1 :: Natural -> Integer -> Either String Natural
fromInteger1 Natural
_ Integer
i
    | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 = String -> Either String Natural
forall a b. a -> Either a b
Left (String -> Either String Natural)
-> String -> Either String Natural
forall a b. (a -> b) -> a -> b
$ String
"Natural: undefined for negative numbers " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
i
    | Bool
otherwise = Natural -> Either String Natural
forall a b. b -> Either a b
Right (Natural -> Either String Natural)
-> Natural -> Either String Natural
forall a b. (a -> b) -> a -> b
$ Integer -> Natural
naturalFromInteger Integer
i

instance Num1 Pos
instance Num1 Word
instance Num1 Word8
instance Num1 Word16
instance Num1 Word32
instance Num1 Word64
instance Num1 Int
instance Num1 Int8
instance Num1 Int16
instance Num1 Int32
instance Num1 Int64