81 lines
2.1 KiB
Haskell
81 lines
2.1 KiB
Haskell
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
|
|
|
module Data.Time.Clock.Instances
|
|
() where
|
|
|
|
import ClassyPrelude
|
|
|
|
import Database.Persist.Sql
|
|
|
|
import Data.Proxy
|
|
|
|
import Data.Time.Clock
|
|
import Data.Time.Calendar
|
|
import Data.Time.Calendar.Instances ()
|
|
import Web.PathPieces
|
|
|
|
import qualified Data.Csv as Csv
|
|
|
|
import Data.Time.Format.ISO8601
|
|
|
|
|
|
instance Hashable DiffTime where
|
|
hashWithSalt s = hashWithSalt s . toRational
|
|
|
|
instance Hashable NominalDiffTime where
|
|
hashWithSalt s = hashWithSalt s . toRational
|
|
|
|
instance PersistField NominalDiffTime where
|
|
toPersistValue = toPersistValue . toRational
|
|
fromPersistValue = fmap fromRational . fromPersistValue
|
|
|
|
instance PersistFieldSql NominalDiffTime where
|
|
sqlType _ = sqlType (Proxy @Rational)
|
|
|
|
|
|
deriving instance Generic UTCTime
|
|
instance Hashable UTCTime
|
|
|
|
instance PathPiece UTCTime where
|
|
toPathPiece = pack . iso8601Show
|
|
fromPathPiece = iso8601ParseM . unpack
|
|
|
|
instance Csv.ToField UTCTime where
|
|
toField = Csv.toField . iso8601Show
|
|
|
|
instance Csv.FromField UTCTime where
|
|
parseField = iso8601ParseM <=< Csv.parseField
|
|
|
|
|
|
|
|
-- 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 coerceICcd (cdMonths, cdDays)
|
|
where
|
|
coerceICcd :: Integer -> CDDdb
|
|
coerceICcd = fromIntegral
|
|
|
|
-- 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 (coerceCcdI -> cdMonths, coerceCcdI -> cdDays) -> Right CalendarDiffDays{..}
|
|
Left e -> Left e
|
|
where
|
|
coerceCcdI :: CDDdb -> Integer
|
|
coerceCcdI = toInteger
|
|
|
|
instance PersistFieldSql CalendarDiffDays where
|
|
sqlType _ = sqlType (Proxy @(CDDdb, CDDdb))
|