----------------------------------------------------------------------
--
-- Module      :  Uniform.Time
--
----------------------------------------------------------------------
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}

-- | a minimal set of time operations
-- at the moment only a wrapper to time
-- examples in TestingTime.hs
module Uniform.Time
  ( module Uniform.Time,
    -- module Uniform.Strings,  
    EpochTime,
    UTCTime (..),
    ErrIO 
  )
where

import Data.Convertible (convert)
import Data.Time as T
  ( NominalDiffTime,
    UTCTime (..),
    addUTCTime,
    defaultTimeLocale,
    diffDays,
    diffUTCTime,
    formatTime,
    getCurrentTime,
    parseTimeM,
    parseTimeOrError,
    toGregorian,
  )
import Data.Time.Clock.POSIX
    ( getCurrentTime, posixSecondsToUTCTime )
import System.Posix.Types (EpochTime)

import Uniform.Error
--(ErrIO, errorT)

import Uniform.Strings
-- Text, CharChains2, show', IsString(..), t2s, s2)

import Uniform.Zero

year2000 :: UTCTime
year2000 :: UTCTime
year2000 = Text -> UTCTime
readDate3 Text
"2000-01-01"
-- ^ may serve as zero in some applications

instance CharChains2 UTCTime Text where -- orphan instance
  show' :: UTCTime -> Text
show' = String -> Text
s2t forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

instance CharChains2 T.NominalDiffTime Text where
  show' :: POSIXTime -> Text
show' = String -> Text
s2t forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

instance CharChains2 (Integer, Int, Int) Text where
  show' :: (Integer, Int, Int) -> Text
show' = String -> Text
s2t forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

instance IsString UTCTime where
  fromString :: String -> UTCTime
fromString = forall a. (Partial, Read a) => String -> String -> a
readNote String
"IsString UTCTime"

getCurrentTimeUTC :: ErrIO UTCTime
addSeconds :: Double -> UTCTime -> UTCTime
diffSeconds :: UTCTime -> UTCTime -> T.NominalDiffTime
getCurrentTimeUTC :: ErrIO UTCTime
getCurrentTimeUTC = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
T.getCurrentTime

addSeconds :: Double -> UTCTime -> UTCTime
addSeconds Double
s UTCTime
t = POSIXTime -> UTCTime -> UTCTime
T.addUTCTime (forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
s) UTCTime
t

diffSeconds :: UTCTime -> UTCTime -> POSIXTime
diffSeconds = UTCTime -> UTCTime -> POSIXTime
T.diffUTCTime

toYMD :: UTCTime -> (Integer, Int, Int)
toYMD :: UTCTime -> (Integer, Int, Int)
toYMD = Day -> (Integer, Int, Int)
T.toGregorian forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> Day
T.utctDay

diffDays :: UTCTime -> UTCTime -> Integer
diffDays :: UTCTime -> UTCTime -> Integer
diffDays UTCTime
a UTCTime
b = Day -> Day -> Integer
T.diffDays (UTCTime -> Day
T.utctDay UTCTime
a) (UTCTime -> Day
T.utctDay UTCTime
b)

epochTime2UTCTime :: EpochTime -> UTCTime
epochTime2UTCTime :: EpochTime -> UTCTime
epochTime2UTCTime = forall a b. Convertible a b => a -> b
convert

getDateAsText :: ErrIO Text
getDateAsText :: ErrIO Text
getDateAsText = forall a. IO a -> ErrIO a
callIO forall a b. (a -> b) -> a -> b
$ do
  UTCTime
now <- IO UTCTime
getCurrentTime
  let res :: String
res = forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%b %-d, %Y" UTCTime
now
  forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
s2t forall a b. (a -> b) -> a -> b
$ String
res


readDate2 :: Text -> UTCTime
-- ^ read data in the Jan 7, 2019 format (no . after month)
readDate2 :: Text -> UTCTime
readDate2 Text
datestring =
  forall t.
ParseTime t =>
Bool -> TimeLocale -> String -> String -> t
parseTimeOrError
    Bool
True
    TimeLocale
defaultTimeLocale
    String
"%b %-d, %Y"
    (Text -> String
t2s Text
datestring) ::
    UTCTime

readDate3 :: Text -> UTCTime
readDate3 :: Text -> UTCTime
readDate3 Text
dateText = case (Text -> Maybe UTCTime
readDateMaybe Text
dateText) of
  Maybe UTCTime
Nothing -> forall a. [Text] -> a
errorT [Text
"readDate3", Text
dateText, Text
"cannot be parsed"]
  Just UTCTime
t -> UTCTime
t

readDateMaybe :: Text -> Maybe UTCTime
-- ^ read data in various formats (but not 9.10.20 !)
readDateMaybe :: Text -> Maybe UTCTime
readDateMaybe Text
dateText =
  forall a. [a] -> Maybe a
listToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$
    [ Maybe UTCTime
shortMonth,
      Maybe UTCTime
longMonth,
      Maybe UTCTime
monthPoint,
      Maybe UTCTime
germanNumeralShort,
      Maybe UTCTime
germanNumeral,
      Maybe UTCTime
isoformat
    ]
  where
    shortMonth :: Maybe UTCTime
    shortMonth :: Maybe UTCTime
shortMonth =
      forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM
        Bool
True
        TimeLocale
defaultTimeLocale
        String
"%b %-d, %Y"
        String
dateString ::
        Maybe UTCTime
    longMonth :: Maybe UTCTime
longMonth =
      forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM
        Bool
True
        TimeLocale
defaultTimeLocale
        String
"%B %-d, %Y"
        String
dateString ::
        Maybe UTCTime
    monthPoint :: Maybe UTCTime
monthPoint =
      forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM
        Bool
True
        TimeLocale
defaultTimeLocale
        String
"%b. %-d, %Y"
        String
dateString ::
        Maybe UTCTime
    germanNumeral :: Maybe UTCTime
germanNumeral =
      forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM
        Bool
True
        TimeLocale
defaultTimeLocale
        String
"%-d.%-m.%Y"
        String
dateString ::
        Maybe UTCTime
    germanNumeralShort :: Maybe UTCTime
germanNumeralShort =
      forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM
        Bool
True
        TimeLocale
defaultTimeLocale
        String
"%-d.%-m.%y"
        String
dateString ::
        Maybe UTCTime
    isoformat :: Maybe UTCTime
isoformat =
      forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM
        Bool
True
        TimeLocale
defaultTimeLocale
        String
"%Y-%m-%d"
        String
dateString ::
        Maybe UTCTime

    dateString :: String
dateString = Text -> String
t2s Text
dateText

fromEpochTime' :: EpochTime -> UTCTime
fromEpochTime' :: EpochTime -> UTCTime
fromEpochTime' EpochTime
et = POSIXTime -> UTCTime
posixSecondsToUTCTime (forall a b. (Real a, Fractional b) => a -> b
realToFrac EpochTime
et)