Add conversion instances for types from the time library

src/lib/Witch/Instances.hs

@@ -25,6 +25,10 @@ import qualified Data.Text as Text
 import qualified Data.Text.Encoding as Text
 import qualified Data.Text.Lazy as LazyText
 import qualified Data.Text.Lazy.Encoding as LazyText
+import qualified Data.Time as Time
+import qualified Data.Time.Clock.POSIX as Time
+import qualified Data.Time.Clock.System as Time
+import qualified Data.Time.Clock.TAI as Time
 import qualified Data.Word as Word
 import qualified GHC.Float as Float
 import qualified Numeric.Natural as Natural
@@ -1079,6 +1083,114 @@ instance From.From
   (TryFromException.TryFromException s u)
   (TryFromException.TryFromException s t)
 
+-- Day
+
+-- | Uses 'Time.ModifiedJulianDay'.
+instance From.From Integer Time.Day where
+  from = Time.ModifiedJulianDay
+
+-- | Uses 'Time.nominalDiffTimeToSeconds'.
+instance From.From Time.Day Integer where
+  from = Time.toModifiedJulianDay
+
+-- DayOfWeek
+
+-- | Uses 'Time.dayOfWeek'.
+instance From.From Time.Day Time.DayOfWeek where
+  from = Time.dayOfWeek
+
+-- UniversalTime
+
+-- | Uses 'Time.ModJulianDate'.
+instance From.From Rational Time.UniversalTime where
+  from = Time.ModJulianDate
+
+-- | Uses 'Time.getModJulianDate'.
+instance From.From Time.UniversalTime Rational where
+  from = Time.getModJulianDate
+
+-- DiffTime
+
+-- | Uses 'realToFrac'.
+instance From.From Fixed.Pico Time.DiffTime where
+  from = realToFrac
+
+-- | Uses 'realToFrac'.
+instance From.From Time.DiffTime Fixed.Pico where
+  from = realToFrac
+
+-- NominalDiffTime
+
+-- | Uses 'Time.secondsToNominalDiffTime'.
+instance From.From Fixed.Pico Time.NominalDiffTime where
+  from = Time.secondsToNominalDiffTime
+
+-- | Uses 'Time.nominalDiffTimeToSeconds'.
+instance From.From Time.NominalDiffTime Fixed.Pico where
+  from = Time.nominalDiffTimeToSeconds
+
+-- POSIXTime
+
+-- | Uses 'Time.systemToPOSIXTime'.
+instance From.From Time.SystemTime Time.POSIXTime where
+  from = Time.systemToPOSIXTime
+
+-- | Uses 'Time.utcTimeToPOSIXSeconds'.
+instance From.From Time.UTCTime Time.POSIXTime where
+  from = Time.utcTimeToPOSIXSeconds
+
+-- | Uses 'Time.posixSecondsToUTCTime'.
+instance From.From Time.POSIXTime Time.UTCTime where
+  from = Time.posixSecondsToUTCTime
+
+-- SystemTime
+
+-- | Uses 'Time.utcToSystemTime'.
+instance From.From Time.UTCTime Time.SystemTime where
+  from = Time.utcToSystemTime
+
+-- | Uses 'Time.systemToTAITime'.
+instance From.From Time.SystemTime Time.AbsoluteTime where
+  from = Time.systemToTAITime
+
+-- | Uses 'Time.systemToUTCTime'.
+instance From.From Time.SystemTime Time.UTCTime where
+  from = Time.systemToUTCTime
+
+-- TimeOfDay
+
+-- | Uses 'Time.timeToTimeOfDay'.
+instance From.From Time.DiffTime Time.TimeOfDay where
+  from = Time.timeToTimeOfDay
+
+-- | Uses 'Time.dayFractionToTimeOfDay'.
+instance From.From Rational Time.TimeOfDay where
+  from = Time.dayFractionToTimeOfDay
+
+-- | Uses 'Time.timeOfDayToTime'.
+instance From.From Time.TimeOfDay Time.DiffTime where
+  from = Time.timeOfDayToTime
+
+-- | Uses 'Time.timeOfDayToDayFraction'.
+instance From.From Time.TimeOfDay Rational where
+  from = Time.timeOfDayToDayFraction
+
+-- CalendarDiffTime
+
+-- | Uses 'Time.calendarTimeDays'.
+instance From.From Time.CalendarDiffDays Time.CalendarDiffTime where
+  from = Time.calendarTimeDays
+
+-- | Uses 'Time.calendarTimeTime'.
+instance From.From Time.NominalDiffTime Time.CalendarDiffTime where
+  from = Time.calendarTimeTime
+
+-- ZonedTime
+
+-- | Uses 'Time.zonedTimeToUTC'.
+instance From.From Time.ZonedTime Time.UTCTime where
+  from = Time.zonedTimeToUTC
+
 fromNonNegativeIntegral
   :: (Integral s, Num t) => s -> Either Exception.ArithException t
 fromNonNegativeIntegral x =

src/test/Main.hs

@@ -19,6 +19,10 @@ import qualified Data.Sequence as Seq
 import qualified Data.Set as Set
 import qualified Data.Text as Text
 import qualified Data.Text.Lazy as LazyText
+import qualified Data.Time as Time
+import qualified Data.Time.Clock.POSIX as Time
+import qualified Data.Time.Clock.System as Time
+import qualified Data.Time.Clock.TAI as Time
 import qualified Data.Word as Word
 import qualified Numeric.Natural as Natural
 import qualified Test.Hspec as Hspec
@@ -1641,6 +1645,114 @@ main = Hspec.hspec . Hspec.describe "Witch" $ do
     Hspec.describe "From (TryFromException s t0) (TryFromException s t1)" $ do
       Hspec.it "needs tests" Hspec.pending
 
+    -- Day
+
+    Hspec.describe "From Integer Day" $ do
+      let f = Witch.from @Integer @Time.Day
+      test $ f 0 `Hspec.shouldBe` Time.ModifiedJulianDay 0
+
+    Hspec.describe "From Day Integer" $ do
+      let f = Witch.from @Time.Day @Integer
+      test $ f (Time.ModifiedJulianDay 0) `Hspec.shouldBe` 0
+
+    -- DayOfWeek
+
+    Hspec.describe "From Day DayOfWeek" $ do
+      let f = Witch.from @Time.Day @Time.DayOfWeek
+      test $ f (Time.ModifiedJulianDay 0) `Hspec.shouldBe` Time.Wednesday
+
+    -- UniversalTime
+
+    Hspec.describe "From Rational UniversalTime" $ do
+      let f = Witch.from @Rational @Time.UniversalTime
+      test $ f 0 `Hspec.shouldBe` Time.ModJulianDate 0
+
+    Hspec.describe "From UniversalTime Rational" $ do
+      let f = Witch.from @Time.UniversalTime @Rational
+      test $ f (Time.ModJulianDate 0) `Hspec.shouldBe` 0
+
+    -- DiffTime
+
+    Hspec.describe "From Pico DiffTime" $ do
+      let f = Witch.from @Fixed.Pico @Time.DiffTime
+      test $ f 0 `Hspec.shouldBe` 0
+
+    Hspec.describe "From DiffTime Pico" $ do
+      let f = Witch.from @Time.DiffTime @Fixed.Pico
+      test $ f 0 `Hspec.shouldBe` 0
+
+    -- NominalDiffTime
+
+    Hspec.describe "From Pico NominalDiffTime" $ do
+      let f = Witch.from @Fixed.Pico @Time.NominalDiffTime
+      test $ f 0 `Hspec.shouldBe` 0
+
+    Hspec.describe "From NominalDiffTime Pico" $ do
+      let f = Witch.from @Time.NominalDiffTime @Fixed.Pico
+      test $ f 0 `Hspec.shouldBe` 0
+
+    -- POSIXTime
+
+    Hspec.describe "From SystemTime POSIXTime" $ do
+      let f = Witch.from @Time.SystemTime @Time.POSIXTime
+      test $ f (Time.MkSystemTime 0 0) `Hspec.shouldBe` 0
+
+    Hspec.describe "From UTCTime POSIXTime" $ do
+      let f = Witch.from @Time.UTCTime @Time.POSIXTime
+      test $ f unixEpoch `Hspec.shouldBe` 0
+
+    Hspec.describe "From POSIXTime UTCTime" $ do
+      let f = Witch.from @Time.POSIXTime @Time.UTCTime
+      test $ f 0 `Hspec.shouldBe` unixEpoch
+
+    -- SystemTime
+
+    Hspec.describe "From UTCTime SystemTime" $ do
+      let f = Witch.from @Time.UTCTime @Time.SystemTime
+      test $ f unixEpoch `Hspec.shouldBe` Time.MkSystemTime 0 0
+
+    Hspec.describe "From SystemTime AbsoluteTime" $ do
+      let f = Witch.from @Time.SystemTime @Time.AbsoluteTime
+      test $ f (Time.MkSystemTime (-3506716800) 0) `Hspec.shouldBe` Time.taiEpoch
+
+    Hspec.describe "From SystemTime UTCTime" $ do
+      let f = Witch.from @Time.SystemTime @Time.UTCTime
+      test $ f (Time.MkSystemTime 0 0) `Hspec.shouldBe` unixEpoch
+
+    -- TimeOfDay
+
+    Hspec.describe "From DiffTime TimeOfDay" $ do
+      let f = Witch.from @Time.DiffTime @Time.TimeOfDay
+      test $ f 0 `Hspec.shouldBe` Time.TimeOfDay 0 0 0
+
+    Hspec.describe "From Rational TimeOfDay" $ do
+      let f = Witch.from @Rational @Time.TimeOfDay
+      test $ f 0 `Hspec.shouldBe` Time.TimeOfDay 0 0 0
+
+    Hspec.describe "From TimeOfDay DiffTime" $ do
+      let f = Witch.from @Time.TimeOfDay @Time.DiffTime
+      test $ f (Time.TimeOfDay 0 0 0) `Hspec.shouldBe` 0
+
+    Hspec.describe "From TimeOfDay Rational" $ do
+      let f = Witch.from @Time.TimeOfDay @Rational
+      test $ f (Time.TimeOfDay 0 0 0) `Hspec.shouldBe` 0
+
+    -- CalendarDiffTime
+
+    Hspec.describe "From CalendarDiffDays CalendarDiffTime" $ do
+      let f = Witch.from @Time.CalendarDiffDays @Time.CalendarDiffTime
+      test $ f (Time.CalendarDiffDays 0 0) `Hspec.shouldBe` Time.CalendarDiffTime 0 0
+
+    Hspec.describe "From NominalDiffTime CalendarDiffTime" $ do
+      let f = Witch.from @Time.NominalDiffTime @Time.CalendarDiffTime
+      test $ f 0 `Hspec.shouldBe` Time.CalendarDiffTime 0 0
+
+    -- ZonedTime
+
+    Hspec.describe "From ZonedTime UTCTime" $ do
+      let f = Witch.from @Time.ZonedTime @Time.UTCTime
+      test $ f (Time.ZonedTime (Time.LocalTime (Time.ModifiedJulianDay 0) (Time.TimeOfDay 0 0 0)) Time.utc) `Hspec.shouldBe` Time.UTCTime (Time.ModifiedJulianDay 0) 0
+
 test :: Hspec.Example a => a -> Hspec.SpecWith (Hspec.Arg a)
 test = Hspec.it ""
 
@@ -1650,6 +1762,9 @@ untested = Hspec.runIO $ Exception.throwIO Untested
 hush :: Either x a -> Maybe a
 hush = either (const Nothing) Just
 
+unixEpoch :: Time.UTCTime
+unixEpoch = Time.UTCTime (Time.ModifiedJulianDay 40587) 0
+
 data Untested
   = Untested
   deriving (Eq, Show)

witch.cabal

@@ -22,6 +22,7 @@ common basics
     , bytestring >= 0.10.12 && < 0.11
     , containers >= 0.6.2 && < 0.7
     , text >= 1.2.4 && < 1.3
+    , time >= 1.9 && < 1.12
   default-language: Haskell2010
   ghc-options:
     -Weverything