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
import Data.Scientific
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 | DefaultConstraint deriving (Show, Eq)
data ColumnInfo = ColumnInfo { _columnInfoText :: !Text,
_columnInfoNormalName :: !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
data EntityInfo = EntityInfo { _entityInfoText :: !Text,
_entityInfoName :: !TH.Name,
_entityInfoSQLName :: !SQL.Name,
_entityInfoType :: !TH.Type,
_entityInfoConstraintList :: ![SQL.Constraint],
_entityInfoColumnMap :: [ColumnInfo]
} deriving (Show)
instance Eq EntityInfo where
(==) a b = _entityInfoName a == _entityInfoName b
makeLenses ''EntityInfo
data ForeignKeyConstraint = ForeignKeyConstraint { _fkName :: !Text,
_fkFromT :: !EntityInfo,
_fkFromCols :: ![ColumnInfo],
_fkToT :: !EntityInfo,
_fkToCols :: ![ColumnInfo]
} deriving (Show)
makeLenses ''ForeignKeyConstraint
data UniqueKeyConstraint = UniqueKeyConstraint { _uqName :: !Text,
_uqEntity :: !EntityInfo,
_uqCols :: ![ColumnInfo]
} deriving (Show)
makeLenses ''UniqueKeyConstraint
data PrimaryKeyConstraint = PrimaryKeyConstraint { _pkName :: !Text,
_pkEntity :: !EntityInfo,
_pkCols :: ![ColumnInfo]
} deriving (Show)
makeLenses ''PrimaryKeyConstraint
data ParseContext = ParseContext { _entities :: ![EntityInfo],
_fks :: ![ForeignKeyConstraint],
_pks :: ![PrimaryKeyConstraint],
_uqs :: ![UniqueKeyConstraint]
} 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 = (<>)
class NullValue a where
nullValue :: a
instance NullValue Int where nullValue = 0
instance NullValue Bool where nullValue = False
instance NullValue LocalTime where nullValue = LocalTime (ModifiedJulianDay 0) nullValue
instance NullValue TimeOfDay where nullValue = TimeOfDay 0 0 0
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 Scientific where nullValue = 0
instance NullValue Day where nullValue = ModifiedJulianDay 0
instance NullValue ByteString where nullValue = ""
instance NullValue (Maybe a) where nullValue = Nothing
newtype Schema = Schema Text