{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

module DataFrame.Internal.Types where

import Data.Int (Int16, Int32, Int64, Int8)
import Data.Kind (Constraint, Type)
import Data.Typeable (Typeable)
import qualified Data.Vector.Unboxed as VU
import Data.Word (Word16, Word32, Word64, Word8)

type Columnable' a = (Typeable a, Show a, Eq a)

{- | Inline replacement for @Data.These.These@ to keep @dataframe-core@ free
of the @these@ package dependency. Only the three constructors and the
derived classes are used internally.
-}
data These a b = This a | That b | These a b
    deriving (These a b -> These a b -> Bool
(These a b -> These a b -> Bool)
-> (These a b -> These a b -> Bool) -> Eq (These a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => These a b -> These a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => These a b -> These a b -> Bool
== :: These a b -> These a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => These a b -> These a b -> Bool
/= :: These a b -> These a b -> Bool
Eq, Eq (These a b)
Eq (These a b) =>
(These a b -> These a b -> Ordering)
-> (These a b -> These a b -> Bool)
-> (These a b -> These a b -> Bool)
-> (These a b -> These a b -> Bool)
-> (These a b -> These a b -> Bool)
-> (These a b -> These a b -> These a b)
-> (These a b -> These a b -> These a b)
-> Ord (These a b)
These a b -> These a b -> Bool
These a b -> These a b -> Ordering
These a b -> These a b -> These a b
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a b. (Ord a, Ord b) => Eq (These a b)
forall a b. (Ord a, Ord b) => These a b -> These a b -> Bool
forall a b. (Ord a, Ord b) => These a b -> These a b -> Ordering
forall a b. (Ord a, Ord b) => These a b -> These a b -> These a b
$ccompare :: forall a b. (Ord a, Ord b) => These a b -> These a b -> Ordering
compare :: These a b -> These a b -> Ordering
$c< :: forall a b. (Ord a, Ord b) => These a b -> These a b -> Bool
< :: These a b -> These a b -> Bool
$c<= :: forall a b. (Ord a, Ord b) => These a b -> These a b -> Bool
<= :: These a b -> These a b -> Bool
$c> :: forall a b. (Ord a, Ord b) => These a b -> These a b -> Bool
> :: These a b -> These a b -> Bool
$c>= :: forall a b. (Ord a, Ord b) => These a b -> These a b -> Bool
>= :: These a b -> These a b -> Bool
$cmax :: forall a b. (Ord a, Ord b) => These a b -> These a b -> These a b
max :: These a b -> These a b -> These a b
$cmin :: forall a b. (Ord a, Ord b) => These a b -> These a b -> These a b
min :: These a b -> These a b -> These a b
Ord, Int -> These a b -> ShowS
[These a b] -> ShowS
These a b -> String
(Int -> These a b -> ShowS)
-> (These a b -> String)
-> ([These a b] -> ShowS)
-> Show (These a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> These a b -> ShowS
forall a b. (Show a, Show b) => [These a b] -> ShowS
forall a b. (Show a, Show b) => These a b -> String
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> These a b -> ShowS
showsPrec :: Int -> These a b -> ShowS
$cshow :: forall a b. (Show a, Show b) => These a b -> String
show :: These a b -> String
$cshowList :: forall a b. (Show a, Show b) => [These a b] -> ShowS
showList :: [These a b] -> ShowS
Show, ReadPrec [These a b]
ReadPrec (These a b)
Int -> ReadS (These a b)
ReadS [These a b]
(Int -> ReadS (These a b))
-> ReadS [These a b]
-> ReadPrec (These a b)
-> ReadPrec [These a b]
-> Read (These a b)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall a b. (Read a, Read b) => ReadPrec [These a b]
forall a b. (Read a, Read b) => ReadPrec (These a b)
forall a b. (Read a, Read b) => Int -> ReadS (These a b)
forall a b. (Read a, Read b) => ReadS [These a b]
$creadsPrec :: forall a b. (Read a, Read b) => Int -> ReadS (These a b)
readsPrec :: Int -> ReadS (These a b)
$creadList :: forall a b. (Read a, Read b) => ReadS [These a b]
readList :: ReadS [These a b]
$creadPrec :: forall a b. (Read a, Read b) => ReadPrec (These a b)
readPrec :: ReadPrec (These a b)
$creadListPrec :: forall a b. (Read a, Read b) => ReadPrec [These a b]
readListPrec :: ReadPrec [These a b]
Read, (forall a b. (a -> b) -> These a a -> These a b)
-> (forall a b. a -> These a b -> These a a) -> Functor (These a)
forall a b. a -> These a b -> These a a
forall a b. (a -> b) -> These a a -> These a b
forall a a b. a -> These a b -> These a a
forall a a b. (a -> b) -> These a a -> These a b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a a b. (a -> b) -> These a a -> These a b
fmap :: forall a b. (a -> b) -> These a a -> These a b
$c<$ :: forall a a b. a -> These a b -> These a a
<$ :: forall a b. a -> These a b -> These a a
Functor, (forall m. Monoid m => These a m -> m)
-> (forall m a. Monoid m => (a -> m) -> These a a -> m)
-> (forall m a. Monoid m => (a -> m) -> These a a -> m)
-> (forall a b. (a -> b -> b) -> b -> These a a -> b)
-> (forall a b. (a -> b -> b) -> b -> These a a -> b)
-> (forall b a. (b -> a -> b) -> b -> These a a -> b)
-> (forall b a. (b -> a -> b) -> b -> These a a -> b)
-> (forall a. (a -> a -> a) -> These a a -> a)
-> (forall a. (a -> a -> a) -> These a a -> a)
-> (forall a. These a a -> [a])
-> (forall a. These a a -> Bool)
-> (forall a. These a a -> Int)
-> (forall a. Eq a => a -> These a a -> Bool)
-> (forall a. Ord a => These a a -> a)
-> (forall a. Ord a => These a a -> a)
-> (forall a. Num a => These a a -> a)
-> (forall a. Num a => These a a -> a)
-> Foldable (These a)
forall a. Eq a => a -> These a a -> Bool
forall a. Num a => These a a -> a
forall a. Ord a => These a a -> a
forall m. Monoid m => These a m -> m
forall a. These a a -> Bool
forall a. These a a -> Int
forall a. These a a -> [a]
forall a. (a -> a -> a) -> These a a -> a
forall a a. Eq a => a -> These a a -> Bool
forall a a. Num a => These a a -> a
forall a a. Ord a => These a a -> a
forall a m. Monoid m => These a m -> m
forall m a. Monoid m => (a -> m) -> These a a -> m
forall a a. These a a -> Bool
forall a a. These a a -> Int
forall a a. These a a -> [a]
forall b a. (b -> a -> b) -> b -> These a a -> b
forall a b. (a -> b -> b) -> b -> These a a -> b
forall a a. (a -> a -> a) -> These a a -> a
forall a m a. Monoid m => (a -> m) -> These a a -> m
forall a b a. (b -> a -> b) -> b -> These a a -> b
forall a a b. (a -> b -> b) -> b -> These a a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall a m. Monoid m => These a m -> m
fold :: forall m. Monoid m => These a m -> m
$cfoldMap :: forall a m a. Monoid m => (a -> m) -> These a a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> These a a -> m
$cfoldMap' :: forall a m a. Monoid m => (a -> m) -> These a a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> These a a -> m
$cfoldr :: forall a a b. (a -> b -> b) -> b -> These a a -> b
foldr :: forall a b. (a -> b -> b) -> b -> These a a -> b
$cfoldr' :: forall a a b. (a -> b -> b) -> b -> These a a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> These a a -> b
$cfoldl :: forall a b a. (b -> a -> b) -> b -> These a a -> b
foldl :: forall b a. (b -> a -> b) -> b -> These a a -> b
$cfoldl' :: forall a b a. (b -> a -> b) -> b -> These a a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> These a a -> b
$cfoldr1 :: forall a a. (a -> a -> a) -> These a a -> a
foldr1 :: forall a. (a -> a -> a) -> These a a -> a
$cfoldl1 :: forall a a. (a -> a -> a) -> These a a -> a
foldl1 :: forall a. (a -> a -> a) -> These a a -> a
$ctoList :: forall a a. These a a -> [a]
toList :: forall a. These a a -> [a]
$cnull :: forall a a. These a a -> Bool
null :: forall a. These a a -> Bool
$clength :: forall a a. These a a -> Int
length :: forall a. These a a -> Int
$celem :: forall a a. Eq a => a -> These a a -> Bool
elem :: forall a. Eq a => a -> These a a -> Bool
$cmaximum :: forall a a. Ord a => These a a -> a
maximum :: forall a. Ord a => These a a -> a
$cminimum :: forall a a. Ord a => These a a -> a
minimum :: forall a. Ord a => These a a -> a
$csum :: forall a a. Num a => These a a -> a
sum :: forall a. Num a => These a a -> a
$cproduct :: forall a a. Num a => These a a -> a
product :: forall a. Num a => These a a -> a
Foldable, Functor (These a)
Foldable (These a)
(Functor (These a), Foldable (These a)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> These a a -> f (These a b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    These a (f a) -> f (These a a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> These a a -> m (These a b))
-> (forall (m :: * -> *) a.
    Monad m =>
    These a (m a) -> m (These a a))
-> Traversable (These a)
forall a. Functor (These a)
forall a. Foldable (These a)
forall a (m :: * -> *) a. Monad m => These a (m a) -> m (These a a)
forall a (f :: * -> *) a.
Applicative f =>
These a (f a) -> f (These a a)
forall a (m :: * -> *) a b.
Monad m =>
(a -> m b) -> These a a -> m (These a b)
forall a (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> These a a -> f (These a b)
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => These a (m a) -> m (These a a)
forall (f :: * -> *) a.
Applicative f =>
These a (f a) -> f (These a a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> These a a -> m (These a b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> These a a -> f (These a b)
$ctraverse :: forall a (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> These a a -> f (These a b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> These a a -> f (These a b)
$csequenceA :: forall a (f :: * -> *) a.
Applicative f =>
These a (f a) -> f (These a a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
These a (f a) -> f (These a a)
$cmapM :: forall a (m :: * -> *) a b.
Monad m =>
(a -> m b) -> These a a -> m (These a b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> These a a -> m (These a b)
$csequence :: forall a (m :: * -> *) a. Monad m => These a (m a) -> m (These a a)
sequence :: forall (m :: * -> *) a. Monad m => These a (m a) -> m (These a a)
Traversable)

{- | A type with column representations used to select the
"right" representation when specializing the `toColumn` function.
-}
data Rep
    = RBoxed
    | RUnboxed
    | RNullableBoxed

-- | Type-level if statement.
type family If (cond :: Bool) (yes :: k) (no :: k) :: k where
    If 'True yes _ = yes
    If 'False _ no = no

-- | All unboxable types (according to the `vector` package).
type family Unboxable (a :: Type) :: Bool where
    Unboxable Int = 'True
    Unboxable Int8 = 'True
    Unboxable Int16 = 'True
    Unboxable Int32 = 'True
    Unboxable Int64 = 'True
    Unboxable Word = 'True
    Unboxable Word8 = 'True
    Unboxable Word16 = 'True
    Unboxable Word32 = 'True
    Unboxable Word64 = 'True
    Unboxable Char = 'True
    Unboxable Bool = 'True
    Unboxable Double = 'True
    Unboxable Float = 'True
    Unboxable _ = 'False

type family Numeric (a :: Type) :: Bool where
    Numeric Integer = 'True
    Numeric Int = 'True
    Numeric Int8 = 'True
    Numeric Int16 = 'True
    Numeric Int32 = 'True
    Numeric Int64 = 'True
    Numeric Word = 'True
    Numeric Word8 = 'True
    Numeric Word16 = 'True
    Numeric Word32 = 'True
    Numeric Word64 = 'True
    Numeric Double = 'True
    Numeric Float = 'True
    Numeric _ = 'False

-- | Compute the column representation tag for any 'a'.
type family KindOf a :: Rep where
    KindOf (Maybe a) = 'RNullableBoxed
    KindOf a = If (Unboxable a) 'RUnboxed 'RBoxed

-- | Type-level boolean for constraint/type comparison.
data SBool (b :: Bool) where
    STrue :: SBool 'True
    SFalse :: SBool 'False

-- | The runtime witness for our type-level branching.
class SBoolI (b :: Bool) where
    sbool :: SBool b

instance SBoolI 'True where sbool :: SBool 'True
sbool = SBool 'True
STrue
instance SBoolI 'False where sbool :: SBool 'False
sbool = SBool 'False
SFalse

-- | Runtime witness for whether @a@ is unboxable.
sUnbox :: forall a. (SBoolI (Unboxable a)) => SBool (Unboxable a)
sUnbox :: forall a. SBoolI (Unboxable a) => SBool (Unboxable a)
sUnbox = forall (b :: Bool). SBoolI b => SBool b
sbool @(Unboxable a)

sNumeric :: forall a. (SBoolI (Numeric a)) => SBool (Numeric a)
sNumeric :: forall a. SBoolI (Numeric a) => SBool (Numeric a)
sNumeric = forall (b :: Bool). SBoolI b => SBool b
sbool @(Numeric a)

type family When (flag :: Bool) (c :: Constraint) :: Constraint where
    When 'True c = c
    When 'False c = ()

type UnboxIf a = When (Unboxable a) (VU.Unbox a)

type family IntegralTypes (a :: Type) :: Bool where
    IntegralTypes Integer = 'True
    IntegralTypes Int = 'True
    IntegralTypes Int8 = 'True
    IntegralTypes Int16 = 'True
    IntegralTypes Int32 = 'True
    IntegralTypes Int64 = 'True
    IntegralTypes Word = 'True
    IntegralTypes Word8 = 'True
    IntegralTypes Word16 = 'True
    IntegralTypes Word32 = 'True
    IntegralTypes Word64 = 'True
    IntegralTypes _ = 'False

sIntegral :: forall a. (SBoolI (IntegralTypes a)) => SBool (IntegralTypes a)
sIntegral :: forall a. SBoolI (IntegralTypes a) => SBool (IntegralTypes a)
sIntegral = forall (b :: Bool). SBoolI b => SBool b
sbool @(IntegralTypes a)

type IntegralIf a = When (IntegralTypes a) (Integral a)

type family FloatingTypes (a :: Type) :: Bool where
    FloatingTypes Float = 'True
    FloatingTypes Double = 'True
    FloatingTypes _ = 'False

sFloating :: forall a. (SBoolI (FloatingTypes a)) => SBool (FloatingTypes a)
sFloating :: forall a. SBoolI (FloatingTypes a) => SBool (FloatingTypes a)
sFloating = forall (b :: Bool). SBoolI b => SBool b
sbool @(FloatingTypes a)

type FloatingIf a = When (FloatingTypes a) (Real a, Fractional a)

{- | Numeric type promotion: resolves the common type for mixed arithmetic.
Double dominates over Float/Int; Float dominates over Int; same types stay unchanged.
-}
type family Promote (a :: Type) (b :: Type) :: Type where
    Promote a a = a
    Promote Double _ = Double
    Promote _ Double = Double
    Promote Float _ = Float
    Promote _ Float = Float
    Promote Int64 _ = Int64
    Promote _ Int64 = Int64
    Promote Int32 _ = Int32
    Promote _ Int32 = Int32
    Promote a _ = a

{- | Like 'Promote', but integral × integral → Double for use with './' .
Double\/Float still dominate; any two integral types (same or mixed) become Double.
-}
type family PromoteDiv (a :: Type) (b :: Type) :: Type where
    PromoteDiv Double _ = Double
    PromoteDiv _ Double = Double
    PromoteDiv Float _ = Float
    PromoteDiv _ Float = Float
    PromoteDiv _ _ = Double