module Data.RelevantTime
( RelevantTime(..)
, encodeRelevantTime
, decodeRelevantTime
, absolutizeRelevantTime
) where
import Data.Text (Text)
import Data.Aeson (ToJSON(..),FromJSON(..))
import Data.Int (Int64)
import Chronos.Types (Time)
import Torsor (add,invert,scale)
import qualified Chronos as CH
import qualified Data.Text as T
import qualified Data.Text.Read as TR
import qualified Data.Aeson as AE
data RelevantTime
= RelevantTimeMinute !Int64
| RelevantTimeHour !Int64
| RelevantTimeDay !Int64
| RelevantTimeNow
| RelevantTimeMidnight
| RelevantTimeNoon
deriving (Eq,Show)
instance ToJSON RelevantTime where
toJSON = AE.String . encodeRelevantTime
instance FromJSON RelevantTime where
parseJSON = AE.withText "RelevantTime"
(maybe (fail "invalid RelevantTime") return . decodeRelevantTime)
encodeRelevantTime :: RelevantTime -> Text
encodeRelevantTime = \case
RelevantTimeNow -> "now"
RelevantTimeMidnight -> "midnight"
RelevantTimeNoon -> "noon"
RelevantTimeMinute x -> T.pack (show x ++ "m")
RelevantTimeHour x -> T.pack (show x ++ "h")
RelevantTimeDay x -> T.pack (show x ++ "d")
decodeRelevantTime :: Text -> Maybe RelevantTime
decodeRelevantTime t = if T.null t
then Nothing
else case t of
"now" -> Just RelevantTimeNow
"noon" -> Just RelevantTimeNoon
"midnight" -> Just RelevantTimeMidnight
_ -> case T.last t of
'm' -> RelevantTimeMinute <$> readInt (T.init t)
'h' -> RelevantTimeHour <$> readInt (T.init t)
'd' -> RelevantTimeDay <$> readInt (T.init t)
_ -> Nothing
absolutizeRelevantTime :: Time -> RelevantTime -> Time
absolutizeRelevantTime now x = case x of
RelevantTimeNow -> now
RelevantTimeNoon-> add (scale 12 CH.hour) (CH.dayToTimeMidnight (CH.timeToDayTruncate now))
RelevantTimeMidnight -> CH.dayToTimeMidnight (CH.timeToDayTruncate now)
RelevantTimeMinute n -> add (invert (scale n CH.minute)) now
RelevantTimeHour n -> add (invert (scale n CH.hour)) now
RelevantTimeDay n -> add (invert (scale n CH.day)) now
readInt :: Text -> Maybe Int64
readInt x = case TR.signed TR.decimal x of
Left _ -> Nothing
Right (i,leftover) -> if T.null leftover
then Just i
else Nothing