{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}

{- | Nullable-aware binary operations for expressions.

This module provides two type classes, 'NullableArithOp' and 'NullableCmpOp',
which enable operators like '.+', '.-', '.*', './', '.==' etc. to work
transparently across combinations of nullable (@Maybe a@) and non-nullable
(@a@) column types.

The partial functional dependencies uniquely determine the result type from
the operand types, so GHC infers it without annotations.

The four combinations covered for each class:

* @(a, a)@               — non-nullable × non-nullable
* @(Maybe a, a)@         — nullable × non-nullable
* @(a, Maybe a)@         — non-nullable × nullable
* @(Maybe a, Maybe a)@   — both nullable

== Usage

@
-- Mixing nullable and non-nullable columns:
F.col \@Int \"x\" '.+' F.col \@(Maybe Int) \"y\"  -- :: Expr (Maybe Int)

-- Both non-nullable (existing behaviour preserved):
F.col \@Int \"x\" '.+' F.col \@Int \"y\"           -- :: Expr Int

-- Comparison with three-valued logic:
F.col \@(Maybe Int) \"x\" '.==' F.col \@Int \"y\"  -- :: Expr (Maybe Bool)
@
-}
module DataFrame.Internal.Nullable (
    -- * Type family
    BaseType,

    -- * Arithmetic class
    NullableArithOp (..),

    -- * Comparison class
    NullableCmpOp (..),

    -- * Generalized nullable lift classes
    NullLift1Op (..),
    NullLift2Op (..),

    -- * Result-type type families (drive inference in nullLift / nullLift2)
    NullLift1Result,
    NullLift2Result,

    -- * Result-type type family for comparison operators
    NullCmpResult,

    -- * Numeric widening
    NumericWidenOp (..),
    widenArithOp,
    WidenResult,

    -- * Division widening (integral × integral → Double)
    DivWidenOp (..),
    divArithOp,
    WidenResultDiv,
) where

import Data.Int (Int32, Int64)
import DataFrame.Internal.Column (Columnable)
import DataFrame.Internal.Types (Promote, PromoteDiv)

{- | Strip one layer of 'Maybe'.

@
BaseType (Maybe a) = a
BaseType a         = a   -- for any non-Maybe type
@
-}
type family BaseType a where
    BaseType (Maybe a) = a
    BaseType a = a

{- | Class for arithmetic binary operations that work transparently over
nullable and non-nullable column types.

The functional dependency @a b -> c@ ensures GHC can infer the result type @c@
from the operand types. The 'OVERLAPPABLE' pragma on the non-nullable instance
ensures the more specific @(Maybe a, Maybe a)@ instance wins when both operands
are nullable.
-}
class
    ( Columnable a
    , Columnable b
    , Columnable c
    ) =>
    NullableArithOp a b c
        | a b -> c
    where
    {- | Lift an arithmetic function over the inner (non-Maybe) values.
    'Nothing' short-circuits: any 'Nothing' operand produces 'Nothing'.
    -}
    nullArithOp ::
        (BaseType a -> BaseType a -> BaseType a) ->
        a ->
        b ->
        c

{- | Compute the result type of a nullable comparison.

@
NullCmpResult (Maybe a) b = Maybe Bool
NullCmpResult a (Maybe b) = Maybe Bool   -- when a is apart from Maybe
NullCmpResult a b         = Bool
@

Used by the comparison operators ('.==', '.<', etc.) so GHC infers the
return type without an explicit annotation.
-}
type family NullCmpResult a b where
    NullCmpResult (Maybe a) b = Maybe Bool
    NullCmpResult a (Maybe b) = Maybe Bool
    NullCmpResult a b = Bool

{- | Class for comparison binary operations that work transparently over
nullable and non-nullable column types.

No functional dependency on @e@: the 'OVERLAPPING'\/'OVERLAPPABLE' pragmas on
instances disambiguate at call sites without a FundDep (which would conflict
when both operands are @Maybe@). GHC selects the unique most-specific instance
from the concrete operand types.
-}
class
    ( Columnable a
    , Columnable b
    , Columnable e
    ) =>
    NullableCmpOp a b e
    where
    {- | Lift a comparison function over the inner values (three-valued logic).
    Returns 'Nothing' when either operand is 'Nothing'.
    -}
    nullCmpOp ::
        (BaseType a -> BaseType a -> Bool) ->
        a ->
        b ->
        e

{- | Non-nullable × Non-nullable: apply directly, no wrapping.
Arithmetic result is @a@; comparison result is @Bool@.
-}
instance
    {-# OVERLAPPABLE #-}
    (Columnable a, a ~ BaseType a) =>
    NullableArithOp a a a
    where
    nullArithOp :: (BaseType a -> BaseType a -> BaseType a) -> a -> a -> a
nullArithOp BaseType a -> BaseType a -> BaseType a
f = a -> a -> a
BaseType a -> BaseType a -> BaseType a
f

instance
    {-# OVERLAPPABLE #-}
    (Columnable a, Columnable Bool, a ~ BaseType a) =>
    NullableCmpOp a a Bool
    where
    nullCmpOp :: (BaseType a -> BaseType a -> Bool) -> a -> a -> Bool
nullCmpOp BaseType a -> BaseType a -> Bool
f = a -> a -> Bool
BaseType a -> BaseType a -> Bool
f

-- | Nullable × Non-nullable: 'Nothing' short-circuits.
instance
    (Columnable a, Columnable (Maybe a)) =>
    NullableArithOp (Maybe a) a (Maybe a)
    where
    nullArithOp :: (BaseType (Maybe a) -> BaseType (Maybe a) -> BaseType (Maybe a))
-> Maybe a -> a -> Maybe a
nullArithOp BaseType (Maybe a) -> BaseType (Maybe a) -> BaseType (Maybe a)
f Maybe a
Nothing a
_ = Maybe a
forall a. Maybe a
Nothing
    nullArithOp BaseType (Maybe a) -> BaseType (Maybe a) -> BaseType (Maybe a)
f (Just a
x) a
y = a -> Maybe a
forall a. a -> Maybe a
Just (BaseType (Maybe a) -> BaseType (Maybe a) -> BaseType (Maybe a)
f a
BaseType (Maybe a)
x a
BaseType (Maybe a)
y)

instance
    (Columnable a, Columnable (Maybe a), Columnable (Maybe Bool)) =>
    NullableCmpOp (Maybe a) a (Maybe Bool)
    where
    nullCmpOp :: (BaseType (Maybe a) -> BaseType (Maybe a) -> Bool)
-> Maybe a -> a -> Maybe Bool
nullCmpOp BaseType (Maybe a) -> BaseType (Maybe a) -> Bool
f Maybe a
Nothing a
_ = Maybe Bool
forall a. Maybe a
Nothing
    nullCmpOp BaseType (Maybe a) -> BaseType (Maybe a) -> Bool
f (Just a
x) a
y = Bool -> Maybe Bool
forall a. a -> Maybe a
Just (BaseType (Maybe a) -> BaseType (Maybe a) -> Bool
f a
BaseType (Maybe a)
x a
BaseType (Maybe a)
y)

-- | Non-nullable × Nullable: 'Nothing' short-circuits.
instance
    ( Columnable a
    , Columnable (Maybe a)
    , a ~ BaseType a
    ) =>
    NullableArithOp a (Maybe a) (Maybe a)
    where
    nullArithOp :: (BaseType a -> BaseType a -> BaseType a) -> a -> Maybe a -> Maybe a
nullArithOp BaseType a -> BaseType a -> BaseType a
f a
_ Maybe a
Nothing = Maybe a
forall a. Maybe a
Nothing
    nullArithOp BaseType a -> BaseType a -> BaseType a
f a
x (Just a
y) = a -> Maybe a
forall a. a -> Maybe a
Just (BaseType a -> BaseType a -> BaseType a
f a
BaseType a
x a
BaseType a
y)

instance
    ( Columnable a
    , Columnable (Maybe a)
    , Columnable (Maybe Bool)
    , a ~ BaseType a
    ) =>
    NullableCmpOp a (Maybe a) (Maybe Bool)
    where
    nullCmpOp :: (BaseType a -> BaseType a -> Bool) -> a -> Maybe a -> Maybe Bool
nullCmpOp BaseType a -> BaseType a -> Bool
f a
_ Maybe a
Nothing = Maybe Bool
forall a. Maybe a
Nothing
    nullCmpOp BaseType a -> BaseType a -> Bool
f a
x (Just a
y) = Bool -> Maybe Bool
forall a. a -> Maybe a
Just (BaseType a -> BaseType a -> Bool
f a
BaseType a
x a
BaseType a
y)

-- | Nullable × Nullable: either 'Nothing' short-circuits.
instance
    {-# OVERLAPPING #-}
    (Columnable a, Columnable (Maybe a)) =>
    NullableArithOp (Maybe a) (Maybe a) (Maybe a)
    where
    nullArithOp :: (BaseType (Maybe a) -> BaseType (Maybe a) -> BaseType (Maybe a))
-> Maybe a -> Maybe a -> Maybe a
nullArithOp BaseType (Maybe a) -> BaseType (Maybe a) -> BaseType (Maybe a)
f Maybe a
Nothing Maybe a
_ = Maybe a
forall a. Maybe a
Nothing
    nullArithOp BaseType (Maybe a) -> BaseType (Maybe a) -> BaseType (Maybe a)
f Maybe a
_ Maybe a
Nothing = Maybe a
forall a. Maybe a
Nothing
    nullArithOp BaseType (Maybe a) -> BaseType (Maybe a) -> BaseType (Maybe a)
f (Just a
x) (Just a
y) = a -> Maybe a
forall a. a -> Maybe a
Just (BaseType (Maybe a) -> BaseType (Maybe a) -> BaseType (Maybe a)
f a
BaseType (Maybe a)
x a
BaseType (Maybe a)
y)

instance
    {-# OVERLAPPING #-}
    (Columnable a, Columnable (Maybe a), Columnable (Maybe Bool)) =>
    NullableCmpOp (Maybe a) (Maybe a) (Maybe Bool)
    where
    nullCmpOp :: (BaseType (Maybe a) -> BaseType (Maybe a) -> Bool)
-> Maybe a -> Maybe a -> Maybe Bool
nullCmpOp BaseType (Maybe a) -> BaseType (Maybe a) -> Bool
f Maybe a
Nothing Maybe a
_ = Maybe Bool
forall a. Maybe a
Nothing
    nullCmpOp BaseType (Maybe a) -> BaseType (Maybe a) -> Bool
f Maybe a
_ Maybe a
Nothing = Maybe Bool
forall a. Maybe a
Nothing
    nullCmpOp BaseType (Maybe a) -> BaseType (Maybe a) -> Bool
f (Just a
x) (Just a
y) = Bool -> Maybe Bool
forall a. a -> Maybe a
Just (BaseType (Maybe a) -> BaseType (Maybe a) -> Bool
f a
BaseType (Maybe a)
x a
BaseType (Maybe a)
y)

-- ---------------------------------------------------------------------------
-- Generalized nullable lift (unary)
-- ---------------------------------------------------------------------------

{- | Lift a unary function over a column expression, propagating 'Nothing'.

When @a@ is non-nullable the function is applied directly; when @a = Maybe x@
the function is applied under the 'Just' and 'Nothing' short-circuits.

Use via 'DataFrame.Functions.nullLift'.
-}

{- | Compute the result type of a nullable unary lift.

@
NullLift1Result (Maybe a) r = Maybe r
NullLift1Result a         r = r        -- for any non-Maybe a
@

Used by 'DataFrame.Functions.nullLift' so GHC can infer the return type
without an explicit annotation.
-}
type family NullLift1Result a r where
    NullLift1Result (Maybe a) r = Maybe r
    NullLift1Result a r = r

class
    ( Columnable a
    , Columnable r
    , Columnable c
    ) =>
    NullLift1Op a r c
    where
    applyNull1 :: (BaseType a -> r) -> a -> c

-- | Non-nullable: apply directly.
instance
    {-# OVERLAPPABLE #-}
    (Columnable a, Columnable r, a ~ BaseType a) =>
    NullLift1Op a r r
    where
    applyNull1 :: (BaseType a -> r) -> a -> r
applyNull1 BaseType a -> r
f = a -> r
BaseType a -> r
f

-- | Nullable: propagate 'Nothing'.
instance
    {-# OVERLAPPING #-}
    (Columnable a, Columnable r, Columnable (Maybe r)) =>
    NullLift1Op (Maybe a) r (Maybe r)
    where
    applyNull1 :: (BaseType (Maybe a) -> r) -> Maybe a -> Maybe r
applyNull1 BaseType (Maybe a) -> r
_ Maybe a
Nothing = Maybe r
forall a. Maybe a
Nothing
    applyNull1 BaseType (Maybe a) -> r
f (Just a
x) = r -> Maybe r
forall a. a -> Maybe a
Just (BaseType (Maybe a) -> r
f a
BaseType (Maybe a)
x)

-- ---------------------------------------------------------------------------
-- Generalized nullable lift (binary)
-- ---------------------------------------------------------------------------

{- | Lift a binary function over two column expressions, propagating 'Nothing'.

The four combinations:

* @(a, b)@               — both non-nullable: result is @r@
* @(Maybe a, b)@         — left nullable: result is @Maybe r@
* @(a, Maybe b)@         — right nullable: result is @Maybe r@
* @(Maybe a, Maybe b)@   — both nullable: result is @Maybe r@

Use via 'DataFrame.Functions.nullLift2'.
-}

{- | Compute the result type of a nullable binary lift.

@
NullLift2Result (Maybe a) b         r = Maybe r
NullLift2Result a         (Maybe b) r = Maybe r   -- when a is apart from Maybe
NullLift2Result a         b         r = r
@

Used by 'DataFrame.Functions.nullLift2' so GHC can infer the return type.
-}
type family NullLift2Result a b r where
    NullLift2Result (Maybe a) b r = Maybe r
    NullLift2Result a (Maybe b) r = Maybe r
    NullLift2Result a b r = r

class
    ( Columnable a
    , Columnable b
    , Columnable r
    , Columnable c
    ) =>
    NullLift2Op a b r c
    where
    applyNull2 :: (BaseType a -> BaseType b -> r) -> a -> b -> c

-- | Both non-nullable: apply directly.
instance
    {-# OVERLAPPABLE #-}
    (Columnable a, Columnable b, Columnable r, a ~ BaseType a, b ~ BaseType b) =>
    NullLift2Op a b r r
    where
    applyNull2 :: (BaseType a -> BaseType b -> r) -> a -> b -> r
applyNull2 BaseType a -> BaseType b -> r
f = a -> b -> r
BaseType a -> BaseType b -> r
f

-- | Left nullable: 'Nothing' short-circuits.
instance
    {-# OVERLAPPABLE #-}
    (Columnable a, Columnable b, Columnable r, Columnable (Maybe r), b ~ BaseType b) =>
    NullLift2Op (Maybe a) b r (Maybe r)
    where
    applyNull2 :: (BaseType (Maybe a) -> BaseType b -> r) -> Maybe a -> b -> Maybe r
applyNull2 BaseType (Maybe a) -> BaseType b -> r
_ Maybe a
Nothing b
_ = Maybe r
forall a. Maybe a
Nothing
    applyNull2 BaseType (Maybe a) -> BaseType b -> r
f (Just a
x) b
y = r -> Maybe r
forall a. a -> Maybe a
Just (BaseType (Maybe a) -> BaseType b -> r
f a
BaseType (Maybe a)
x b
BaseType b
y)

-- | Right nullable: 'Nothing' short-circuits.
instance
    {-# OVERLAPPABLE #-}
    (Columnable a, Columnable b, Columnable r, Columnable (Maybe r), a ~ BaseType a) =>
    NullLift2Op a (Maybe b) r (Maybe r)
    where
    applyNull2 :: (BaseType a -> BaseType (Maybe b) -> r) -> a -> Maybe b -> Maybe r
applyNull2 BaseType a -> BaseType (Maybe b) -> r
_ a
_ Maybe b
Nothing = Maybe r
forall a. Maybe a
Nothing
    applyNull2 BaseType a -> BaseType (Maybe b) -> r
f a
x (Just b
y) = r -> Maybe r
forall a. a -> Maybe a
Just (BaseType a -> BaseType (Maybe b) -> r
f a
BaseType a
x b
BaseType (Maybe b)
y)

-- | Both nullable: either 'Nothing' short-circuits.
instance
    {-# OVERLAPPING #-}
    (Columnable a, Columnable b, Columnable r, Columnable (Maybe r)) =>
    NullLift2Op (Maybe a) (Maybe b) r (Maybe r)
    where
    applyNull2 :: (BaseType (Maybe a) -> BaseType (Maybe b) -> r)
-> Maybe a -> Maybe b -> Maybe r
applyNull2 BaseType (Maybe a) -> BaseType (Maybe b) -> r
_ Maybe a
Nothing Maybe b
_ = Maybe r
forall a. Maybe a
Nothing
    applyNull2 BaseType (Maybe a) -> BaseType (Maybe b) -> r
_ Maybe a
_ Maybe b
Nothing = Maybe r
forall a. Maybe a
Nothing
    applyNull2 BaseType (Maybe a) -> BaseType (Maybe b) -> r
f (Just a
x) (Just b
y) = r -> Maybe r
forall a. a -> Maybe a
Just (BaseType (Maybe a) -> BaseType (Maybe b) -> r
f a
BaseType (Maybe a)
x b
BaseType (Maybe b)
y)

-- ---------------------------------------------------------------------------
-- Numeric widening
-- ---------------------------------------------------------------------------

{- | Widen two numeric base types to their promoted common type.

When @a ~ b@ the coercions are identity; otherwise one operand is widened
(e.g. 'Int' → 'Double').
-}
class (Columnable (Promote a b)) => NumericWidenOp a b where
    widen1 :: a -> Promote a b
    widen2 :: b -> Promote a b

-- | Same type: identity coercions.
instance {-# OVERLAPPING #-} (Columnable a) => NumericWidenOp a a where
    widen1 :: a -> Promote a a
widen1 = a -> a
a -> Promote a a
forall a. a -> a
id
    widen2 :: a -> Promote a a
widen2 = a -> a
a -> Promote a a
forall a. a -> a
id

instance NumericWidenOp Int Double where widen1 :: Int -> Promote Int Double
widen1 = Int -> Double
Int -> Promote Int Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral; widen2 :: Double -> Promote Int Double
widen2 = Double -> Double
Double -> Promote Int Double
forall a. a -> a
id
instance NumericWidenOp Double Int where
    widen1 :: Double -> Promote Double Int
widen1 = Double -> Double
Double -> Promote Double Int
forall a. a -> a
id
    widen2 :: Int -> Promote Double Int
widen2 = Int -> Double
Int -> Promote Double Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance NumericWidenOp Float Double where widen1 :: Float -> Promote Float Double
widen1 = Float -> Double
Float -> Promote Float Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac; widen2 :: Double -> Promote Float Double
widen2 = Double -> Double
Double -> Promote Float Double
forall a. a -> a
id
instance NumericWidenOp Double Float where
    widen1 :: Double -> Promote Double Float
widen1 = Double -> Double
Double -> Promote Double Float
forall a. a -> a
id
    widen2 :: Float -> Promote Double Float
widen2 = Float -> Double
Float -> Promote Double Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac
instance NumericWidenOp Int Float where widen1 :: Int -> Promote Int Float
widen1 = Int -> Float
Int -> Promote Int Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral; widen2 :: Float -> Promote Int Float
widen2 = Float -> Float
Float -> Promote Int Float
forall a. a -> a
id
instance NumericWidenOp Float Int where
    widen1 :: Float -> Promote Float Int
widen1 = Float -> Float
Float -> Promote Float Int
forall a. a -> a
id
    widen2 :: Int -> Promote Float Int
widen2 = Int -> Float
Int -> Promote Float Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Apply an arithmetic function after widening both operands to their common type.
widenArithOp ::
    forall a b.
    (NumericWidenOp a b) =>
    (Promote a b -> Promote a b -> Promote a b) ->
    a ->
    b ->
    Promote a b
widenArithOp :: forall a b.
NumericWidenOp a b =>
(Promote a b -> Promote a b -> Promote a b)
-> a -> b -> Promote a b
widenArithOp Promote a b -> Promote a b -> Promote a b
f a
x b
y = Promote a b -> Promote a b -> Promote a b
f (forall a b. NumericWidenOp a b => a -> Promote a b
widen1 @a @b a
x) (forall a b. NumericWidenOp a b => b -> Promote a b
widen2 @a @b b
y)

-- | Result type of a widening binary operator, accounting for nullable wrappers.
type WidenResult a b = NullLift2Result a b (Promote (BaseType a) (BaseType b))

-- ---------------------------------------------------------------------------
-- Division widening (integral × integral → Double)
-- ---------------------------------------------------------------------------

{- | Like 'NumericWidenOp' but uses 'PromoteDiv': integral×integral → Double.
Floating types still dominate (Double > Float), and any two integral types
(same or mixed) are both widened to Double.
-}
class (Columnable (PromoteDiv a b)) => DivWidenOp a b where
    divWiden1 :: a -> PromoteDiv a b
    divWiden2 :: b -> PromoteDiv a b

-- Floating same-type (identity)
instance DivWidenOp Double Double where divWiden1 :: Double -> PromoteDiv Double Double
divWiden1 = Double -> Double
Double -> PromoteDiv Double Double
forall a. a -> a
id; divWiden2 :: Double -> PromoteDiv Double Double
divWiden2 = Double -> Double
Double -> PromoteDiv Double Double
forall a. a -> a
id
instance DivWidenOp Float Float where divWiden1 :: Float -> PromoteDiv Float Float
divWiden1 = Float -> Float
Float -> PromoteDiv Float Float
forall a. a -> a
id; divWiden2 :: Float -> PromoteDiv Float Float
divWiden2 = Float -> Float
Float -> PromoteDiv Float Float
forall a. a -> a
id

-- Mixed Double/Float
instance DivWidenOp Double Float where divWiden1 :: Double -> PromoteDiv Double Float
divWiden1 = Double -> Double
Double -> PromoteDiv Double Float
forall a. a -> a
id; divWiden2 :: Float -> PromoteDiv Double Float
divWiden2 = Float -> Double
Float -> PromoteDiv Double Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac
instance DivWidenOp Float Double where divWiden1 :: Float -> PromoteDiv Float Double
divWiden1 = Float -> Double
Float -> PromoteDiv Float Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac; divWiden2 :: Double -> PromoteDiv Float Double
divWiden2 = Double -> Double
Double -> PromoteDiv Float Double
forall a. a -> a
id

-- Double beats integral
instance DivWidenOp Double Int where divWiden1 :: Double -> PromoteDiv Double Int
divWiden1 = Double -> Double
Double -> PromoteDiv Double Int
forall a. a -> a
id; divWiden2 :: Int -> PromoteDiv Double Int
divWiden2 = Int -> Double
Int -> PromoteDiv Double Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance DivWidenOp Int Double where divWiden1 :: Int -> PromoteDiv Int Double
divWiden1 = Int -> Double
Int -> PromoteDiv Int Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral; divWiden2 :: Double -> PromoteDiv Int Double
divWiden2 = Double -> Double
Double -> PromoteDiv Int Double
forall a. a -> a
id
instance DivWidenOp Double Int32 where divWiden1 :: Double -> PromoteDiv Double Int32
divWiden1 = Double -> Double
Double -> PromoteDiv Double Int32
forall a. a -> a
id; divWiden2 :: Int32 -> PromoteDiv Double Int32
divWiden2 = Int32 -> Double
Int32 -> PromoteDiv Double Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance DivWidenOp Int32 Double where divWiden1 :: Int32 -> PromoteDiv Int32 Double
divWiden1 = Int32 -> Double
Int32 -> PromoteDiv Int32 Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral; divWiden2 :: Double -> PromoteDiv Int32 Double
divWiden2 = Double -> Double
Double -> PromoteDiv Int32 Double
forall a. a -> a
id
instance DivWidenOp Double Int64 where divWiden1 :: Double -> PromoteDiv Double Int64
divWiden1 = Double -> Double
Double -> PromoteDiv Double Int64
forall a. a -> a
id; divWiden2 :: Int64 -> PromoteDiv Double Int64
divWiden2 = Int64 -> Double
Int64 -> PromoteDiv Double Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance DivWidenOp Int64 Double where divWiden1 :: Int64 -> PromoteDiv Int64 Double
divWiden1 = Int64 -> Double
Int64 -> PromoteDiv Int64 Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral; divWiden2 :: Double -> PromoteDiv Int64 Double
divWiden2 = Double -> Double
Double -> PromoteDiv Int64 Double
forall a. a -> a
id

-- Float beats integral
instance DivWidenOp Float Int where divWiden1 :: Float -> PromoteDiv Float Int
divWiden1 = Float -> Float
Float -> PromoteDiv Float Int
forall a. a -> a
id; divWiden2 :: Int -> PromoteDiv Float Int
divWiden2 = Int -> Float
Int -> PromoteDiv Float Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance DivWidenOp Int Float where divWiden1 :: Int -> PromoteDiv Int Float
divWiden1 = Int -> Float
Int -> PromoteDiv Int Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral; divWiden2 :: Float -> PromoteDiv Int Float
divWiden2 = Float -> Float
Float -> PromoteDiv Int Float
forall a. a -> a
id
instance DivWidenOp Float Int32 where divWiden1 :: Float -> PromoteDiv Float Int32
divWiden1 = Float -> Float
Float -> PromoteDiv Float Int32
forall a. a -> a
id; divWiden2 :: Int32 -> PromoteDiv Float Int32
divWiden2 = Int32 -> Float
Int32 -> PromoteDiv Float Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance DivWidenOp Int32 Float where divWiden1 :: Int32 -> PromoteDiv Int32 Float
divWiden1 = Int32 -> Float
Int32 -> PromoteDiv Int32 Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral; divWiden2 :: Float -> PromoteDiv Int32 Float
divWiden2 = Float -> Float
Float -> PromoteDiv Int32 Float
forall a. a -> a
id
instance DivWidenOp Float Int64 where divWiden1 :: Float -> PromoteDiv Float Int64
divWiden1 = Float -> Float
Float -> PromoteDiv Float Int64
forall a. a -> a
id; divWiden2 :: Int64 -> PromoteDiv Float Int64
divWiden2 = Int64 -> Float
Int64 -> PromoteDiv Float Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance DivWidenOp Int64 Float where divWiden1 :: Int64 -> PromoteDiv Int64 Float
divWiden1 = Int64 -> Float
Int64 -> PromoteDiv Int64 Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral; divWiden2 :: Float -> PromoteDiv Int64 Float
divWiden2 = Float -> Float
Float -> PromoteDiv Int64 Float
forall a. a -> a
id

-- Integral × integral → Double
instance DivWidenOp Int Int where
    divWiden1 :: Int -> PromoteDiv Int Int
divWiden1 = Int -> Double
Int -> PromoteDiv Int Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    divWiden2 :: Int -> PromoteDiv Int Int
divWiden2 = Int -> Double
Int -> PromoteDiv Int Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance DivWidenOp Int32 Int32 where
    divWiden1 :: Int32 -> PromoteDiv Int32 Int32
divWiden1 = Int32 -> Double
Int32 -> PromoteDiv Int32 Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    divWiden2 :: Int32 -> PromoteDiv Int32 Int32
divWiden2 = Int32 -> Double
Int32 -> PromoteDiv Int32 Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance DivWidenOp Int64 Int64 where
    divWiden1 :: Int64 -> PromoteDiv Int64 Int64
divWiden1 = Int64 -> Double
Int64 -> PromoteDiv Int64 Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    divWiden2 :: Int64 -> PromoteDiv Int64 Int64
divWiden2 = Int64 -> Double
Int64 -> PromoteDiv Int64 Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance DivWidenOp Int Int32 where
    divWiden1 :: Int -> PromoteDiv Int Int32
divWiden1 = Int -> Double
Int -> PromoteDiv Int Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    divWiden2 :: Int32 -> PromoteDiv Int Int32
divWiden2 = Int32 -> Double
Int32 -> PromoteDiv Int Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance DivWidenOp Int32 Int where
    divWiden1 :: Int32 -> PromoteDiv Int32 Int
divWiden1 = Int32 -> Double
Int32 -> PromoteDiv Int32 Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    divWiden2 :: Int -> PromoteDiv Int32 Int
divWiden2 = Int -> Double
Int -> PromoteDiv Int32 Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance DivWidenOp Int Int64 where
    divWiden1 :: Int -> PromoteDiv Int Int64
divWiden1 = Int -> Double
Int -> PromoteDiv Int Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    divWiden2 :: Int64 -> PromoteDiv Int Int64
divWiden2 = Int64 -> Double
Int64 -> PromoteDiv Int Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance DivWidenOp Int64 Int where
    divWiden1 :: Int64 -> PromoteDiv Int64 Int
divWiden1 = Int64 -> Double
Int64 -> PromoteDiv Int64 Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    divWiden2 :: Int -> PromoteDiv Int64 Int
divWiden2 = Int -> Double
Int -> PromoteDiv Int64 Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance DivWidenOp Int32 Int64 where
    divWiden1 :: Int32 -> PromoteDiv Int32 Int64
divWiden1 = Int32 -> Double
Int32 -> PromoteDiv Int32 Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    divWiden2 :: Int64 -> PromoteDiv Int32 Int64
divWiden2 = Int64 -> Double
Int64 -> PromoteDiv Int32 Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance DivWidenOp Int64 Int32 where
    divWiden1 :: Int64 -> PromoteDiv Int64 Int32
divWiden1 = Int64 -> Double
Int64 -> PromoteDiv Int64 Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    divWiden2 :: Int32 -> PromoteDiv Int64 Int32
divWiden2 = Int32 -> Double
Int32 -> PromoteDiv Int64 Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Apply an arithmetic function after widening both operands via 'PromoteDiv'.
divArithOp ::
    forall a b.
    (DivWidenOp a b) =>
    (PromoteDiv a b -> PromoteDiv a b -> PromoteDiv a b) ->
    a ->
    b ->
    PromoteDiv a b
divArithOp :: forall a b.
DivWidenOp a b =>
(PromoteDiv a b -> PromoteDiv a b -> PromoteDiv a b)
-> a -> b -> PromoteDiv a b
divArithOp PromoteDiv a b -> PromoteDiv a b -> PromoteDiv a b
f a
x b
y = PromoteDiv a b -> PromoteDiv a b -> PromoteDiv a b
f (forall a b. DivWidenOp a b => a -> PromoteDiv a b
divWiden1 @a @b a
x) (forall a b. DivWidenOp a b => b -> PromoteDiv a b
divWiden2 @a @b b
y)

-- | Result type of a division-widening binary operator, accounting for nullable wrappers.
type WidenResultDiv a b =
    NullLift2Result a b (PromoteDiv (BaseType a) (BaseType b))