module Internal.Data.Basic.TH.Types where
import Internal.Interlude hiding (Type)
import Data.Text (append)
import qualified Language.Haskell.TH.Syntax as TH
import qualified Database.HsSqlPpp.Syntax as SQL
import Data.Time
data ParseError = ParseError Text deriving (Show)
instance Semigroup ParseError where
(<>) (ParseError a) (ParseError b) = ParseError (a `append` b)
instance Monoid ParseError where
mempty = ParseError ""
mappend = (<>)
data ColumnConstraint = NullConstraint | NotNullConstraint deriving (Show, Eq)
data ColumnInfo = ColumnInfo { _columnInfoText :: !Text,
_columnInfoName :: !TH.Name,
_columnInfoType :: !TH.Type,
_columnInfoSqlType :: !SQL.TypeName,
_columnInfoConstraints :: ![ColumnConstraint]
} deriving (Show)
makeLenses ''ColumnInfo
instance Eq ColumnInfo where
(==) a b = _columnInfoName a == _columnInfoName b
-- | Entity information gathered from a parser
data EntityInfo = EntityInfo { _entityInfoText :: !Text, -- ^ name retrieved from the parser, basically a computed value of 'SQL.Name'
_entityInfoName :: !TH.Name, -- ^ generated TH name
_entityInfoSQLName :: !SQL.Name, -- ^ original sql name retrieved by hssqlpp
_entityInfoType :: !TH.Type, -- ^ generated datatype
_entityInfoConstraintList :: ![SQL.Constraint], -- ^ list of constraints that have to be applied
_entityInfoColumnMap :: [ColumnInfo] -- ^ list of all columns
} deriving (Show)
instance Eq EntityInfo where
(==) a b = _entityInfoName a == _entityInfoName b
makeLenses ''EntityInfo
-- | Minimal context we need to generate a foreign key constraint
data ForeignKeyConstraint = ForeignKeyConstraint { _fkName :: !Text, -- ^ name of the foreign key
_fkFromT :: !EntityInfo,
_fkFromCols :: ![ColumnInfo],
_fkToT :: !EntityInfo, -- ^ referenced entity
_fkToCols :: ![ColumnInfo] -- ^ referenced columns
} deriving (Show)
makeLenses ''ForeignKeyConstraint
-- | Minimal context we need to generate a unique key constraint
data UniqueKeyConstraint = UniqueKeyConstraint { _uqName :: !Text, -- ^ name of the constraint
_uqEntity :: !EntityInfo, -- ^ referenced entity
_uqCols :: ![ColumnInfo] -- ^ referenced columns
} deriving (Show)
makeLenses ''UniqueKeyConstraint
-- | Minimal context we need to generate a primary key constraint
data PrimaryKeyConstraint = PrimaryKeyConstraint { _pkName :: !Text, -- ^ name of the constraint
_pkEntity :: !EntityInfo, -- ^ referenced entity
_pkCols :: ![ColumnInfo] -- ^ referenced columns
} deriving (Show)
makeLenses ''PrimaryKeyConstraint
-- | Full parse context. This datatype is filled with information as parser goes trough the sql
-- file. After 'ParseContext' is filled, TH takes over and code generation starts.
data ParseContext = ParseContext { _entities :: ![EntityInfo], -- ^ list of entities found
_fks :: ![ForeignKeyConstraint], -- ^ all foreign keys
_pks :: ![PrimaryKeyConstraint], -- ^ all primary keys
_uqs :: ![UniqueKeyConstraint] -- ^ all unique constraints
} deriving (Show)
makeLenses ''ParseContext
instance Semigroup ParseContext where
(<>) (ParseContext ei1 fk1 pk1 uq1) (ParseContext ei2 fk2 pk2 uq2) =
ParseContext (ei1 <> ei2) (fk1 <> fk2) (pk1 <> pk2) (uq1 <> uq2)
instance Monoid ParseContext where
mempty = ParseContext mempty mempty mempty mempty
mappend = (<>)
-- | Defines null values for all datatypes that we support in Basic.
-- This is basically a hack to avoid usage of unsafeCoerce, because with unsafeCoerce
-- you can hit segmentation faults due to wrong memory allocation (e.g. 'Int' and 'Bool').
class NullValue a where
nullValue :: a
instance NullValue Int where nullValue = 0
instance NullValue Bool where nullValue = False
instance NullValue TimeOfDay where nullValue = TimeOfDay 0 0 0
instance NullValue LocalTime where nullValue = LocalTime (ModifiedJulianDay 0) nullValue
instance (NullValue a, NullValue b) => NullValue (a, b) where nullValue = (nullValue, nullValue)
instance NullValue Double where nullValue = 0
instance NullValue Text where nullValue = ""
instance NullValue (Maybe a) where nullValue = Nothing