-- | This module implements displaying ClockTime as a String which does NOT
-- depend on the time-zone.
module Util.ClockTimeToString(
   clockTimeToString, -- :: ClockTime -> String
   stringToClockTime, -- :: String -> ClockTime
   ) where

import System.Time

import Util.ExtendedPrelude

-- | Convert a ClockTime to a String.
-- This has the format
--    \<optional sign\>\<digits\>+\<digits\>
-- where the digits encode two integers N1 and N2 (in order) representing
-- the time elapsed since 00:00:00 UTC on 1 Jan 1970.  This will be
-- N1 + (N2 \/ 10^12) seconds.  0<=N2<10^12.
clockTimeToString :: ClockTime -> String
clockTimeToString :: ClockTime -> String
clockTimeToString (TOD Integer
n1 Integer
n2) = Integer -> String
forall a. Show a => a -> String
show Integer
n1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"+" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
n2

-- | Convert a validly formatted String to a ClockTime.
stringToClockTime :: String -> ClockTime
stringToClockTime :: String -> ClockTime
stringToClockTime String
s = case Char -> String -> [String]
splitByChar Char
'+' String
s of
   [String
n1s,String
n2s] -> Integer -> Integer -> ClockTime
TOD (String -> Integer
forall a. Read a => String -> a
read String
n1s) (String -> Integer
forall a. Read a => String -> a
read String
n2s)
   [String]
_ -> String -> ClockTime
forall a. HasCallStack => String -> a
error String
"Badly formatted clock time"