refactor(db): instance PersistField CalendarDiffDays
This commit is contained in:
parent
70409fa320
commit
944ef46d84
@ -46,28 +46,35 @@ instance Csv.ToField UTCTime where
|
||||
instance Csv.FromField UTCTime where
|
||||
parseField = iso8601ParseM <=< Csv.parseField
|
||||
|
||||
deriving instance Generic CalendarDiffDays
|
||||
|
||||
|
||||
-- CalendarDiffDays
|
||||
--
|
||||
-- CalendarDiffDays is basically a pair of Integers, we are stored in the DB as an Array of Word (Word8 probably suffices already)
|
||||
type CDDdb = Word
|
||||
|
||||
deriving instance Generic CalendarDiffDays
|
||||
-- deriving instance Hashable CalendarDiffDays
|
||||
|
||||
instance PersistField CalendarDiffDays where
|
||||
toPersistValue CalendarDiffDays{..} = toPersistValue $ both coerceI64 (cdMonths, cdDays)
|
||||
toPersistValue CalendarDiffDays{..} = toPersistValue $ both coerceICcd (cdMonths, cdDays)
|
||||
where
|
||||
coerceI64 :: Integer -> Word
|
||||
coerceI64 = fromIntegral
|
||||
coerceICcd :: Integer -> CDDdb
|
||||
coerceICcd = fromIntegral
|
||||
|
||||
-- cannot be imported from utils due to cyclic dependencies and Data.Tuple.Extra is not yet a dependency
|
||||
-- placement in Utils impossivle due to cyclic dependencies
|
||||
-- Data.Tuple.Extra is not yet a dependency
|
||||
-- both = join (***) is still too cryptic for me
|
||||
both :: (a -> b) -> (a, a) -> (b, b)
|
||||
both f (x,y) = (f x, f y)
|
||||
|
||||
fromPersistValue v =
|
||||
case fromPersistValue v of
|
||||
Right (cdMonths, cdDays) -> Right CalendarDiffDays{cdMonths = coerce64I cdMonths, cdDays = coerce64I cdDays}
|
||||
Right (coerceCcdI -> cdMonths, coerceCcdI -> cdDays) -> Right CalendarDiffDays{..}
|
||||
Left e -> Left e
|
||||
where
|
||||
coerce64I :: Word -> Integer
|
||||
coerce64I = toInteger
|
||||
coerceCcdI :: CDDdb -> Integer
|
||||
coerceCcdI = toInteger
|
||||
|
||||
type WordPair = (Word, Word)
|
||||
instance PersistFieldSql CalendarDiffDays where
|
||||
sqlType _ = sqlType (Proxy @WordPair)
|
||||
|
||||
sqlType _ = sqlType (Proxy @(CDDdb, CDDdb))
|
||||
|
||||
Loading…
Reference in New Issue
Block a user