-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

{-# LANGUAGE UndecidableInstances #-}
{-# 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.Clock.Instances.TH ()
import Data.Time.Calendar.Instances ()
import Web.PathPieces

import qualified Data.Csv as Csv

import Data.Time.Format.ISO8601

import Servant.Docs (ToSample(..), samples)

import qualified Language.Haskell.TH as TH
import qualified Language.Haskell.TH.Syntax as TH


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 Day 
deriving instance Generic UTCTime
instance Hashable UTCTime

instance PathPiece UTCTime where
  toPathPiece = pack . iso8601Show
  fromPathPiece = iso8601ParseM . unpack

-- UTCTime, Day, etc. 
--instance {-# OVERLAPPABLE #-} ISO8601 t => Csv.ToField t where  -- Error: overlaps Csv.ToField String, but no instance ISO8601 String exists?!  
--  toField = (Csv.toField::String -> Field) . iso8601Show 
{-
    • Overlapping instances for Csv.ToField String
        arising from a use of ‘Csv.toField’
      Matching instances:
        instance ISO8601 t => Csv.ToField t
          -- Defined at src/Data/Time/Clock/Instances.hs:45:11
        instance Csv.ToField [Char]
          -- Defined in ‘cassava-0.5.2.0:Data.Csv.Conversion’
    • In the first argument of ‘(.)’, namely ‘Csv.toField’
      In the expression: Csv.toField . iso8601Show
      In an equation for ‘Csv.toField’:
          Csv.toField = Csv.toField . iso8601Show
-}
--
--instance {-# OVERLAPPABLE #-} ISO8601 t => Csv.FromField t where -- overlapped for ZonedTime in Handler.Utils.DateTime
--  parseField = iso8601ParseM <=< Csv.parseField
--

instance Csv.ToField UTCTime where
  toField = Csv.toField . iso8601Show 

instance Csv.FromField UTCTime where
  parseField = iso8601ParseM <=< Csv.parseField

instance Csv.ToField Day where
  toField = Csv.toField . iso8601Show 

instance Csv.FromField Day 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 impossible 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))

instance ToSample UTCTime where
  toSamples _ = samples $ do
    diff <- [0,172801..]
    sign <- [1, -1]
    return $ (sign * diff) `addUTCTime` now
    where now = $(TH.lift =<< TH.runIO getCurrentTime)
