Num1.hs

{-# 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 f a = fromInteger1 a (f (toInteger1 a))

-- | run a function of two integers against the underlying 'Num1' types
withOp2 :: Num1 a => (Integer -> Integer -> Integer) -> a -> a -> Either String a
withOp2 f a b = fromInteger1 a (f (toInteger1 a) (toInteger1 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 f a b c =
  fromInteger1 a (f (toInteger1 a) (toInteger1 b) (toInteger1 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 f a b c d =
  fromInteger1 a (f (toInteger1 a) (toInteger1 b) (toInteger1 c) (toInteger1 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 = toInteger . 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 = const integerToEnumSafe

  (.+)
    , (.-)
    , (.*) ::
      Either String a ->
      Either String a ->
      Either String a
  (.+) = join .@ liftA2 (lmsg "(.+)" .@ withOp2 (+))
  (.-) = join .@ liftA2 (lmsg "(.-)" .@ withOp2 (-))
  (.*) = join .@ liftA2 (lmsg "(.*)" .@ withOp2 (*))
  negate1
    , abs1
    , signum1
    , succ1
    , pred1 ::
      Either String a ->
      Either String a
  negate1 = (=<<) (lmsg "negate1" . withOp negate)
  signum1 = (=<<) (lmsg "signum1" . withOp signum)
  abs1 = (=<<) (lmsg "abs1" . withOp abs)
  succ1 = (=<<) (lmsg "succ1" . withOp succ)
  pred1 = (=<<) (lmsg "pred1" . withOp pred)

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

instance Num1 Natural where
  fromInteger1 _ i
    | i < 0 = Left $ "Natural: undefined for negative numbers " ++ show i
    | otherwise = Right $ naturalFromInteger 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