{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE IncoherentInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module Generics.Eot.Datatype where
import Data.Maybe
import Data.Proxy
import qualified GHC.Generics as GHC
import GHC.Generics hiding (Datatype(..), Constructor(..))
data Datatype
= Datatype {
Datatype -> String
datatypeName :: String,
Datatype -> [Constructor]
constructors :: [Constructor]
}
deriving (Int -> Datatype -> ShowS
[Datatype] -> ShowS
Datatype -> String
(Int -> Datatype -> ShowS)
-> (Datatype -> String) -> ([Datatype] -> ShowS) -> Show Datatype
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Datatype] -> ShowS
$cshowList :: [Datatype] -> ShowS
show :: Datatype -> String
$cshow :: Datatype -> String
showsPrec :: Int -> Datatype -> ShowS
$cshowsPrec :: Int -> Datatype -> ShowS
Show, Datatype -> Datatype -> Bool
(Datatype -> Datatype -> Bool)
-> (Datatype -> Datatype -> Bool) -> Eq Datatype
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Datatype -> Datatype -> Bool
$c/= :: Datatype -> Datatype -> Bool
== :: Datatype -> Datatype -> Bool
$c== :: Datatype -> Datatype -> Bool
Eq)
data Constructor
= Constructor {
Constructor -> String
constructorName :: String,
Constructor -> Fields
fields :: Fields
}
deriving (Int -> Constructor -> ShowS
[Constructor] -> ShowS
Constructor -> String
(Int -> Constructor -> ShowS)
-> (Constructor -> String)
-> ([Constructor] -> ShowS)
-> Show Constructor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Constructor] -> ShowS
$cshowList :: [Constructor] -> ShowS
show :: Constructor -> String
$cshow :: Constructor -> String
showsPrec :: Int -> Constructor -> ShowS
$cshowsPrec :: Int -> Constructor -> ShowS
Show, Constructor -> Constructor -> Bool
(Constructor -> Constructor -> Bool)
-> (Constructor -> Constructor -> Bool) -> Eq Constructor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Constructor -> Constructor -> Bool
$c/= :: Constructor -> Constructor -> Bool
== :: Constructor -> Constructor -> Bool
$c== :: Constructor -> Constructor -> Bool
Eq)
data Fields
= Selectors [String]
| NoSelectors Int
| NoFields
deriving (Int -> Fields -> ShowS
[Fields] -> ShowS
Fields -> String
(Int -> Fields -> ShowS)
-> (Fields -> String) -> ([Fields] -> ShowS) -> Show Fields
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Fields] -> ShowS
$cshowList :: [Fields] -> ShowS
show :: Fields -> String
$cshow :: Fields -> String
showsPrec :: Int -> Fields -> ShowS
$cshowsPrec :: Int -> Fields -> ShowS
Show, Fields -> Fields -> Bool
(Fields -> Fields -> Bool)
-> (Fields -> Fields -> Bool) -> Eq Fields
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Fields -> Fields -> Bool
$c/= :: Fields -> Fields -> Bool
== :: Fields -> Fields -> Bool
$c== :: Fields -> Fields -> Bool
Eq)
class GenericDatatype (a :: * -> *) where
datatypeC :: Proxy a -> Datatype
instance (GHC.Datatype c, GenericConstructors f) =>
GenericDatatype (D1 c f) where
datatypeC :: Proxy (D1 c f) -> Datatype
datatypeC Proxy (D1 c f)
Proxy = String -> [Constructor] -> Datatype
Datatype String
n [Constructor]
constructors
where
n :: String
n = M1 D c f Any -> String
forall k (d :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Datatype d =>
t d f a -> String
GHC.datatypeName (forall x. M1 D c f x
forall a. HasCallStack => a
undefined :: D1 c f x)
constructors :: [Constructor]
constructors = Proxy f -> [Constructor]
forall (a :: * -> *).
GenericConstructors a =>
Proxy a -> [Constructor]
getConstructors (Proxy f
forall k (t :: k). Proxy t
Proxy :: Proxy f)
class GenericConstructors (a :: * -> *) where
getConstructors :: Proxy a -> [Constructor]
instance (GenericConstructors a, GenericConstructors b) =>
GenericConstructors (a :+: b) where
getConstructors :: Proxy (a :+: b) -> [Constructor]
getConstructors Proxy (a :+: b)
Proxy = Proxy a -> [Constructor]
forall (a :: * -> *).
GenericConstructors a =>
Proxy a -> [Constructor]
getConstructors Proxy a
a [Constructor] -> [Constructor] -> [Constructor]
forall a. [a] -> [a] -> [a]
++ Proxy b -> [Constructor]
forall (a :: * -> *).
GenericConstructors a =>
Proxy a -> [Constructor]
getConstructors Proxy b
b
where
Proxy a
a :: Proxy a = Proxy a
forall k (t :: k). Proxy t
Proxy
Proxy b
b :: Proxy b = Proxy b
forall k (t :: k). Proxy t
Proxy
instance (GHC.Constructor c, GenericFields f) =>
GenericConstructors (C1 c f) where
getConstructors :: Proxy (C1 c f) -> [Constructor]
getConstructors Proxy (C1 c f)
Proxy = [String -> Fields -> Constructor
Constructor String
n (Proxy f -> Fields
forall (a :: * -> *). GenericFields a => Proxy a -> Fields
getFields Proxy f
f)]
where
n :: String
n = M1 C c f Any -> String
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
GHC.conName (forall x. M1 C c f x
forall a. HasCallStack => a
undefined :: (C1 c f x))
Proxy f
f :: Proxy f = Proxy f
forall k (t :: k). Proxy t
Proxy
instance GenericConstructors V1 where
getConstructors :: Proxy V1 -> [Constructor]
getConstructors Proxy V1
Proxy = []
getFields :: GenericFields a => Proxy a -> Fields
getFields :: Proxy a -> Fields
getFields Proxy a
proxy = case Proxy a -> [Maybe String]
forall (a :: * -> *). GenericFields a => Proxy a -> [Maybe String]
getFieldsC Proxy a
proxy of
[] -> Fields
NoFields
l :: [Maybe String]
l@(Maybe String
Nothing : [Maybe String]
_) -> Int -> Fields
NoSelectors ([Maybe String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Maybe String]
l)
l :: [Maybe String]
l@(Just String
_ : [Maybe String]
_) -> [String] -> Fields
Selectors ([Maybe String] -> [String]
forall a. [Maybe a] -> [a]
catMaybes [Maybe String]
l)
class GenericFields (a :: * -> *) where
getFieldsC :: Proxy a -> [Maybe String]
instance (GenericFields a, GenericFields b) =>
GenericFields (a :*: b) where
getFieldsC :: Proxy (a :*: b) -> [Maybe String]
getFieldsC Proxy (a :*: b)
Proxy = Proxy a -> [Maybe String]
forall (a :: * -> *). GenericFields a => Proxy a -> [Maybe String]
getFieldsC Proxy a
a [Maybe String] -> [Maybe String] -> [Maybe String]
forall a. [a] -> [a] -> [a]
++ Proxy b -> [Maybe String]
forall (a :: * -> *). GenericFields a => Proxy a -> [Maybe String]
getFieldsC Proxy b
b
where
Proxy a
a :: Proxy a = Proxy a
forall k (t :: k). Proxy t
Proxy
Proxy b
b :: Proxy b = Proxy b
forall k (t :: k). Proxy t
Proxy
instance Selector c => GenericFields (S1 c (Rec0 f)) where
getFieldsC :: Proxy (S1 c (Rec0 f)) -> [Maybe String]
getFieldsC Proxy (S1 c (Rec0 f))
proxy = [Proxy (S1 c (Rec0 f)) -> Maybe String
forall (c :: Meta) f.
Selector c =>
Proxy (S1 c (Rec0 f)) -> Maybe String
getField Proxy (S1 c (Rec0 f))
proxy]
getField :: forall c f . Selector c =>
Proxy (S1 c (Rec0 f)) -> Maybe String
getField :: Proxy (S1 c (Rec0 f)) -> Maybe String
getField Proxy (S1 c (Rec0 f))
Proxy = case M1 S c (Rec0 f) Any -> String
forall k (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
selName (forall x. M1 S c (Rec0 f) x
forall a. HasCallStack => a
undefined :: S1 c (Rec0 f) x) of
String
"" -> Maybe String
forall a. Maybe a
Nothing
String
s -> String -> Maybe String
forall a. a -> Maybe a
Just String
s
instance GenericFields U1 where
getFieldsC :: Proxy U1 -> [Maybe String]
getFieldsC Proxy U1
Proxy = []