{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE Strict #-}
module DataFrame.Internal.Types where

import Data.Int ( Int8, Int16, Int32, Int64 )
import Data.Kind (Type)
import Data.Maybe (fromMaybe)
import Data.Typeable (Typeable, type (:~:) (..))
import Data.Word ( Word8, Word16, Word32, Word64 )
import Type.Reflection (TypeRep, typeOf, typeRep)
import Data.Type.Equality (TestEquality(..))

-- We need an "Object" type as an intermediate representation
-- for rows. Useful for things like sorting and function application.
type Columnable a = (Typeable a, Show a, Ord a, Eq a)

data RowValue where
    Value :: (Columnable a) => a -> RowValue

instance Eq RowValue where
    (==) :: RowValue -> RowValue -> Bool
    (Value a
a) == :: RowValue -> RowValue -> Bool
== (Value a
b) = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ do
        a :~: a
Refl <- TypeRep a -> TypeRep a -> Maybe (a :~: a)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (a -> TypeRep a
forall a. Typeable a => a -> TypeRep a
typeOf a
a) (a -> TypeRep a
forall a. Typeable a => a -> TypeRep a
typeOf a
b)
        Bool -> Maybe Bool
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a
b

instance Ord RowValue where
    (<=) :: RowValue -> RowValue -> Bool
    (Value a
a) <= :: RowValue -> RowValue -> Bool
<= (Value a
b) = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ do
        a :~: a
Refl <- TypeRep a -> TypeRep a -> Maybe (a :~: a)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (a -> TypeRep a
forall a. Typeable a => a -> TypeRep a
typeOf a
a) (a -> TypeRep a
forall a. Typeable a => a -> TypeRep a
typeOf a
b)
        Bool -> Maybe Bool
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
a
b

instance Show RowValue where
    show :: RowValue -> String
    show :: RowValue -> String
show (Value a
a) = a -> String
forall a. Show a => a -> String
show a
a

toRowValue :: forall a . (Columnable a) => a -> RowValue
toRowValue :: forall a. Columnable a => a -> RowValue
toRowValue =  a -> RowValue
forall a. Columnable a => a -> RowValue
Value

-- | Essentially a "functor" instance of our type-erased Column.
class Transformable a where
  transform :: forall b c . (Columnable b, Columnable c) => (b -> c) -> a -> Maybe a

-- Convenience functions for types.
unboxableTypes :: TypeRepList '[Int, Int8, Int16, Int32, Int64,
                                Word, Word8, Word16, Word32, Word64,
                                Char, Double, Float, Bool]
unboxableTypes :: TypeRepList
  '[Int, Int8, Int16, Int32, Int64, Word, Word8, Word16, Word32,
    Word64, Char, Double, Float, Bool]
unboxableTypes = TypeRep Int
-> TypeRepList
     '[Int8, Int16, Int32, Int64, Word, Word8, Word16, Word32, Word64,
       Char, Double, Float, Bool]
-> TypeRepList
     '[Int, Int8, Int16, Int32, Int64, Word, Word8, Word16, Word32,
       Word64, Char, Double, Float, Bool]
forall x (xs :: [*]).
Typeable x =>
TypeRep x -> TypeRepList xs -> TypeRepList (x : xs)
Cons TypeRep Int
forall {k} (a :: k). Typeable a => TypeRep a
typeRep (TypeRep Int8
-> TypeRepList
     '[Int16, Int32, Int64, Word, Word8, Word16, Word32, Word64, Char,
       Double, Float, Bool]
-> TypeRepList
     '[Int8, Int16, Int32, Int64, Word, Word8, Word16, Word32, Word64,
       Char, Double, Float, Bool]
forall x (xs :: [*]).
Typeable x =>
TypeRep x -> TypeRepList xs -> TypeRepList (x : xs)
Cons TypeRep Int8
forall {k} (a :: k). Typeable a => TypeRep a
typeRep (TypeRep Int16
-> TypeRepList
     '[Int32, Int64, Word, Word8, Word16, Word32, Word64, Char, Double,
       Float, Bool]
-> TypeRepList
     '[Int16, Int32, Int64, Word, Word8, Word16, Word32, Word64, Char,
       Double, Float, Bool]
forall x (xs :: [*]).
Typeable x =>
TypeRep x -> TypeRepList xs -> TypeRepList (x : xs)
Cons TypeRep Int16
forall {k} (a :: k). Typeable a => TypeRep a
typeRep (TypeRep Int32
-> TypeRepList
     '[Int64, Word, Word8, Word16, Word32, Word64, Char, Double, Float,
       Bool]
-> TypeRepList
     '[Int32, Int64, Word, Word8, Word16, Word32, Word64, Char, Double,
       Float, Bool]
forall x (xs :: [*]).
Typeable x =>
TypeRep x -> TypeRepList xs -> TypeRepList (x : xs)
Cons TypeRep Int32
forall {k} (a :: k). Typeable a => TypeRep a
typeRep (TypeRep Int64
-> TypeRepList
     '[Word, Word8, Word16, Word32, Word64, Char, Double, Float, Bool]
-> TypeRepList
     '[Int64, Word, Word8, Word16, Word32, Word64, Char, Double, Float,
       Bool]
forall x (xs :: [*]).
Typeable x =>
TypeRep x -> TypeRepList xs -> TypeRepList (x : xs)
Cons TypeRep Int64
forall {k} (a :: k). Typeable a => TypeRep a
typeRep (TypeRep Word
-> TypeRepList
     '[Word8, Word16, Word32, Word64, Char, Double, Float, Bool]
-> TypeRepList
     '[Word, Word8, Word16, Word32, Word64, Char, Double, Float, Bool]
forall x (xs :: [*]).
Typeable x =>
TypeRep x -> TypeRepList xs -> TypeRepList (x : xs)
Cons TypeRep Word
forall {k} (a :: k). Typeable a => TypeRep a
typeRep (TypeRep Word8
-> TypeRepList '[Word16, Word32, Word64, Char, Double, Float, Bool]
-> TypeRepList
     '[Word8, Word16, Word32, Word64, Char, Double, Float, Bool]
forall x (xs :: [*]).
Typeable x =>
TypeRep x -> TypeRepList xs -> TypeRepList (x : xs)
Cons TypeRep Word8
forall {k} (a :: k). Typeable a => TypeRep a
typeRep (TypeRep Word16
-> TypeRepList '[Word32, Word64, Char, Double, Float, Bool]
-> TypeRepList '[Word16, Word32, Word64, Char, Double, Float, Bool]
forall x (xs :: [*]).
Typeable x =>
TypeRep x -> TypeRepList xs -> TypeRepList (x : xs)
Cons TypeRep Word16
forall {k} (a :: k). Typeable a => TypeRep a
typeRep (TypeRep Word32
-> TypeRepList '[Word64, Char, Double, Float, Bool]
-> TypeRepList '[Word32, Word64, Char, Double, Float, Bool]
forall x (xs :: [*]).
Typeable x =>
TypeRep x -> TypeRepList xs -> TypeRepList (x : xs)
Cons TypeRep Word32
forall {k} (a :: k). Typeable a => TypeRep a
typeRep (TypeRep Word64
-> TypeRepList '[Char, Double, Float, Bool]
-> TypeRepList '[Word64, Char, Double, Float, Bool]
forall x (xs :: [*]).
Typeable x =>
TypeRep x -> TypeRepList xs -> TypeRepList (x : xs)
Cons TypeRep Word64
forall {k} (a :: k). Typeable a => TypeRep a
typeRep (TypeRep Char
-> TypeRepList '[Double, Float, Bool]
-> TypeRepList '[Char, Double, Float, Bool]
forall x (xs :: [*]).
Typeable x =>
TypeRep x -> TypeRepList xs -> TypeRepList (x : xs)
Cons TypeRep Char
forall {k} (a :: k). Typeable a => TypeRep a
typeRep (TypeRep Double
-> TypeRepList '[Float, Bool] -> TypeRepList '[Double, Float, Bool]
forall x (xs :: [*]).
Typeable x =>
TypeRep x -> TypeRepList xs -> TypeRepList (x : xs)
Cons TypeRep Double
forall {k} (a :: k). Typeable a => TypeRep a
typeRep (TypeRep Float -> TypeRepList '[Bool] -> TypeRepList '[Float, Bool]
forall x (xs :: [*]).
Typeable x =>
TypeRep x -> TypeRepList xs -> TypeRepList (x : xs)
Cons TypeRep Float
forall {k} (a :: k). Typeable a => TypeRep a
typeRep (TypeRep Bool -> TypeRepList '[] -> TypeRepList '[Bool]
forall x (xs :: [*]).
Typeable x =>
TypeRep x -> TypeRepList xs -> TypeRepList (x : xs)
Cons TypeRep Bool
forall {k} (a :: k). Typeable a => TypeRep a
typeRep TypeRepList '[]
Nil)))))))))))))

numericTypes :: TypeRepList '[Int, Int8, Int16, Int32, Int64, Double, Float]
numericTypes :: TypeRepList '[Int, Int8, Int16, Int32, Int64, Double, Float]
numericTypes = TypeRep Int
-> TypeRepList '[Int8, Int16, Int32, Int64, Double, Float]
-> TypeRepList '[Int, Int8, Int16, Int32, Int64, Double, Float]
forall x (xs :: [*]).
Typeable x =>
TypeRep x -> TypeRepList xs -> TypeRepList (x : xs)
Cons TypeRep Int
forall {k} (a :: k). Typeable a => TypeRep a
typeRep (TypeRep Int8
-> TypeRepList '[Int16, Int32, Int64, Double, Float]
-> TypeRepList '[Int8, Int16, Int32, Int64, Double, Float]
forall x (xs :: [*]).
Typeable x =>
TypeRep x -> TypeRepList xs -> TypeRepList (x : xs)
Cons TypeRep Int8
forall {k} (a :: k). Typeable a => TypeRep a
typeRep (TypeRep Int16
-> TypeRepList '[Int32, Int64, Double, Float]
-> TypeRepList '[Int16, Int32, Int64, Double, Float]
forall x (xs :: [*]).
Typeable x =>
TypeRep x -> TypeRepList xs -> TypeRepList (x : xs)
Cons TypeRep Int16
forall {k} (a :: k). Typeable a => TypeRep a
typeRep (TypeRep Int32
-> TypeRepList '[Int64, Double, Float]
-> TypeRepList '[Int32, Int64, Double, Float]
forall x (xs :: [*]).
Typeable x =>
TypeRep x -> TypeRepList xs -> TypeRepList (x : xs)
Cons TypeRep Int32
forall {k} (a :: k). Typeable a => TypeRep a
typeRep (TypeRep Int64
-> TypeRepList '[Double, Float]
-> TypeRepList '[Int64, Double, Float]
forall x (xs :: [*]).
Typeable x =>
TypeRep x -> TypeRepList xs -> TypeRepList (x : xs)
Cons TypeRep Int64
forall {k} (a :: k). Typeable a => TypeRep a
typeRep (TypeRep Double
-> TypeRepList '[Float] -> TypeRepList '[Double, Float]
forall x (xs :: [*]).
Typeable x =>
TypeRep x -> TypeRepList xs -> TypeRepList (x : xs)
Cons TypeRep Double
forall {k} (a :: k). Typeable a => TypeRep a
typeRep (TypeRep Float -> TypeRepList '[] -> TypeRepList '[Float]
forall x (xs :: [*]).
Typeable x =>
TypeRep x -> TypeRepList xs -> TypeRepList (x : xs)
Cons TypeRep Float
forall {k} (a :: k). Typeable a => TypeRep a
typeRep TypeRepList '[]
Nil))))))

data TypeRepList (xs :: [Type]) where
  Nil  :: TypeRepList '[]
  Cons :: Typeable x => TypeRep x -> TypeRepList xs -> TypeRepList (x ': xs)

matchesAnyType :: forall a xs. (Typeable a) => TypeRepList xs -> TypeRep a -> Bool
matchesAnyType :: forall a (xs :: [*]).
Typeable a =>
TypeRepList xs -> TypeRep a -> Bool
matchesAnyType TypeRepList xs
Nil TypeRep a
_ = Bool
False
matchesAnyType (Cons TypeRep x
ty TypeRepList xs
tys) TypeRep a
rep =
  case TypeRep x -> TypeRep a -> Maybe (x :~: a)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality TypeRep x
ty TypeRep a
rep of
    Just x :~: a
Refl -> Bool
True
    Maybe (x :~: a)
Nothing   -> TypeRepList xs -> TypeRep a -> Bool
forall a (xs :: [*]).
Typeable a =>
TypeRepList xs -> TypeRep a -> Bool
matchesAnyType TypeRepList xs
tys TypeRep a
rep

testUnboxable :: forall a . Typeable a => TypeRep a -> Bool
testUnboxable :: forall a. Typeable a => TypeRep a -> Bool
testUnboxable TypeRep a
x = TypeRepList
  '[Int, Int8, Int16, Int32, Int64, Word, Word8, Word16, Word32,
    Word64, Char, Double, Float, Bool]
-> TypeRep a -> Bool
forall a (xs :: [*]).
Typeable a =>
TypeRepList xs -> TypeRep a -> Bool
matchesAnyType TypeRepList
  '[Int, Int8, Int16, Int32, Int64, Word, Word8, Word16, Word32,
    Word64, Char, Double, Float, Bool]
unboxableTypes (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a)

testNumeric :: forall a . Typeable a => TypeRep a -> Bool
testNumeric :: forall a. Typeable a => TypeRep a -> Bool
testNumeric TypeRep a
x = TypeRepList '[Int, Int8, Int16, Int32, Int64, Double, Float]
-> TypeRep a -> Bool
forall a (xs :: [*]).
Typeable a =>
TypeRepList xs -> TypeRep a -> Bool
matchesAnyType TypeRepList '[Int, Int8, Int16, Int32, Int64, Double, Float]
numericTypes (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a)