-- | @since 0.2.0
module Faker.DateTime where

import Control.Monad.IO.Class (liftIO)
import Data.Text
import Data.Time
import Faker
import Faker.Combinators

-- | Fake 'UTCTime' between 17-11-1858 and the current time. Note that
-- this function is not deterministic as the current time is not
-- constant. If you want deterministic output, use 'utcBetween'.
utc :: Fake UTCTime
utc :: Fake UTCTime
utc = do
  UTCTime
now <- IO UTCTime -> Fake UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  UTCTime -> UTCTime -> Fake UTCTime
utcBetween
    (UTCTime :: Day -> DiffTime -> UTCTime
UTCTime
       { utctDay :: Day
utctDay = (ModifiedJulianDay :: Integer -> Day
ModifiedJulianDay {toModifiedJulianDay :: Integer
toModifiedJulianDay = Integer
0})
       , utctDayTime :: DiffTime
utctDayTime = DiffTime
0
       })
    UTCTime
now

-- | Fake 'Day' between 17-11-1858 and the current day. Note that
-- this function is not deterministic as the current time is not
-- constant. If you want deterministic output, use 'dayBetween'.
day :: Fake Day
day :: Fake Day
day = do
  UTCTime
now <- IO UTCTime -> Fake UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  Day -> Day -> Fake Day
dayBetween (ModifiedJulianDay :: Integer -> Day
ModifiedJulianDay {toModifiedJulianDay :: Integer
toModifiedJulianDay = Integer
0}) (UTCTime -> Day
utctDay UTCTime
now)

-- | Generates a random UTCTime in the range [from, to].
utcBetween :: UTCTime -> UTCTime -> Fake UTCTime
utcBetween :: UTCTime -> UTCTime -> Fake UTCTime
utcBetween UTCTime
from UTCTime
to = do
  Double
delta <- (Double, Double) -> FakeT IO Double
forall a (m :: * -> *). (Monad m, Random a) => (a, a) -> FakeT m a
fromRange (Double
0 :: Double, NominalDiffTime -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (NominalDiffTime -> Double) -> NominalDiffTime -> Double
forall a b. (a -> b) -> a -> b
$ UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
to UTCTime
from)
  UTCTime -> Fake UTCTime
forall (m :: * -> *) a. Monad m => a -> m a
return (UTCTime -> Fake UTCTime) -> UTCTime -> Fake UTCTime
forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (Double -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
delta) UTCTime
from

-- | Generates a random Day in the range [from, to].
dayBetween :: Day -> Day -> Fake Day
dayBetween :: Day -> Day -> Fake Day
dayBetween Day
from Day
to = do
  Integer
delta <- (Integer, Integer) -> FakeT IO Integer
forall a (m :: * -> *). (Monad m, Random a) => (a, a) -> FakeT m a
fromRange (Integer
0, Day -> Day -> Integer
diffDays Day
to Day
from)
  Day -> Fake Day
forall (m :: * -> *) a. Monad m => a -> m a
return (Day -> Fake Day) -> Day -> Fake Day
forall a b. (a -> b) -> a -> b
$ Integer -> Day -> Day
addDays Integer
delta Day
from

-- | Generates a random Day in the year range [from, to].
dayBetweenYears :: Integer -> Integer -> Fake Day
dayBetweenYears :: Integer -> Integer -> Fake Day
dayBetweenYears Integer
ystart Integer
yend =
  Day -> Day -> Fake Day
forall a (m :: * -> *). (Monad m, Enum a) => a -> a -> FakeT m a
fakeEnumFromTo (Integer -> Int -> Int -> Day
fromGregorian Integer
ystart Int
1 Int
1) (Integer -> Int -> Int -> Day
fromGregorian Integer
yend Int
12 Int
31)

-- | Generates a random 'DiffTime' between hour range [from, to].
timeBetweenHours :: Int -> Int -> Fake DiffTime
timeBetweenHours :: Int -> Int -> Fake DiffTime
timeBetweenHours Int
hstart Int
hend =
  Integer -> DiffTime
secondsToDiffTime (Integer -> DiffTime) -> FakeT IO Integer -> Fake DiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Integer, Integer) -> FakeT IO Integer
forall a (m :: * -> *). (Monad m, Random a) => (a, a) -> FakeT m a
fromRange (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
from, Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
to)
  where
    from :: Int
from = Int
hstart Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3600
    to :: Int
to = Int
hend Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3599

-- | Generate a random 'UTCTime' between year range [from, to].
utcBetweenYears :: Integer -> Integer -> Fake UTCTime
utcBetweenYears :: Integer -> Integer -> Fake UTCTime
utcBetweenYears Integer
ystart Integer
yend =
  Day -> DiffTime -> UTCTime
UTCTime (Day -> DiffTime -> UTCTime)
-> Fake Day -> FakeT IO (DiffTime -> UTCTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> Integer -> Fake Day
dayBetweenYears Integer
ystart Integer
yend FakeT IO (DiffTime -> UTCTime) -> Fake DiffTime -> Fake UTCTime
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Int -> Fake DiffTime
timeBetweenHours Int
0 Int
24