module Data.Binary.Orphans (
Binary(..),
module Data.Binary,
) where
import Control.Monad (liftM, liftM2, liftM3)
import qualified Data.Aeson as A
import Data.Binary
import Data.Fixed
import qualified Data.HashMap.Lazy as HM
import qualified Data.HashSet as HS
import Data.Hashable (Hashable)
import qualified Data.Scientific as S
import qualified Data.Tagged as Tagged
import qualified Data.Time as Time
#if !(MIN_VERSION_text(1,2,1))
import Data.Text.Binary ()
#endif
import Data.Vector.Binary ()
instance Binary A.Value where
get = do
t <- get :: Get Int
case t of
0 -> fmap A.Object get
1 -> fmap A.Array get
2 -> fmap A.String get
3 -> fmap A.Number get
4 -> fmap A.Bool get
5 -> return A.Null
_ -> fail $ "Invalid Value tag: " ++ show t
put (A.Object v) = put (0 :: Int) >> put v
put (A.Array v) = put (1 :: Int) >> put v
put (A.String v) = put (2 :: Int) >> put v
put (A.Number v) = put (3 :: Int) >> put v
put (A.Bool v) = put (4 :: Int) >> put v
put A.Null = put (5 :: Int)
instance (Hashable k, Eq k, Binary k, Binary v) => Binary (HM.HashMap k v) where
get = fmap HM.fromList get
put = put . HM.toList
instance (Hashable v, Eq v, Binary v) => Binary (HS.HashSet v) where
get = fmap HS.fromList get
put = put . HS.toList
instance Binary S.Scientific where
get = liftM2 S.scientific get get
put s = put (S.coefficient s) >> put (S.base10Exponent s)
instance Binary b => Binary (Tagged.Tagged s b) where
put = put . Tagged.unTagged
get = fmap Tagged.Tagged get
instance Binary (Fixed a) where
put (MkFixed a) = put a
get = MkFixed `liftM` get
instance Binary Time.Day where
get = fmap Time.ModifiedJulianDay get
put = put . Time.toModifiedJulianDay
instance Binary Time.UniversalTime where
get = fmap Time.ModJulianDate get
put = put . Time.getModJulianDate
instance Binary Time.DiffTime where
get = fmap Time.picosecondsToDiffTime get
put = (put :: Pico -> Put) . realToFrac
instance Binary Time.UTCTime where
get = liftM2 Time.UTCTime get get
put (Time.UTCTime d dt) = put d >> put dt
instance Binary Time.NominalDiffTime where
get = fmap realToFrac (get :: Get Pico)
put = (put :: Pico -> Put) . realToFrac
instance Binary Time.TimeZone where
get = liftM3 Time.TimeZone get get get
put (Time.TimeZone m s n) = put m >> put s >> put n
instance Binary Time.TimeOfDay where
get = liftM3 Time.TimeOfDay get get get
put (Time.TimeOfDay h m s) = put h >> put m >> put s
instance Binary Time.LocalTime where
get = liftM2 Time.LocalTime get get
put (Time.LocalTime d tod) = put d >> put tod