git.iko.soy/project-m36
on ca59541 help sign in
project-m36/src/lib/ProjectM36/DataTypes/Interval.hs
37 lines 1.3 kB history raw
1{-# LANGUAGE GeneralizedNewtypeDeriving, StandaloneDeriving #-}
2{-# OPTIONS_GHC -fno-warn-orphans #-}
3module ProjectM36.DataTypes.Interval where
4import Data.Interval
5import ProjectM36.Base hiding (Finite)
6import Data.Binary
7import ProjectM36.Atom
8import Data.Typeable
9import Data.Time.Clock
11instance (Atomable a, Ord a) => Atomable (Interval a)
13instance (Binary a) => Binary (Extended a) where
14 put ext = case ext of
15 NegInf -> put (1 :: Int)
16 PosInf -> put (2 :: Int)
17 Finite x -> put (3 :: Int) >> put x
18 get = do
19 flag <- get :: Get Int
20 case flag of
21 1 -> pure NegInf
22 2 -> pure PosInf
23 3 -> Finite <$> get
24 _ -> error "poop"
26instance (Ord a, Binary a) => Binary (Interval a) where
27 put interv = put (lowerBound interv) >> put (upperBound interv)
28 get = interval <$> get <*> get
30intervalFunctions :: [AtomFunction]
31intervalFunctions = [AtomFunction { atomFuncName = "interval_dt_member",
32 atomFuncType = [dateTimeAtomType,
33 atomTypeForProxy (Proxy :: Proxy (Interval UTCTime)),
34 boolAtomType],
35 atomFunc = (\(dt:dtinterval:_) -> Atom $ member ((unsafeCast dt)::UTCTime) ((unsafeCast dtinterval)::(Interval UTCTime)))}
37 ]