{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE TypeApplications #-}
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
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))
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))
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))
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))
type Num1 :: Type -> Constraint
class Num1 a where
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
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