@@ -0,0 +1,69 @@
1+{-# LANGUAGE DerivingVia #-}
2+{-# LANGUAGE NamedFieldPuns #-}
3+{-# LANGUAGE RecordWildCards #-}
4+{-# LANGUAGE StandaloneDeriving #-}
5+{-# LANGUAGE ViewPatterns #-}
6+{-# OPTIONS_GHC -fno-warn-orphans #-}
7+
8+
9+module Flat.Instances where
10+
11+import Data.Fixed
12+import Data.Time
13+import Flat as F
14+
15+
16+deriving via Integer instance Flat Day
17+
18+instance Flat DiffTime where
19+ encode = F.encode . diffTimeToPicoseconds
20+ decode = picosecondsToDiffTime <$> F.decode
21+ size = F.size . diffTimeToPicoseconds
22+
23+utcTimeToTuple :: UTCTime -> (Day, DiffTime)
24+utcTimeToTuple = ((,) <$> utctDay <*> utctDayTime)
25+
26+instance Flat UTCTime where
27+ encode = F.encode . utcTimeToTuple
28+ decode = uncurry UTCTime <$> F.decode
29+ size = F.size . utcTimeToTuple
30+
31+timeOfDayToTuple :: TimeOfDay -> (Int, Int, Pico)
32+timeOfDayToTuple TimeOfDay{..} = (todHour, todMin, todSec)
33+
34+tupleToTimeOfDay :: (Int, Int, Pico) -> TimeOfDay
35+tupleToTimeOfDay (todHour, todMin, todSec) = TimeOfDay{..}
36+
37+instance Flat TimeOfDay where
38+ encode = F.encode . timeOfDayToTuple
39+ decode = tupleToTimeOfDay <$> F.decode
40+ size = F.size . timeOfDayToTuple
41+
42+localTimeToTuple :: LocalTime -> (Day, TimeOfDay)
43+localTimeToTuple LocalTime{..} = (localDay, localTimeOfDay)
44+
45+instance Flat LocalTime where
46+ size = F.size . localTimeToTuple
47+ encode = F.encode . localTimeToTuple
48+ decode = uncurry LocalTime <$> F.decode
49+
50+timeZoneToTuple :: TimeZone -> (Int, Bool, String)
51+timeZoneToTuple TimeZone{..} =
52+ (timeZoneMinutes, timeZoneSummerOnly, timeZoneName)
53+
54+tupleToTimeZone :: (Int, Bool, String) -> TimeZone
55+tupleToTimeZone (timeZoneMinutes, timeZoneSummerOnly, timeZoneName) =
56+ TimeZone{..}
57+
58+instance Flat TimeZone where
59+ size = F.size . timeZoneToTuple
60+ encode = F.encode . timeZoneToTuple
61+ decode = tupleToTimeZone <$> F.decode
62+
63+zonedTimeToTuple :: ZonedTime -> (LocalTime, TimeZone)
64+zonedTimeToTuple ZonedTime{..} = (zonedTimeToLocalTime, zonedTimeZone)
65+
66+instance Flat ZonedTime where
67+ size = F.size . zonedTimeToTuple
68+ encode = F.encode . zonedTimeToTuple
69+ decode = uncurry ZonedTime <$> F.decode