{-# LANGUAGE NoImplicitPrelude #-}

{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE EmptyDataDeriving #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE  GeneralizedNewtypeDeriving #-}

-- |
-- Module      : OAlg.Entity.Definition
-- Description : definition of entities
-- Copyright   : (c) Erich Gut
-- License     : BSD3
-- Maintainer  : zerich.gut@gmail.com
-- 
-- definition of entities. All algebraic structures defined here are based on them.
-- They are __[showable]("OAlg.Data.Show")__, __[distinguishable]("OAlg.Data.Equal")__,
-- __[validable]("OAlg.Data.Validable")__
-- and __[typeable]("Data.Typeable")__.
module OAlg.Entity.Definition
  (
    -- * Entity
    Entity, Ent

    -- * Entity1
  , Entity1
  
    -- * Entity2
  , Entity2

    -- * Basic Entities
    -- ** Empty
  , Empty(), empty, Empty2(), empty2
  )
  where

import Prelude (Ord(..),undefined)

import Data.Typeable

import OAlg.Category.Definition

import OAlg.Data.Show
import OAlg.Data.Equal
import OAlg.Data.Validable
import OAlg.Data.Number
import OAlg.Data.Opposite

import OAlg.Data.Either
import OAlg.Data.Symbol

import OAlg.Structure.Definition

--------------------------------------------------------------------------------
-- Entity -

-- | entity.
class (Show a, Eq a, Validable a, Typeable a) => Entity a

deriving instance Entity x => Entity (Op x)

instance Entity ()
instance Entity Int
instance Entity Integer
instance Entity Char
instance Entity Symbol
instance Entity N
instance Entity Z
instance Entity Q

instance Entity a => Entity [a]
instance (Entity a,Entity b) => Entity (a,b)

--------------------------------------------------------------------------------
-- Ent -
-- | indexing 'Entity's.
data Ent

type instance Structure Ent x = Entity x 

--------------------------------------------------------------------------------
-- Entity1 -

-- | entity for parameterized types.
class (Show1 a, Eq1 a, Validable1 a, Typeable a) => Entity1 a

instance Entity1 Proxy

--------------------------------------------------------------------------------
-- Entity2 - 

-- | entity for two parameterized types.
class (Show2 h, Eq2 h, Validable2 h, Typeable h) => Entity2 h

--------------------------------------------------------------------------------
-- Empty -

-- | the empty entity.
data Empty deriving (Empty -> Empty -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Empty -> Empty -> Bool
$c/= :: Empty -> Empty -> Bool
== :: Empty -> Empty -> Bool
$c== :: Empty -> Empty -> Bool
Eq, Eq Empty
Empty -> Empty -> Bool
Empty -> Empty -> Ordering
Empty -> Empty -> Empty
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
min :: Empty -> Empty -> Empty
$cmin :: Empty -> Empty -> Empty
max :: Empty -> Empty -> Empty
$cmax :: Empty -> Empty -> Empty
>= :: Empty -> Empty -> Bool
$c>= :: Empty -> Empty -> Bool
> :: Empty -> Empty -> Bool
$c> :: Empty -> Empty -> Bool
<= :: Empty -> Empty -> Bool
$c<= :: Empty -> Empty -> Bool
< :: Empty -> Empty -> Bool
$c< :: Empty -> Empty -> Bool
compare :: Empty -> Empty -> Ordering
$ccompare :: Empty -> Empty -> Ordering
Ord, Int -> Empty -> ShowS
[Empty] -> ShowS
Empty -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Empty] -> ShowS
$cshowList :: [Empty] -> ShowS
show :: Empty -> String
$cshow :: Empty -> String
showsPrec :: Int -> Empty -> ShowS
$cshowsPrec :: Int -> Empty -> ShowS
Show)

-- | the empty function.
empty :: Empty -> x
empty :: forall x. Empty -> x
empty = forall b a. b -> a -> b
const forall a. HasCallStack => a
undefined

instance Validable Empty where
  valid :: Empty -> Statement
valid = forall x. Empty -> x
empty

instance Entity Empty

--------------------------------------------------------------------------------
-- Empty2 -

-- | the empty entity2.
data Empty2 a b deriving (Empty2 a b -> Empty2 a b -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. Empty2 a b -> Empty2 a b -> Bool
/= :: Empty2 a b -> Empty2 a b -> Bool
$c/= :: forall a b. Empty2 a b -> Empty2 a b -> Bool
== :: Empty2 a b -> Empty2 a b -> Bool
$c== :: forall a b. Empty2 a b -> Empty2 a b -> Bool
Eq, Int -> Empty2 a b -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. Int -> Empty2 a b -> ShowS
forall a b. [Empty2 a b] -> ShowS
forall a b. Empty2 a b -> String
showList :: [Empty2 a b] -> ShowS
$cshowList :: forall a b. [Empty2 a b] -> ShowS
show :: Empty2 a b -> String
$cshow :: forall a b. Empty2 a b -> String
showsPrec :: Int -> Empty2 a b -> ShowS
$cshowsPrec :: forall a b. Int -> Empty2 a b -> ShowS
Show)

-- | the empty function.
empty2 :: Empty2 a b -> x
empty2 :: forall a b x. Empty2 a b -> x
empty2 = forall b a. b -> a -> b
const forall a. HasCallStack => a
undefined

instance Validable (Empty2 x y) where
  valid :: Empty2 x y -> Statement
valid = forall a b x. Empty2 a b -> x
empty2

instance Show2 Empty2

instance Eq2 Empty2

instance Validable2 Empty2

instance Entity2 Empty2

--------------------------------------------------------------------------------
-- Entity2 - Instance -

instance (Entity2 f, Entity2 g) => Entity2 (Either2 f g)

instance (Entity2 h, Typeable t) => Entity2 (Forget t h)