{-# LANGUAGE DefaultSignatures #-}

module Database.GP.Entity
  ( Entity (..),
    columnNameFor,
    fieldTypeFor,
    maybeFieldTypeFor,
    toString,
    evidence,
    evidenceFrom,
    ResolutionCache,
    EntityId,
    Ctx (..),
    GP,
  )
where

import           Data.Char            (toLower)
import           Data.Data            
import           Database.HDBC        (SqlValue, fromSql, ConnWrapper)
import           Database.GP.RecordtypeReflection (gFromRow, gToRow)
import           Database.GP.TypeInfo             
import           Data.Dynamic
import           RIO

{--
This is the Entity class. It is a type class that is used to define the mapping 
between a Haskell product type in record notation and a database table.
The class has a default implementation for all methods. 
The default implementation uses the type information to determine a simple 1:1 mapping.

That means that 
- the type name is used as the table name and the 
- field names are used as the column names.
- A field named '<lowercase typeName>ID' is used as the primary key field.

The default implementation can be overridden by defining a custom instance for a type.

Please note the following constraints, which apply to all valid Entity type, 
but that are not explicitely encoded in the type class definition:

- The type must be a product type in record notation.
- The type must have exactly one constructor.
- There must be single primary key field, compund primary keys are not supported.

--}

class (Data a) => Entity a where
  -- | Converts a database row to a value of type 'a'.
  fromRow :: [SqlValue] -> GP a

  -- | Converts a value of type 'a' to a database row.
  toRow :: a -> GP [SqlValue]

  -- | Returns the name of the primary key field for a type 'a'.
  idField :: a -> String

  -- | Returns a list of tuples that map field names to column names for a type 'a'.
  fieldsToColumns :: a -> [(String, String)]

  -- | Returns the name of the table for a type 'a'.
  tableName :: a -> String

  -- | generic default implementation
  default fromRow :: [SqlValue] -> GP a
  fromRow = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Data a => [SqlValue] -> a
gFromRow

  -- | generic default implementation
  default toRow :: a -> GP [SqlValue]
  toRow = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Data a => a -> [SqlValue]
gToRow

  -- | default implementation: the ID field is the field with the same name
  --   as the type name in lower case and appended with "ID", e.g. "bookID"
  default idField :: a -> String
  idField = TypeInfo a -> String
idFieldName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Data a => a -> TypeInfo a
typeInfo
    where
      idFieldName :: TypeInfo a -> String
      idFieldName :: TypeInfo a -> String
idFieldName TypeInfo a
ti = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (forall {k} (a :: k). TypeInfo a -> String
typeName TypeInfo a
ti) forall a. [a] -> [a] -> [a]
++ String
"ID"

  -- | default implementation: the field names are used as column names
  default fieldsToColumns :: a -> [(String, String)]
  fieldsToColumns a
x = forall a b. [a] -> [b] -> [(a, b)]
zip (forall {k} (a :: k). TypeInfo a -> [String]
fieldNames (forall a. Data a => a -> TypeInfo a
typeInfo a
x)) (forall {k} (a :: k). TypeInfo a -> [String]
fieldNames (forall a. Data a => a -> TypeInfo a
typeInfo a
x))

  -- | default implementation: the type name is used as table name
  default tableName :: a -> String
  tableName = forall {k} (a :: k). TypeInfo a -> String
typeName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Data a => a -> TypeInfo a
typeInfo

-- | type Ctx defines the context in which the persistence operations are executed.
-- It contains a connection to the database and a resolution cache for circular lookups.
data Ctx = 
  Ctx
    {Ctx -> ConnWrapper
connection :: ConnWrapper,
     Ctx -> ResolutionCache
cache :: ResolutionCache
    }

type GP = RIO Ctx

-- | The EntityId is a tuple of the TypeRep and the primary key value of an Entity.
--   It is used as a key in the resolution cache.
type EntityId = (TypeRep, SqlValue)

-- | The resolution cache maps an EntityId to a Dynamic value (representing an Entity).
--   It is used to resolve circular references during loading and storing of Entities.
type ResolutionCache = [(EntityId, Dynamic)]

-- | A convenience function: returns the name of the column for a field of a type 'a'.
columnNameFor :: Entity a => a -> String -> String
columnNameFor :: forall a. Entity a => a -> String -> String
columnNameFor a
x String
fieldName =
  case forall a. Entity a => a -> String -> Maybe String
maybeColumnNameFor a
x String
fieldName of
    Just String
columnName -> String
columnName
    Maybe String
Nothing -> forall a. HasCallStack => String -> a
error (String
"columnNameFor: " forall a. [a] -> [a] -> [a]
++ forall a. Entity a => a -> String
toString a
x forall a. [a] -> [a] -> [a]
++ 
                      String
" has no column mapping for " forall a. [a] -> [a] -> [a]
++ String
fieldName)
  where
    maybeColumnNameFor :: Entity a => a -> String -> Maybe String
    maybeColumnNameFor :: forall a. Entity a => a -> String -> Maybe String
maybeColumnNameFor a
a String
field = forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
field (forall a. Entity a => a -> [(String, String)]
fieldsToColumns a
a)

-- | A convenience function: returns the TypeRep of a field of a type 'a'.  
fieldTypeFor :: Entity a => a -> String -> TypeRep
fieldTypeFor :: forall a. Entity a => a -> String -> TypeRep
fieldTypeFor a
x String
fieldName =
  case forall a. Entity a => a -> String -> Maybe TypeRep
maybeFieldTypeFor a
x String
fieldName of
    Just TypeRep
tyRep -> TypeRep
tyRep
    Maybe TypeRep
Nothing -> forall a. HasCallStack => String -> a
error (String
"fieldTypeFor: " forall a. [a] -> [a] -> [a]
++ forall a. Entity a => a -> String
toString a
x forall a. [a] -> [a] -> [a]
++ 
                      String
" has no field " forall a. [a] -> [a] -> [a]
++ String
fieldName)

maybeFieldTypeFor :: Entity a => a -> String -> Maybe TypeRep
maybeFieldTypeFor :: forall a. Entity a => a -> String -> Maybe TypeRep
maybeFieldTypeFor a
a String
field = forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
field (forall {k} (a :: k). TypeInfo a -> [(String, TypeRep)]
fieldsAndTypes (forall a. Data a => a -> TypeInfo a
typeInfo a
a))
  where
    fieldsAndTypes :: TypeInfo a -> [(String, TypeRep)]
    fieldsAndTypes :: forall {k} (a :: k). TypeInfo a -> [(String, TypeRep)]
fieldsAndTypes TypeInfo a
ti = forall a b. [a] -> [b] -> [(a, b)]
zip (forall {k} (a :: k). TypeInfo a -> [String]
fieldNames TypeInfo a
ti) (forall {k} (a :: k). TypeInfo a -> [TypeRep]
fieldTypes TypeInfo a
ti)

-- | Returns a string representation of a value of type 'a'.
toString :: (Entity a) => a -> String
toString :: forall a. Entity a => a -> String
toString a
x = forall {k} (a :: k). TypeInfo a -> String
typeName (forall a. Data a => a -> TypeInfo a
typeInfo a
x) forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
mappedRow
  where
    mappedRow :: [String]
mappedRow = forall a b. (a -> b) -> [a] -> [b]
map forall a. Convertible SqlValue a => SqlValue -> a
fromSql (forall a. Data a => a -> [SqlValue]
gToRow a
x)

-- | A convenience function: returns an evidence instance of type 'a'.
--   This is useful for type inference where no instance is available.
evidence :: forall a. (Entity a) => a 
evidence :: forall a. Entity a => a
evidence = forall a. Entity a => TypeInfo a -> a
evidenceFrom TypeInfo a
ti
  where 
    ti :: TypeInfo a
ti = forall a. Data a => TypeInfo a
typeInfoFromContext :: TypeInfo a


evidenceFrom :: forall a. (Entity a) => TypeInfo a -> a
evidenceFrom :: forall a. Entity a => TypeInfo a -> a
evidenceFrom = forall a. Data a => Constr -> a
fromConstr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (a :: k). TypeInfo a -> Constr
typeConstructor