-- Copyright (c) 2016-present, Facebook, Inc.
-- All rights reserved.
--
-- This source code is licensed under the BSD-style license found in the
-- LICENSE file in the root directory of this source tree.


{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NoRebindableSyntax #-}
{-# LANGUAGE TypeFamilies #-}

module Duckling.TimeGrain.Types
  ( Grain(..)
  , add
  , inSeconds
  , lower
  )
  where

import Control.DeepSeq
import Data.Aeson
import Data.Hashable
import Data.Text.Lazy.Builder (fromText)
import GHC.Generics
import Prelude
import TextShow
import qualified Data.Text as Text
import qualified Data.Time as Time

import Duckling.Resolve (Resolve(..))

data Grain
  -- NoGrain is helpful to define "now"
  = NoGrain | Second | Minute | Hour | Day | Week | Month | Quarter | Year
  deriving (Grain -> Grain -> Bool
(Grain -> Grain -> Bool) -> (Grain -> Grain -> Bool) -> Eq Grain
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Grain -> Grain -> Bool
$c/= :: Grain -> Grain -> Bool
== :: Grain -> Grain -> Bool
$c== :: Grain -> Grain -> Bool
Eq, (forall x. Grain -> Rep Grain x)
-> (forall x. Rep Grain x -> Grain) -> Generic Grain
forall x. Rep Grain x -> Grain
forall x. Grain -> Rep Grain x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Grain x -> Grain
$cfrom :: forall x. Grain -> Rep Grain x
Generic, Int -> Grain -> Int
Grain -> Int
(Int -> Grain -> Int) -> (Grain -> Int) -> Hashable Grain
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Grain -> Int
$chash :: Grain -> Int
hashWithSalt :: Int -> Grain -> Int
$chashWithSalt :: Int -> Grain -> Int
Hashable, Eq Grain
Eq Grain
-> (Grain -> Grain -> Ordering)
-> (Grain -> Grain -> Bool)
-> (Grain -> Grain -> Bool)
-> (Grain -> Grain -> Bool)
-> (Grain -> Grain -> Bool)
-> (Grain -> Grain -> Grain)
-> (Grain -> Grain -> Grain)
-> Ord Grain
Grain -> Grain -> Bool
Grain -> Grain -> Ordering
Grain -> Grain -> Grain
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Grain -> Grain -> Grain
$cmin :: Grain -> Grain -> Grain
max :: Grain -> Grain -> Grain
$cmax :: Grain -> Grain -> Grain
>= :: Grain -> Grain -> Bool
$c>= :: Grain -> Grain -> Bool
> :: Grain -> Grain -> Bool
$c> :: Grain -> Grain -> Bool
<= :: Grain -> Grain -> Bool
$c<= :: Grain -> Grain -> Bool
< :: Grain -> Grain -> Bool
$c< :: Grain -> Grain -> Bool
compare :: Grain -> Grain -> Ordering
$ccompare :: Grain -> Grain -> Ordering
$cp1Ord :: Eq Grain
Ord, Grain
Grain -> Grain -> Bounded Grain
forall a. a -> a -> Bounded a
maxBound :: Grain
$cmaxBound :: Grain
minBound :: Grain
$cminBound :: Grain
Bounded, Int -> Grain
Grain -> Int
Grain -> [Grain]
Grain -> Grain
Grain -> Grain -> [Grain]
Grain -> Grain -> Grain -> [Grain]
(Grain -> Grain)
-> (Grain -> Grain)
-> (Int -> Grain)
-> (Grain -> Int)
-> (Grain -> [Grain])
-> (Grain -> Grain -> [Grain])
-> (Grain -> Grain -> [Grain])
-> (Grain -> Grain -> Grain -> [Grain])
-> Enum Grain
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Grain -> Grain -> Grain -> [Grain]
$cenumFromThenTo :: Grain -> Grain -> Grain -> [Grain]
enumFromTo :: Grain -> Grain -> [Grain]
$cenumFromTo :: Grain -> Grain -> [Grain]
enumFromThen :: Grain -> Grain -> [Grain]
$cenumFromThen :: Grain -> Grain -> [Grain]
enumFrom :: Grain -> [Grain]
$cenumFrom :: Grain -> [Grain]
fromEnum :: Grain -> Int
$cfromEnum :: Grain -> Int
toEnum :: Int -> Grain
$ctoEnum :: Int -> Grain
pred :: Grain -> Grain
$cpred :: Grain -> Grain
succ :: Grain -> Grain
$csucc :: Grain -> Grain
Enum, Int -> Grain -> ShowS
[Grain] -> ShowS
Grain -> String
(Int -> Grain -> ShowS)
-> (Grain -> String) -> ([Grain] -> ShowS) -> Show Grain
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Grain] -> ShowS
$cshowList :: [Grain] -> ShowS
show :: Grain -> String
$cshow :: Grain -> String
showsPrec :: Int -> Grain -> ShowS
$cshowsPrec :: Int -> Grain -> ShowS
Show, Grain -> ()
(Grain -> ()) -> NFData Grain
forall a. (a -> ()) -> NFData a
rnf :: Grain -> ()
$crnf :: Grain -> ()
NFData)

instance Resolve Grain where
  type ResolvedValue Grain = Grain
  resolve :: Context -> Options -> Grain -> Maybe (ResolvedValue Grain, Bool)
resolve Context
_ Options
_ Grain
_ = Maybe (ResolvedValue Grain, Bool)
forall a. Maybe a
Nothing

instance TextShow Grain where
  showb :: Grain -> Builder
showb = Text -> Builder
fromText (Text -> Builder) -> (Grain -> Text) -> Grain -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Text.toLower (Text -> Text) -> (Grain -> Text) -> Grain -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Text) -> (Grain -> String) -> Grain -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Grain -> String
forall a. Show a => a -> String
show

instance ToJSON Grain where
  toJSON :: Grain -> Value
toJSON = Text -> Value
String (Text -> Value) -> (Grain -> Text) -> Grain -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Grain -> Text
forall a. TextShow a => a -> Text
showt

updateUTCDay :: Time.UTCTime -> (Time.Day -> Time.Day) -> Time.UTCTime
updateUTCDay :: UTCTime -> (Day -> Day) -> UTCTime
updateUTCDay (Time.UTCTime Day
day DiffTime
diffTime) Day -> Day
f = Day -> DiffTime -> UTCTime
Time.UTCTime (Day -> Day
f Day
day) DiffTime
diffTime

add :: Time.UTCTime -> Grain -> Integer -> Time.UTCTime
add :: UTCTime -> Grain -> Integer -> UTCTime
add UTCTime
utcTime Grain
NoGrain Integer
n = NominalDiffTime -> UTCTime -> UTCTime
Time.addUTCTime (Integer -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac Integer
n) UTCTime
utcTime
add UTCTime
utcTime Grain
Second Integer
n = NominalDiffTime -> UTCTime -> UTCTime
Time.addUTCTime (Integer -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac Integer
n) UTCTime
utcTime
add UTCTime
utcTime Grain
Minute Integer
n = NominalDiffTime -> UTCTime -> UTCTime
Time.addUTCTime (Integer -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Integer -> NominalDiffTime) -> Integer -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ Integer
60 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
n) UTCTime
utcTime
add UTCTime
utcTime Grain
Hour Integer
n = NominalDiffTime -> UTCTime -> UTCTime
Time.addUTCTime (Integer -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Integer -> NominalDiffTime) -> Integer -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ Integer
3600 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
n) UTCTime
utcTime
add UTCTime
utcTime Grain
Day Integer
n = UTCTime -> (Day -> Day) -> UTCTime
updateUTCDay UTCTime
utcTime ((Day -> Day) -> UTCTime) -> (Day -> Day) -> UTCTime
forall a b. (a -> b) -> a -> b
$ Integer -> Day -> Day
Time.addDays Integer
n
add UTCTime
utcTime Grain
Week Integer
n = UTCTime -> (Day -> Day) -> UTCTime
updateUTCDay UTCTime
utcTime ((Day -> Day) -> UTCTime)
-> (Integer -> Day -> Day) -> Integer -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Day -> Day
Time.addDays (Integer -> UTCTime) -> Integer -> UTCTime
forall a b. (a -> b) -> a -> b
$ Integer
7 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
n
add UTCTime
utcTime Grain
Month Integer
n = UTCTime -> (Day -> Day) -> UTCTime
updateUTCDay UTCTime
utcTime ((Day -> Day) -> UTCTime) -> (Day -> Day) -> UTCTime
forall a b. (a -> b) -> a -> b
$ Integer -> Day -> Day
Time.addGregorianMonthsClip Integer
n
add UTCTime
utcTime Grain
Quarter Integer
n =
  UTCTime -> (Day -> Day) -> UTCTime
updateUTCDay UTCTime
utcTime ((Day -> Day) -> UTCTime)
-> (Integer -> Day -> Day) -> Integer -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Day -> Day
Time.addGregorianMonthsClip (Integer -> UTCTime) -> Integer -> UTCTime
forall a b. (a -> b) -> a -> b
$ Integer
3 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
n
add UTCTime
utcTime Grain
Year Integer
n = UTCTime -> (Day -> Day) -> UTCTime
updateUTCDay UTCTime
utcTime ((Day -> Day) -> UTCTime) -> (Day -> Day) -> UTCTime
forall a b. (a -> b) -> a -> b
$ Integer -> Day -> Day
Time.addGregorianYearsClip Integer
n

inSeconds :: Num a => Grain -> a -> a
inSeconds :: Grain -> a -> a
inSeconds Grain
NoGrain a
n = a
n
inSeconds Grain
Second  a
n = a
n
inSeconds Grain
Minute  a
n = a
n a -> a -> a
forall a. Num a => a -> a -> a
* a
60
inSeconds Grain
Hour    a
n = a
n a -> a -> a
forall a. Num a => a -> a -> a
* Grain -> a -> a
forall a. Num a => Grain -> a -> a
inSeconds Grain
Minute a
60
inSeconds Grain
Day     a
n = a
n a -> a -> a
forall a. Num a => a -> a -> a
* Grain -> a -> a
forall a. Num a => Grain -> a -> a
inSeconds Grain
Hour a
24
inSeconds Grain
Week    a
n = a
n a -> a -> a
forall a. Num a => a -> a -> a
* Grain -> a -> a
forall a. Num a => Grain -> a -> a
inSeconds Grain
Day a
7
inSeconds Grain
Month   a
n = a
n a -> a -> a
forall a. Num a => a -> a -> a
* Grain -> a -> a
forall a. Num a => Grain -> a -> a
inSeconds Grain
Day a
30
inSeconds Grain
Quarter a
n = a
n a -> a -> a
forall a. Num a => a -> a -> a
* Grain -> a -> a
forall a. Num a => Grain -> a -> a
inSeconds Grain
Month a
3
inSeconds Grain
Year    a
n = a
n a -> a -> a
forall a. Num a => a -> a -> a
* Grain -> a -> a
forall a. Num a => Grain -> a -> a
inSeconds Grain
Day a
365

lower :: Grain -> Grain
lower :: Grain -> Grain
lower Grain
NoGrain = Grain
Second
lower Grain
Second = Grain
Second
lower Grain
Year = Grain
Month
lower Grain
Month = Grain
Day
lower Grain
x = Grain -> Grain
forall a. Enum a => a -> a
pred Grain
x