Skip to content

Instantly share code, notes, and snippets.

@ibizaman
Last active October 12, 2019 06:27
Show Gist options
  • Save ibizaman/efa6ee8a7b4e0f5696c24ff493e5744a to your computer and use it in GitHub Desktop.
Save ibizaman/efa6ee8a7b4e0f5696c24ff493e5744a to your computer and use it in GitHub Desktop.
Using custom time data type in place of UTCTime for elm-bridge
{-# 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)
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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment