{-# OPTIONS -fno-warn-orphans #-}
module Data.Time.Instances() where

    import Data.Time
    import Data.Time.Clock.TAI
    import Data.Data
    import Data.Fixed

    data DataInstance a = MkDataInstance {
        gfoldl' :: forall c. (forall d b. (Data d) => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> a -> c a,
        gunfold' :: forall c. (forall b r. (Data b) => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c a,
        dataTypeOf' :: a -> DataType,
        toConstr' :: a -> Constr
    }

    newTypeDataInstance :: forall a inner. (Data inner) => String -> String -> (inner -> a) -> (a -> inner) -> DataInstance a;
    newTypeDataInstance tyname conname mk un = 
     let
        ty = mkDataType tyname [con]
        con = mkConstr ty conname [] Prefix
     in MkDataInstance {
        gfoldl' = \k z a -> k (z mk) (un a),
        gunfold' = \k z _ -> k (z mk),
        dataTypeOf' = \_ -> ty,
        toConstr' = \_ -> con
     }

    fromDiffTime :: DiffTime -> Pico
    fromDiffTime = realToFrac

    toDiffTime :: Pico -> DiffTime
    toDiffTime = realToFrac

    instDiffTime :: DataInstance DiffTime
    instDiffTime = newTypeDataInstance "Data.Time.Clock.Scale.DiffTime" "MkDiffTime" toDiffTime fromDiffTime
    instance Data DiffTime where
        gfoldl = gfoldl' instDiffTime
        gunfold = gunfold' instDiffTime
        toConstr = toConstr' instDiffTime
        dataTypeOf = dataTypeOf' instDiffTime


    fromNominalDiffTime :: NominalDiffTime -> Pico
    fromNominalDiffTime = realToFrac

    toNominalDiffTime :: Pico -> NominalDiffTime
    toNominalDiffTime = realToFrac

    instNominalDiffTime :: DataInstance NominalDiffTime
    instNominalDiffTime = newTypeDataInstance "Data.Time.Clock.UTC.NominalDiffTime" "MkNominalDiffTime" toNominalDiffTime fromNominalDiffTime
    instance Data NominalDiffTime where
        gfoldl = gfoldl' instNominalDiffTime
        gunfold = gunfold' instNominalDiffTime
        toConstr = toConstr' instNominalDiffTime
        dataTypeOf = dataTypeOf' instNominalDiffTime


    fromAbsoluteTime :: AbsoluteTime -> DiffTime
    fromAbsoluteTime at = diffAbsoluteTime at taiEpoch

    toAbsoluteTime :: DiffTime -> AbsoluteTime
    toAbsoluteTime dt = addAbsoluteTime dt taiEpoch

    instAbsoluteTime :: DataInstance AbsoluteTime
    instAbsoluteTime = newTypeDataInstance "Data.Time.Clock.TAI.AbsoluteTime" "MkAbsoluteTime" toAbsoluteTime fromAbsoluteTime
    instance Data AbsoluteTime where
        gfoldl = gfoldl' instAbsoluteTime
        gunfold = gunfold' instAbsoluteTime
        toConstr = toConstr' instAbsoluteTime
        dataTypeOf = dataTypeOf' instAbsoluteTime

    deriving instance Data Day
    deriving instance Data UniversalTime
    deriving instance Data UTCTime
    deriving instance Data TimeZone
    deriving instance Data TimeOfDay
    deriving instance Data ZonedTime
    deriving instance Data LocalTime