aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorLibravatar Alexander Foremny <aforemny@posteo.de>2023-10-14 14:56:42 +0200
committerLibravatar Alexander Foremny <aforemny@posteo.de>2023-10-16 10:27:54 +0200
commit42fc137f64aab9242aab9bdb2f5da0a6d892f09c (patch)
treec83753abf6abeb354cbce389b2b637bde297ad76
parent8d6a71ace58889110fc61f8384f7554c42ed3d8a (diff)
fix UTCTime serialization
-rw-r--r--app/Issue.hs24
1 files changed, 19 insertions, 5 deletions
diff --git a/app/Issue.hs b/app/Issue.hs
index c9d18f8..256947b 100644
--- a/app/Issue.hs
+++ b/app/Issue.hs
@@ -3,17 +3,20 @@
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
module Issue (Issue (..), Provenance (..), fromMatch, id) where
-import Data.Binary (Binary, get, put)
+import Data.Binary (Binary, Put, get, put)
import Data.ByteString.Lazy (toStrict)
+import Data.Fixed (Pico)
import Data.Function ((&))
import Data.List (find, foldl')
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.Encoding (decodeUtf8)
-import Data.Time.Clock (UTCTime)
+import Data.Time.Calendar (Day (..), toModifiedJulianDay)
+import Data.Time.Clock (DiffTime, UTCTime (..), picosecondsToDiffTime)
import GHC.Generics (Generic)
import Issue.Tag (Tag (..))
import Issue.Tag qualified as I
@@ -46,10 +49,21 @@ data Provenance = Provenance
}
deriving (Show, Generic, Binary)
+-- XXX These are taken from `Data.Binary.Orphans` [1]. I cannot get importing
+-- the instance from the package to work.. so we use `-fno-warn-orphans` here.
+--
+-- [1] https://hackage.haskell.org/package/binary-orphans-0.1.5.1/docs/src/Data-Binary-Orphans.html#line-132
instance Binary UTCTime where
- -- TODO Serialize UTCTime using POSIX time stamps
- put = put . show
- get = fmap read get
+ get = UTCTime <$> get <*> get
+ put (UTCTime d dt) = put d >> put dt
+
+instance Binary Day where
+ get = fmap ModifiedJulianDay get
+ put = put . toModifiedJulianDay
+
+instance Binary DiffTime where
+ get = fmap picosecondsToDiffTime get
+ put = (put :: Pico -> Put) . realToFrac
id :: Issue -> Maybe String
id issue =