{-# 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
class (Data a) => Entity a where
fromRow :: [SqlValue] -> GP a
toRow :: a -> GP [SqlValue]
idField :: a -> String
fieldsToColumns :: a -> [(String, String)]
tableName :: a -> String
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
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 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 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 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
data Ctx =
Ctx
{Ctx -> ConnWrapper
connection :: ConnWrapper,
Ctx -> ResolutionCache
cache :: ResolutionCache
}
type GP = RIO Ctx
type EntityId = (TypeRep, SqlValue)
type ResolutionCache = [(EntityId, Dynamic)]
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)
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)
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)
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