{-# 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
import Primus.Extra

-- | 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 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