-- |
-- Copyright: © 2018-2020 IOHK
-- License: Apache-2.0
--
-- Utility functions for converting time values to and from text.

module Data.Time.Text
    (
      -- * Conversion to and from text
      utcTimeToText
    , utcTimeFromText

      -- * Time format specification
    , TimeFormat (..)

      -- * Time formats
    , iso8601BasicUtc
    , iso8601BasicLocal
    , iso8601ExtendedUtc
    , iso8601ExtendedLocal

      -- * Time format families
    , iso8601
    , iso8601Basic
    , iso8601Extended

    ) where

import Prelude

import Control.Applicative
    ( (<|>) )
import Control.Monad
    ( join )
import Data.Text
    ( Text )
import Data.Time.Clock
    ( UTCTime )
import Data.Time.Format
    ( defaultTimeLocale, formatTime, parseTimeM )

import qualified Data.Text as T

-- | Convert the specified time value to text, using the specified time format.
--
utcTimeToText :: TimeFormat -> UTCTime -> Text
utcTimeToText :: TimeFormat -> UTCTime -> Text
utcTimeToText TimeFormat
f = String -> Text
T.pack (String -> Text) -> (UTCTime -> String) -> UTCTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale (TimeFormat -> String
timeFormatPattern TimeFormat
f)

-- | Attempt to use each of the specified time formats to parse the given text.
--   Returns a time value that corresponds to the first matching format, or
--   'Nothing' if none of the formats matched.
--
utcTimeFromText :: [TimeFormat] -> Text -> Maybe UTCTime
utcTimeFromText :: [TimeFormat] -> Text -> Maybe UTCTime
utcTimeFromText [TimeFormat]
fs Text
t = (Maybe UTCTime -> Maybe UTCTime -> Maybe UTCTime)
-> Maybe UTCTime -> [Maybe UTCTime] -> Maybe UTCTime
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Maybe UTCTime -> Maybe UTCTime -> Maybe UTCTime
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) Maybe UTCTime
forall a. Maybe a
Nothing ([Maybe UTCTime] -> Maybe UTCTime)
-> [Maybe UTCTime] -> Maybe UTCTime
forall a b. (a -> b) -> a -> b
$
    (String -> String -> Maybe UTCTime)
-> String -> String -> Maybe UTCTime
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Bool -> TimeLocale -> String -> String -> Maybe UTCTime
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
False TimeLocale
defaultTimeLocale) (Text -> String
T.unpack Text
t) (String -> Maybe UTCTime)
-> (TimeFormat -> String) -> TimeFormat -> Maybe UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeFormat -> String
timeFormatPattern
        (TimeFormat -> Maybe UTCTime) -> [TimeFormat] -> [Maybe UTCTime]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TimeFormat]
fs

-- | Represents a particular way of representing a moment in time in text.
data TimeFormat = TimeFormat
    { TimeFormat -> String
timeFormatName :: String
    , TimeFormat -> String
timeFormatPattern :: String }
    deriving TimeFormat -> TimeFormat -> Bool
(TimeFormat -> TimeFormat -> Bool)
-> (TimeFormat -> TimeFormat -> Bool) -> Eq TimeFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TimeFormat -> TimeFormat -> Bool
$c/= :: TimeFormat -> TimeFormat -> Bool
== :: TimeFormat -> TimeFormat -> Bool
$c== :: TimeFormat -> TimeFormat -> Bool
Eq

-- | Represents the ISO 8601 family of formats.
iso8601 :: [TimeFormat]
iso8601 :: [TimeFormat]
iso8601 = [[TimeFormat]] -> [TimeFormat]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join [[TimeFormat]
iso8601Basic, [TimeFormat]
iso8601Extended]

-- | Represents the ISO 8601 basic family of formats.
iso8601Basic :: [TimeFormat]
iso8601Basic :: [TimeFormat]
iso8601Basic = [TimeFormat
iso8601BasicUtc, TimeFormat
iso8601BasicLocal]

-- | Represents the ISO 8601 extended family of formats.
iso8601Extended :: [TimeFormat]
iso8601Extended :: [TimeFormat]
iso8601Extended = [TimeFormat
iso8601ExtendedUtc, TimeFormat
iso8601ExtendedLocal]

-- | Represents the ISO 8601 basic format (UTC).
iso8601BasicUtc :: TimeFormat
iso8601BasicUtc :: TimeFormat
iso8601BasicUtc =
    String -> String -> TimeFormat
TimeFormat String
"ISO 8601 Basic UTC" String
"%Y%m%dT%H%M%S%QZ"

-- | Represents the ISO 8601 basic format (with local timezone).
iso8601BasicLocal :: TimeFormat
iso8601BasicLocal :: TimeFormat
iso8601BasicLocal =
    String -> String -> TimeFormat
TimeFormat String
"ISO 8601 Basic Local" String
"%Y%m%dT%H%M%S%Q%z"

-- | Represents the ISO 8601 extended format (UTC).
iso8601ExtendedUtc :: TimeFormat
iso8601ExtendedUtc :: TimeFormat
iso8601ExtendedUtc =
    String -> String -> TimeFormat
TimeFormat String
"ISO 8601 Extended UTC" String
"%Y-%m-%dT%H:%M:%S%QZ"

-- | Represents the ISO 8601 extended format (with local timezone).
iso8601ExtendedLocal :: TimeFormat
iso8601ExtendedLocal :: TimeFormat
iso8601ExtendedLocal =
    String -> String -> TimeFormat
TimeFormat String
"ISO 8601 Extended Local" String
"%Y-%m-%dT%H:%M:%S%Q%z"