module Database.Record.Persistable (
PersistableSqlType, runPersistableNullValue, unsafePersistableSqlTypeFromNull,
PersistableRecordWidth, runPersistableRecordWidth,
unsafePersistableRecordWidth, unsafeValueWidth, (<&>), maybeWidth,
PersistableType(..), sqlNullValue,
PersistableWidth (..), derivedWidth
) where
newtype PersistableSqlType q = PersistableSqlType q
runPersistableNullValue :: PersistableSqlType q -> q
runPersistableNullValue (PersistableSqlType q) = q
unsafePersistableSqlTypeFromNull :: q
-> PersistableSqlType q
unsafePersistableSqlTypeFromNull = PersistableSqlType
newtype PersistableRecordWidth a =
PersistableRecordWidth Int
runPersistableRecordWidth :: PersistableRecordWidth a -> Int
runPersistableRecordWidth (PersistableRecordWidth w) = w
unsafePersistableRecordWidth :: Int
-> PersistableRecordWidth a
unsafePersistableRecordWidth = PersistableRecordWidth
unsafeValueWidth :: PersistableRecordWidth a
unsafeValueWidth = unsafePersistableRecordWidth 1
(<&>) :: PersistableRecordWidth a -> PersistableRecordWidth b -> PersistableRecordWidth (a, b)
a <&> b = PersistableRecordWidth $ runPersistableRecordWidth a + runPersistableRecordWidth b
maybeWidth :: PersistableRecordWidth a -> PersistableRecordWidth (Maybe a)
maybeWidth = PersistableRecordWidth . runPersistableRecordWidth
voidWidth :: PersistableRecordWidth ()
voidWidth = unsafePersistableRecordWidth 0
class Eq q => PersistableType q where
persistableType :: PersistableSqlType q
sqlNullValue :: PersistableType q => q
sqlNullValue = runPersistableNullValue persistableType
class PersistableWidth a where
persistableWidth :: PersistableRecordWidth a
instance (PersistableWidth a, PersistableWidth b) => PersistableWidth (a, b) where
persistableWidth = persistableWidth <&> persistableWidth
instance PersistableWidth a => PersistableWidth (Maybe a) where
persistableWidth = maybeWidth persistableWidth
instance PersistableWidth () where
persistableWidth = voidWidth
derivedWidth :: PersistableWidth a => (PersistableRecordWidth a, Int)
derivedWidth = (pw, runPersistableRecordWidth pw) where
pw = persistableWidth