Using custom time data type in place of UTCTime for elm-bridge

Time.hs

{-# LANGUAGE TemplateHaskell #-}

module Time
  ( Time(..)
  , fromUTCTime
  )
where

import qualified Data.Aeson                    as Aeson
import           Data.Char                      ( toLower )
import qualified Data.Fixed                    as F
import           Data.SafeCopy                  ( base
                                                , deriveSafeCopy
                                                )
import qualified Data.Time.Calendar            as DTCal
import qualified Data.Time.Clock               as DTClock
import qualified Elm.Derive                    as Elm


-- |Custom time data type.
data Time = Time
  { tYear :: Integer
  , tMonth :: Int
  , tDay :: Int
  , tHour :: Int
  , tMinute :: Int
  , tSecond :: Int
  , tPicosecond :: Integer
  }
  deriving(Eq)

instance Show Time where
  show Time {..} =
    show tYear
      <> "/"
      <> show tMonth
      <> "/"
      <> show tDay
      <> "T"
      <> show tHour
      <> ":"
      <> show tMinute
      <> ":"
      <> show tSecond
      <> "."
      <> show tPicosecond


$(deriveSafeCopy 0 'base ''Time)
$(Elm.deriveBoth Elm.defaultOptions{Aeson.constructorTagModifier = map toLower} ''Time)


-- |Converts a 'DTClock.UTCTime' to a 'Time'.
--
-- It will lose some precision in the last picoseconds digit.
fromUTCTime :: DTClock.UTCTime -> Time
fromUTCTime DTClock.UTCTime {..} =
  let (year, month, day)           = parseDay utctDay
      (hour, minute, second, pico) = parseTime utctDayTime
  in  Time year month day hour minute second pico


parseDay :: DTCal.Day -> (Integer, Int, Int)
parseDay = DTCal.toGregorian


posixDayLength :: DTClock.DiffTime
posixDayLength = fromInteger 86400


-- Taken from Data.Time.LocalTime.Internal.TimeOfDay.timeToTimeOfDay.
parseTime :: DTClock.DiffTime -> (Int, Int, Int, Integer)
parseTime dt | dt >= posixDayLength =
  let s' = 60 + realToFrac (dt - posixDayLength) :: Double
      p  = (s' - (fromInteger $ round s')) * 1000000000000
  in  (23, 59, round s', round p)
parseTime dt =
  let s' = realToFrac dt :: Double
      p  = (s' - (fromInteger $ round s')) * 1000000000000
      s  = F.mod' s' 60
      m' = F.div' s' 60
      m  = F.mod' m' 60
      h  = F.div' m' 60
  in  (fromInteger h, fromInteger m, round s, round p)

TimeSpec.hs

module TimeSpec
  ( spec
  )
where

import           Test.Hspec                     ( Spec
                                                , it
                                                , shouldBe
                                                , describe
                                                )





import           Data.Time.Calendar             ( fromGregorian )
import           Data.Time.Clock                ( UTCTime(..)
                                                , picosecondsToDiffTime
                                                )
import           Time


pico :: Num a => a -> a
pico p = 1 * p

second :: Num a => a -> a
second s = pico 1 * 1000000000000 * s

minute :: Num a => a -> a
minute m = second 1 * 60 * m

hour :: Num a => a -> a
hour h = minute 1 * 60 * h


spec :: Spec
spec = describe "from a UTCTime" $ do
  it "converts 2019/10/9T23:15:9.123456790"
    $ let day = fromGregorian 2019 10 9
          diff =
            picosecondsToDiffTime
              $ (hour 23)
              + (minute 15)
              + (second 9)
              + (pico 123456790)
          utcTime = UTCTime day diff
      in  fromUTCTime utcTime `shouldBe` Time 2019 10 9 23 15 9 123456790
  it "converts 2019/10/9T23:15:9.0"
    $ let
        day = fromGregorian 2019 10 9
        diff =
          picosecondsToDiffTime
            $ (hour 23)
            + (minute 15)
            + (second 9)
            + (pico 0)
        utcTime = UTCTime day diff
      in
        fromUTCTime utcTime `shouldBe` Time 2019 10 9 23 15 9 0
  it "converts 2019/10/9T24:1:9.1 with leap second"
    $ let
        day = fromGregorian 2019 10 9
        diff =
          picosecondsToDiffTime $ (hour 24) + (minute 1) + (second 9) + (pico 1)
        utcTime = UTCTime day diff
      in
        fromUTCTime utcTime `shouldBe` Time 2019 10 9 23 59 129 1