module PostgreSQL.Binary.Interval where

import PostgreSQL.Binary.Prelude hiding (months)
import qualified PostgreSQL.Binary.Time as Time


data Interval = 
  Interval {
    Interval -> Int64
micros :: Int64,
    Interval -> Int32
days :: Int32,
    Interval -> Int32
months :: Int32
  } 
  deriving (Int -> Interval -> ShowS
[Interval] -> ShowS
Interval -> String
(Int -> Interval -> ShowS)
-> (Interval -> String) -> ([Interval] -> ShowS) -> Show Interval
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Interval] -> ShowS
$cshowList :: [Interval] -> ShowS
show :: Interval -> String
$cshow :: Interval -> String
showsPrec :: Int -> Interval -> ShowS
$cshowsPrec :: Int -> Interval -> ShowS
Show, Interval -> Interval -> Bool
(Interval -> Interval -> Bool)
-> (Interval -> Interval -> Bool) -> Eq Interval
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Interval -> Interval -> Bool
$c/= :: Interval -> Interval -> Bool
== :: Interval -> Interval -> Bool
$c== :: Interval -> Interval -> Bool
Eq)


-- |
-- Oddly enough despite a claim of support of up to 178000000 years in
-- <http://www.postgresql.org/docs/9.3/static/datatype-datetime.html Postgres' docs>
-- in practice it starts behaving unpredictably after a smaller limit.
DiffTime
maxDiffTime :: DiffTime = DiffTime
1780000 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* Int64 -> DiffTime
Time.microsToDiffTime Int64
Time.yearMicros
DiffTime
minDiffTime :: DiffTime = DiffTime -> DiffTime
forall a. Num a => a -> a
negate DiffTime
maxDiffTime

fromDiffTime :: DiffTime -> Maybe Interval
fromDiffTime :: DiffTime -> Maybe Interval
fromDiffTime DiffTime
x =
  if DiffTime
x DiffTime -> DiffTime -> Bool
forall a. Ord a => a -> a -> Bool
> DiffTime
maxDiffTime Bool -> Bool -> Bool
|| DiffTime
x DiffTime -> DiffTime -> Bool
forall a. Ord a => a -> a -> Bool
< DiffTime
minDiffTime
    then Maybe Interval
forall a. Maybe a
Nothing
    else Interval -> Maybe Interval
forall a. a -> Maybe a
Just (Interval -> Maybe Interval) -> Interval -> Maybe Interval
forall a b. (a -> b) -> a -> b
$ Integer -> Interval
fromPicosUnsafe (DiffTime -> Integer
forall a b. a -> b
unsafeCoerce DiffTime
x)

fromPicosUnsafe :: Integer -> Interval
fromPicosUnsafe :: Integer -> Interval
fromPicosUnsafe =
  State Integer Interval -> Integer -> Interval
forall s a. State s a -> s -> a
evalState (State Integer Interval -> Integer -> Interval)
-> State Integer Interval -> Integer -> Interval
forall a b. (a -> b) -> a -> b
$ do
    (Integer -> Integer) -> StateT Integer Identity ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify ((Integer -> Integer) -> StateT Integer Identity ())
-> (Integer -> Integer) -> StateT Integer Identity ()
forall a b. (a -> b) -> a -> b
$ (Integer -> Integer -> Integer) -> Integer -> Integer -> Integer
forall a b c. (a -> b -> c) -> b -> a -> c
flip Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div (Integer
10Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
6)
    Integer
u <- (Integer -> (Integer, Integer)) -> StateT Integer Identity Integer
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state ((Integer -> (Integer, Integer))
 -> StateT Integer Identity Integer)
-> (Integer -> (Integer, Integer))
-> StateT Integer Identity Integer
forall a b. (a -> b) -> a -> b
$ (Integer, Integer) -> (Integer, Integer)
forall a b. (a, b) -> (b, a)
swap ((Integer, Integer) -> (Integer, Integer))
-> (Integer -> (Integer, Integer)) -> Integer -> (Integer, Integer)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Integer -> Integer -> (Integer, Integer))
-> Integer -> Integer -> (Integer, Integer)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
divMod (Integer
10 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
6 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
60 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
60 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
24)
    Integer
d <- (Integer -> (Integer, Integer)) -> StateT Integer Identity Integer
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state ((Integer -> (Integer, Integer))
 -> StateT Integer Identity Integer)
-> (Integer -> (Integer, Integer))
-> StateT Integer Identity Integer
forall a b. (a -> b) -> a -> b
$ (Integer, Integer) -> (Integer, Integer)
forall a b. (a, b) -> (b, a)
swap ((Integer, Integer) -> (Integer, Integer))
-> (Integer -> (Integer, Integer)) -> Integer -> (Integer, Integer)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Integer -> Integer -> (Integer, Integer))
-> Integer -> Integer -> (Integer, Integer)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
divMod (Integer
31)
    Integer
m <- StateT Integer Identity Integer
forall (m :: * -> *) s. Monad m => StateT s m s
get
    Interval -> State Integer Interval
forall (m :: * -> *) a. Monad m => a -> m a
return (Interval -> State Integer Interval)
-> Interval -> State Integer Interval
forall a b. (a -> b) -> a -> b
$ Int64 -> Int32 -> Int32 -> Interval
Interval (Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
u) (Integer -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
d) (Integer -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
m)

toDiffTime :: Interval -> DiffTime
toDiffTime :: Interval -> DiffTime
toDiffTime Interval
x =
  Integer -> DiffTime
picosecondsToDiffTime (Integer -> DiffTime) -> Integer -> DiffTime
forall a b. (a -> b) -> a -> b
$ 
    (Integer
10 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
6) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*
    (Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Interval -> Int64
micros Interval
x) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ 
     Integer
10 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
6 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
60 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
60 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
24 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Int32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Interval -> Int32
days Interval
x Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
31 Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
* Interval -> Int32
months Interval
x)))