{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

module DataFrame.Internal.Schema where

import qualified Data.Map as M
import qualified Data.Proxy as P
import qualified Data.Text as T

import Data.Maybe
import Data.Type.Equality (TestEquality (..))
import DataFrame.Internal.Column
import Type.Reflection (typeRep)

data SchemaType where
    SType :: (Columnable a) => P.Proxy a -> SchemaType

instance Show SchemaType where
    show :: SchemaType -> String
show (SType (Proxy a
_ :: P.Proxy a)) = TypeRep a -> String
forall a. Show a => a -> String
show (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a)

instance Eq SchemaType where
    == :: SchemaType -> SchemaType -> Bool
(==) (SType (Proxy a
_ :: P.Proxy a)) (SType (Proxy a
_ :: P.Proxy b)) = Maybe (a :~: a) -> Bool
forall a. Maybe a -> Bool
isJust (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 (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @b))

schemaType :: forall a. (Columnable a) => SchemaType
schemaType :: forall a. Columnable a => SchemaType
schemaType = Proxy a -> SchemaType
forall a. Columnable a => Proxy a -> SchemaType
SType (forall t. Proxy t
forall {k} (t :: k). Proxy t
P.Proxy @a)

newtype Schema = Schema
    { Schema -> Map Text SchemaType
elements :: M.Map T.Text SchemaType
    }
    deriving (Int -> Schema -> ShowS
[Schema] -> ShowS
Schema -> String
(Int -> Schema -> ShowS)
-> (Schema -> String) -> ([Schema] -> ShowS) -> Show Schema
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Schema -> ShowS
showsPrec :: Int -> Schema -> ShowS
$cshow :: Schema -> String
show :: Schema -> String
$cshowList :: [Schema] -> ShowS
showList :: [Schema] -> ShowS
Show, Schema -> Schema -> Bool
(Schema -> Schema -> Bool)
-> (Schema -> Schema -> Bool) -> Eq Schema
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Schema -> Schema -> Bool
== :: Schema -> Schema -> Bool
$c/= :: Schema -> Schema -> Bool
/= :: Schema -> Schema -> Bool
Eq)