{-# 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))