mirror of
https://github.com/facebook/duckling.git
synced 2024-12-25 13:11:38 +03:00
70 lines
2.2 KiB
Haskell
70 lines
2.2 KiB
Haskell
-- 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. An additional grant
|
|
-- of patent rights can be found in the PATENTS file in the same directory.
|
|
|
|
|
|
{-# LANGUAGE DeriveAnyClass #-}
|
|
{-# LANGUAGE DeriveGeneric #-}
|
|
{-# LANGUAGE NoRebindableSyntax #-}
|
|
{-# LANGUAGE TypeFamilies #-}
|
|
|
|
module Duckling.TimeGrain.Types
|
|
( Grain(..)
|
|
, add
|
|
, inSeconds
|
|
)
|
|
where
|
|
|
|
import Control.DeepSeq
|
|
import Data.Aeson
|
|
import Data.Hashable
|
|
import qualified Data.Text as Text
|
|
import Data.Text.Lazy.Builder (fromText)
|
|
import qualified Data.Time as Time
|
|
import GHC.Generics
|
|
import TextShow
|
|
|
|
import Prelude
|
|
|
|
import Duckling.Resolve (Resolve(..))
|
|
|
|
data Grain = Second | Minute | Hour | Day | Week | Month | Quarter | Year
|
|
deriving (Eq, Generic, Hashable, Ord, Bounded, Enum, Show, NFData)
|
|
|
|
instance Resolve Grain where
|
|
type ResolvedValue Grain = Grain
|
|
resolve _ _ = Nothing
|
|
|
|
instance TextShow Grain where
|
|
showb = fromText . Text.toLower . Text.pack . show
|
|
|
|
instance ToJSON Grain where
|
|
toJSON = String . showt
|
|
|
|
updateUTCDay :: Time.UTCTime -> (Time.Day -> Time.Day) -> Time.UTCTime
|
|
updateUTCDay (Time.UTCTime day diffTime) f = Time.UTCTime (f day) diffTime
|
|
|
|
add :: Time.UTCTime -> Grain -> Integer -> Time.UTCTime
|
|
add utcTime Second n = Time.addUTCTime (realToFrac n) utcTime
|
|
add utcTime Minute n = Time.addUTCTime (realToFrac $ 60 * n) utcTime
|
|
add utcTime Hour n = Time.addUTCTime (realToFrac $ 3600 * n) utcTime
|
|
add utcTime Day n = updateUTCDay utcTime $ Time.addDays n
|
|
add utcTime Week n = updateUTCDay utcTime . Time.addDays $ 7 * n
|
|
add utcTime Month n = updateUTCDay utcTime $ Time.addGregorianMonthsClip n
|
|
add utcTime Quarter n =
|
|
updateUTCDay utcTime . Time.addGregorianMonthsClip $ 3 * n
|
|
add utcTime Year n = updateUTCDay utcTime $ Time.addGregorianYearsClip n
|
|
|
|
inSeconds :: Grain -> Int -> Int
|
|
inSeconds Second n = n
|
|
inSeconds Minute n = n * 60
|
|
inSeconds Hour n = n * inSeconds Minute 60
|
|
inSeconds Day n = n * inSeconds Hour 24
|
|
inSeconds Week n = n * inSeconds Day 7
|
|
inSeconds Month n = n * inSeconds Day 30
|
|
inSeconds Quarter n = n * inSeconds Month 3
|
|
inSeconds Year n = n * inSeconds Day 365
|