{-# LANGUAGE OverloadedStrings #-}
-- | Converts data between Ginger templates & HourGlass,
-- whilst decomposing the datamodel further.
module Text.HTML.Form.WebApp.Ginger.Hourglass(
    timeData, modifyTime, modifyTime', timeParseOrNow, gSeqTo, gPad2) where

import Text.Ginger.GVal as V (GVal(..), toGVal, ToGVal, orderedDict, (~>), toInt)
import Text.Ginger.Html (unsafeRawHtml)
import Data.Hourglass
import Time.System (localDateCurrent)
import qualified Data.Text as Txt
import Text.Read (readMaybe)
import System.IO.Unsafe (unsafePerformIO) -- For use with localDateCurrent

-- | Converts HourGlass data to Ginger's datamodel.
timeData :: LocalTime DateTime -> GVal a
timeData :: forall (a :: * -> *). LocalTime DateTime -> GVal a
timeData LocalTime DateTime
datetime = [Pair a] -> GVal a
forall (m :: * -> *). [Pair m] -> GVal m
orderedDict [
    Text
"year" Text -> Int -> Pair a
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Int -> Int
forall a. Num a => a -> a
abs (Date -> Int
dateYear Date
date),
    (Text
"month", Month -> GVal a
forall x (a :: * -> *). (Enum x, Show x) => x -> GVal a
enumG (Month -> GVal a) -> Month -> GVal a
forall a b. (a -> b) -> a -> b
$ Date -> Month
dateMonth Date
date),
    Text
"date" Text -> Int -> Pair a
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Date -> Int
dateDay Date
date,
    Text
"meridiem" Text -> String -> Pair a
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> case TimeOfDay -> Hours
todHour (TimeOfDay -> Hours) -> TimeOfDay -> Hours
forall a b. (a -> b) -> a -> b
$ DateTime -> TimeOfDay
dtTime (DateTime -> TimeOfDay) -> DateTime -> TimeOfDay
forall a b. (a -> b) -> a -> b
$ LocalTime DateTime -> DateTime
forall t. LocalTime t -> t
localTimeUnwrap LocalTime DateTime
datetime of
        Hours
x | Hours
x Hours -> Hours -> Bool
forall a. Ord a => a -> a -> Bool
< Hours
12 -> String
"AM" :: String
        Hours
24 -> String
"AM"
        Hours
_ -> String
"PM",
    (Text
"hour", Hours -> GVal a
forall x (a :: * -> *). (Enum x, Show x) => x -> GVal a
enumG (Hours -> GVal a) -> Hours -> GVal a
forall a b. (a -> b) -> a -> b
$ case TimeOfDay -> Hours
todHour (TimeOfDay -> Hours) -> TimeOfDay -> Hours
forall a b. (a -> b) -> a -> b
$ DateTime -> TimeOfDay
dtTime (DateTime -> TimeOfDay) -> DateTime -> TimeOfDay
forall a b. (a -> b) -> a -> b
$ LocalTime DateTime -> DateTime
forall t. LocalTime t -> t
localTimeUnwrap LocalTime DateTime
datetime of
        Hours
x | Hours
x Hours -> Hours -> Bool
forall a. Ord a => a -> a -> Bool
<= Hours
12 -> Hours
x
        Hours
24 -> Hours
12
        Hours
x -> Hours
x Hours -> Hours -> Hours
forall a. Num a => a -> a -> a
- Hours
11),
    (Text
"minute", Minutes -> GVal a
forall x (a :: * -> *). (Enum x, Show x) => x -> GVal a
enumG (Minutes -> GVal a) -> Minutes -> GVal a
forall a b. (a -> b) -> a -> b
$ TimeOfDay -> Minutes
todMin (TimeOfDay -> Minutes) -> TimeOfDay -> Minutes
forall a b. (a -> b) -> a -> b
$ DateTime -> TimeOfDay
dtTime (DateTime -> TimeOfDay) -> DateTime -> TimeOfDay
forall a b. (a -> b) -> a -> b
$ LocalTime DateTime -> DateTime
forall t. LocalTime t -> t
localTimeUnwrap LocalTime DateTime
datetime),
    (Text
"second", Seconds -> GVal a
forall x (a :: * -> *). (Enum x, Show x) => x -> GVal a
enumG (Seconds -> GVal a) -> Seconds -> GVal a
forall a b. (a -> b) -> a -> b
$ TimeOfDay -> Seconds
todSec (TimeOfDay -> Seconds) -> TimeOfDay -> Seconds
forall a b. (a -> b) -> a -> b
$ DateTime -> TimeOfDay
dtTime (DateTime -> TimeOfDay) -> DateTime -> TimeOfDay
forall a b. (a -> b) -> a -> b
$ LocalTime DateTime -> DateTime
forall t. LocalTime t -> t
localTimeUnwrap LocalTime DateTime
datetime),
    (Text
"nano", (NanoSeconds -> Int) -> NanoSeconds -> GVal a
forall x (m :: * -> *) a.
(Show x, ToGVal m a) =>
(x -> a) -> x -> GVal m
showG NanoSeconds -> Int
unwrapNanos (NanoSeconds -> GVal a) -> NanoSeconds -> GVal a
forall a b. (a -> b) -> a -> b
$ TimeOfDay -> NanoSeconds
todNSec (TimeOfDay -> NanoSeconds) -> TimeOfDay -> NanoSeconds
forall a b. (a -> b) -> a -> b
$ DateTime -> TimeOfDay
dtTime (DateTime -> TimeOfDay) -> DateTime -> TimeOfDay
forall a b. (a -> b) -> a -> b
$ LocalTime DateTime -> DateTime
forall t. LocalTime t -> t
localTimeUnwrap LocalTime DateTime
datetime),
    (Text
"zone", (TimezoneOffset -> Int) -> TimezoneOffset -> GVal a
forall x (m :: * -> *) a.
(Show x, ToGVal m a) =>
(x -> a) -> x -> GVal m
showG TimezoneOffset -> Int
timezoneOffsetToMinutes (TimezoneOffset -> GVal a) -> TimezoneOffset -> GVal a
forall a b. (a -> b) -> a -> b
$ LocalTime DateTime -> TimezoneOffset
forall t. LocalTime t -> TimezoneOffset
localTimeGetTimezone LocalTime DateTime
datetime),
    Text
"daysInMonth" Text -> Int -> Pair a
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> (Date -> Int
dateYear Date
date Int -> Month -> Int
`daysInMonth` Date -> Month
dateMonth Date
date),
    (Text
"monthStart", Int -> GVal a
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal (Int -> GVal a) -> Int -> GVal a
forall a b. (a -> b) -> a -> b
$ WeekDay -> Int
forall a. Enum a => a -> Int
fromEnum (WeekDay -> Int) -> WeekDay -> Int
forall a b. (a -> b) -> a -> b
$ Date -> WeekDay
getWeekDay Date
date { dateDay = 1 })
   ]
  where
    date :: Date
date = DateTime -> Date
dtDate (DateTime -> Date) -> DateTime -> Date
forall a b. (a -> b) -> a -> b
$ LocalTime DateTime -> DateTime
forall t. LocalTime t -> t
localTimeUnwrap LocalTime DateTime
datetime

-- Converts an enum to Ginger's datamodel.
enumG :: (Enum x, Show x) => x -> GVal a
enumG :: forall x (a :: * -> *). (Enum x, Show x) => x -> GVal a
enumG = (x -> Int) -> x -> GVal a
forall x (m :: * -> *) a.
(Show x, ToGVal m a) =>
(x -> a) -> x -> GVal m
showG x -> Int
forall a. Enum a => a -> Int
fromEnum
-- | Converts showable data to Ginger's datamodel via a callback.
showG :: (Show x, ToGVal m a) => (x -> a) -> x -> GVal m
showG :: forall x (m :: * -> *) a.
(Show x, ToGVal m a) =>
(x -> a) -> x -> GVal m
showG x -> a
cb x
x = (a -> GVal m
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal (a -> GVal m) -> a -> GVal m
forall a b. (a -> b) -> a -> b
$ x -> a
cb x
x) {
    asText = Txt.pack $ show x,
    asHtml = unsafeRawHtml $ Txt.pack $ show x
  }
-- Retrieves the integral value from HourGlass Nanoseconds.
unwrapNanos :: NanoSeconds -> Int
unwrapNanos :: NanoSeconds -> Int
unwrapNanos (NanoSeconds Int64
x) = Int64 -> Int
forall a. Enum a => a -> Int
fromEnum Int64
x

-- | Interpret an operation upon a given time.
modifyTime :: Txt.Text -> LocalTime DateTime -> Maybe (LocalTime DateTime)
modifyTime :: Text -> LocalTime DateTime -> Maybe (LocalTime DateTime)
modifyTime Text
"-hour" LocalTime DateTime
time = LocalTime DateTime
-> (DateTime -> DateTime) -> Maybe (LocalTime DateTime)
forall a b. LocalTime a -> (a -> b) -> Maybe (LocalTime b)
modLTime LocalTime DateTime
time ((DateTime -> DateTime) -> Maybe (LocalTime DateTime))
-> (DateTime -> DateTime) -> Maybe (LocalTime DateTime)
forall a b. (a -> b) -> a -> b
$ (DateTime -> Duration -> DateTime)
-> Duration -> DateTime -> DateTime
forall a b c. (a -> b -> c) -> b -> a -> c
flip DateTime -> Duration -> DateTime
forall t ti. (Time t, TimeInterval ti) => t -> ti -> t
timeAdd Duration
forall a. Monoid a => a
mempty { durationHours = -1 }
modifyTime Text
"+hour" LocalTime DateTime
time = LocalTime DateTime
-> (DateTime -> DateTime) -> Maybe (LocalTime DateTime)
forall a b. LocalTime a -> (a -> b) -> Maybe (LocalTime b)
modLTime LocalTime DateTime
time ((DateTime -> DateTime) -> Maybe (LocalTime DateTime))
-> (DateTime -> DateTime) -> Maybe (LocalTime DateTime)
forall a b. (a -> b) -> a -> b
$ (DateTime -> Duration -> DateTime)
-> Duration -> DateTime -> DateTime
forall a b c. (a -> b -> c) -> b -> a -> c
flip DateTime -> Duration -> DateTime
forall t ti. (Time t, TimeInterval ti) => t -> ti -> t
timeAdd Duration
forall a. Monoid a => a
mempty { durationHours = 1 }
modifyTime Text
"-minute" LocalTime DateTime
time = LocalTime DateTime
-> (DateTime -> DateTime) -> Maybe (LocalTime DateTime)
forall a b. LocalTime a -> (a -> b) -> Maybe (LocalTime b)
modLTime LocalTime DateTime
time ((DateTime -> DateTime) -> Maybe (LocalTime DateTime))
-> (DateTime -> DateTime) -> Maybe (LocalTime DateTime)
forall a b. (a -> b) -> a -> b
$ (DateTime -> Duration -> DateTime)
-> Duration -> DateTime -> DateTime
forall a b c. (a -> b -> c) -> b -> a -> c
flip DateTime -> Duration -> DateTime
forall t ti. (Time t, TimeInterval ti) => t -> ti -> t
timeAdd Duration
forall a. Monoid a => a
mempty { durationMinutes = -1 }
modifyTime Text
"+minute" LocalTime DateTime
time = LocalTime DateTime
-> (DateTime -> DateTime) -> Maybe (LocalTime DateTime)
forall a b. LocalTime a -> (a -> b) -> Maybe (LocalTime b)
modLTime LocalTime DateTime
time ((DateTime -> DateTime) -> Maybe (LocalTime DateTime))
-> (DateTime -> DateTime) -> Maybe (LocalTime DateTime)
forall a b. (a -> b) -> a -> b
$ (DateTime -> Duration -> DateTime)
-> Duration -> DateTime -> DateTime
forall a b c. (a -> b -> c) -> b -> a -> c
flip DateTime -> Duration -> DateTime
forall t ti. (Time t, TimeInterval ti) => t -> ti -> t
timeAdd Duration
forall a. Monoid a => a
mempty { durationMinutes = 1 }
modifyTime Text
"meridiem" LocalTime DateTime
time = case TimeOfDay -> Hours
todHour (TimeOfDay -> Hours) -> TimeOfDay -> Hours
forall a b. (a -> b) -> a -> b
$ DateTime -> TimeOfDay
dtTime (DateTime -> TimeOfDay) -> DateTime -> TimeOfDay
forall a b. (a -> b) -> a -> b
$ LocalTime DateTime -> DateTime
forall t. LocalTime t -> t
localTimeUnwrap LocalTime DateTime
time of
    Hours
12 -> LocalTime DateTime
-> (DateTime -> DateTime) -> Maybe (LocalTime DateTime)
forall a b. LocalTime a -> (a -> b) -> Maybe (LocalTime b)
modLTime LocalTime DateTime
time ((DateTime -> DateTime) -> Maybe (LocalTime DateTime))
-> (DateTime -> DateTime) -> Maybe (LocalTime DateTime)
forall a b. (a -> b) -> a -> b
$ \DateTime
time' -> DateTime
time' {
        dtTime = (dtTime time') { todHour = 24 }
      }
    Hours
x | Hours
x Hours -> Hours -> Bool
forall a. Ord a => a -> a -> Bool
< Hours
12 -> LocalTime DateTime
-> (DateTime -> DateTime) -> Maybe (LocalTime DateTime)
forall a b. LocalTime a -> (a -> b) -> Maybe (LocalTime b)
modLTime LocalTime DateTime
time ((DateTime -> DateTime) -> Maybe (LocalTime DateTime))
-> (DateTime -> DateTime) -> Maybe (LocalTime DateTime)
forall a b. (a -> b) -> a -> b
$ \DateTime
time' -> DateTime
time' {
        dtTime = (dtTime time') { todHour = x + 12 }
      }
    Hours
x -> LocalTime DateTime
-> (DateTime -> DateTime) -> Maybe (LocalTime DateTime)
forall a b. LocalTime a -> (a -> b) -> Maybe (LocalTime b)
modLTime LocalTime DateTime
time ((DateTime -> DateTime) -> Maybe (LocalTime DateTime))
-> (DateTime -> DateTime) -> Maybe (LocalTime DateTime)
forall a b. (a -> b) -> a -> b
$ \DateTime
time' -> DateTime
time' {
        dtTime = (dtTime time') { todHour = x - 12 }
      }
modifyTime Text
"-second" LocalTime DateTime
time = LocalTime DateTime
-> (DateTime -> DateTime) -> Maybe (LocalTime DateTime)
forall a b. LocalTime a -> (a -> b) -> Maybe (LocalTime b)
modLTime LocalTime DateTime
time ((DateTime -> DateTime) -> Maybe (LocalTime DateTime))
-> (DateTime -> DateTime) -> Maybe (LocalTime DateTime)
forall a b. (a -> b) -> a -> b
$ (DateTime -> Duration -> DateTime)
-> Duration -> DateTime -> DateTime
forall a b c. (a -> b -> c) -> b -> a -> c
flip DateTime -> Duration -> DateTime
forall t ti. (Time t, TimeInterval ti) => t -> ti -> t
timeAdd Duration
forall a. Monoid a => a
mempty { durationSeconds = -1 }
modifyTime Text
"+second" LocalTime DateTime
time = LocalTime DateTime
-> (DateTime -> DateTime) -> Maybe (LocalTime DateTime)
forall a b. LocalTime a -> (a -> b) -> Maybe (LocalTime b)
modLTime LocalTime DateTime
time ((DateTime -> DateTime) -> Maybe (LocalTime DateTime))
-> (DateTime -> DateTime) -> Maybe (LocalTime DateTime)
forall a b. (a -> b) -> a -> b
$ (DateTime -> Duration -> DateTime)
-> Duration -> DateTime -> DateTime
forall a b c. (a -> b -> c) -> b -> a -> c
flip DateTime -> Duration -> DateTime
forall t ti. (Time t, TimeInterval ti) => t -> ti -> t
timeAdd Duration
forall a. Monoid a => a
mempty { durationSeconds = 1 }
modifyTime Text
"-nano" LocalTime DateTime
time = LocalTime DateTime
-> (DateTime -> DateTime) -> Maybe (LocalTime DateTime)
forall a b. LocalTime a -> (a -> b) -> Maybe (LocalTime b)
modLTime LocalTime DateTime
time ((DateTime -> DateTime) -> Maybe (LocalTime DateTime))
-> (DateTime -> DateTime) -> Maybe (LocalTime DateTime)
forall a b. (a -> b) -> a -> b
$ (DateTime -> Duration -> DateTime)
-> Duration -> DateTime -> DateTime
forall a b c. (a -> b -> c) -> b -> a -> c
flip DateTime -> Duration -> DateTime
forall t ti. (Time t, TimeInterval ti) => t -> ti -> t
timeAdd Duration
forall a. Monoid a => a
mempty { durationNs = -1 }
modifyTime Text
"+nano" LocalTime DateTime
time = LocalTime DateTime
-> (DateTime -> DateTime) -> Maybe (LocalTime DateTime)
forall a b. LocalTime a -> (a -> b) -> Maybe (LocalTime b)
modLTime LocalTime DateTime
time ((DateTime -> DateTime) -> Maybe (LocalTime DateTime))
-> (DateTime -> DateTime) -> Maybe (LocalTime DateTime)
forall a b. (a -> b) -> a -> b
$ (DateTime -> Duration -> DateTime)
-> Duration -> DateTime -> DateTime
forall a b c. (a -> b -> c) -> b -> a -> c
flip DateTime -> Duration -> DateTime
forall t ti. (Time t, TimeInterval ti) => t -> ti -> t
timeAdd Duration
forall a. Monoid a => a
mempty { durationNs = 1 }
modifyTime Text
"-zone" LocalTime DateTime
time = LocalTime DateTime -> Int -> Maybe (LocalTime DateTime)
forall t. Time t => LocalTime t -> Int -> Maybe (LocalTime t)
offsetTZ LocalTime DateTime
time (-Int
30) -- TODO Include a timezone database...
modifyTime Text
"+zone" LocalTime DateTime
time = LocalTime DateTime -> Int -> Maybe (LocalTime DateTime)
forall t. Time t => LocalTime t -> Int -> Maybe (LocalTime t)
offsetTZ LocalTime DateTime
time Int
30
modifyTime Text
"now" LocalTime DateTime
_ = LocalTime DateTime -> Maybe (LocalTime DateTime)
forall a. a -> Maybe a
Just (LocalTime DateTime -> Maybe (LocalTime DateTime))
-> LocalTime DateTime -> Maybe (LocalTime DateTime)
forall a b. (a -> b) -> a -> b
$ IO (LocalTime DateTime) -> LocalTime DateTime
forall a. IO a -> a
unsafePerformIO (IO (LocalTime DateTime) -> LocalTime DateTime)
-> IO (LocalTime DateTime) -> LocalTime DateTime
forall a b. (a -> b) -> a -> b
$ IO (LocalTime DateTime)
localDateCurrent
modifyTime Text
op LocalTime DateTime
time
    | Just Text
x' <- Text -> Text -> Maybe Text
Txt.stripPrefix Text
"year=" Text
op, Just Int
x <- String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Int) -> String -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Text -> String
Txt.unpack Text
x' =
        LocalTime DateTime
-> (DateTime -> DateTime) -> Maybe (LocalTime DateTime)
forall a b. LocalTime a -> (a -> b) -> Maybe (LocalTime b)
modLTime LocalTime DateTime
time ((DateTime -> DateTime) -> Maybe (LocalTime DateTime))
-> (DateTime -> DateTime) -> Maybe (LocalTime DateTime)
forall a b. (a -> b) -> a -> b
$ \DateTime
time' -> DateTime
time' { dtDate = date { dateYear = toEnum x } }
    | Just Text
x' <- Text -> Text -> Maybe Text
Txt.stripPrefix Text
"month=" Text
op, Just Int
x <- String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Int) -> String -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Text -> String
Txt.unpack Text
x' =
        LocalTime DateTime
-> (DateTime -> DateTime) -> Maybe (LocalTime DateTime)
forall a b. LocalTime a -> (a -> b) -> Maybe (LocalTime b)
modLTime LocalTime DateTime
time ((DateTime -> DateTime) -> Maybe (LocalTime DateTime))
-> (DateTime -> DateTime) -> Maybe (LocalTime DateTime)
forall a b. (a -> b) -> a -> b
$ \DateTime
time' -> DateTime
time' { dtDate = date { dateMonth = toEnum x } }
    | Just Text
x' <- Text -> Text -> Maybe Text
Txt.stripPrefix Text
"date=" Text
op, Just Int
x <- String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Int) -> String -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Text -> String
Txt.unpack Text
x' =
        LocalTime DateTime
-> (DateTime -> DateTime) -> Maybe (LocalTime DateTime)
forall a b. LocalTime a -> (a -> b) -> Maybe (LocalTime b)
modLTime LocalTime DateTime
time ((DateTime -> DateTime) -> Maybe (LocalTime DateTime))
-> (DateTime -> DateTime) -> Maybe (LocalTime DateTime)
forall a b. (a -> b) -> a -> b
$ \DateTime
time' -> DateTime
time' { dtDate = date { dateDay = toEnum x } }
    | Just Text
x' <- Text -> Text -> Maybe Text
Txt.stripPrefix Text
"hour=" Text
op, Just Int
x <- String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Int) -> String -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Text -> String
Txt.unpack Text
x' =
        LocalTime DateTime
-> (DateTime -> DateTime) -> Maybe (LocalTime DateTime)
forall a b. LocalTime a -> (a -> b) -> Maybe (LocalTime b)
modLTime LocalTime DateTime
time ((DateTime -> DateTime) -> Maybe (LocalTime DateTime))
-> (DateTime -> DateTime) -> Maybe (LocalTime DateTime)
forall a b. (a -> b) -> a -> b
$ \DateTime
time' -> DateTime
time' { dtTime = time_ {
            todHour = toEnum x + (if isAM then 0 else 12)
        } }
    | Just Text
x' <- Text -> Text -> Maybe Text
Txt.stripPrefix Text
"minute=" Text
op, Just Int
x <- String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Int) -> String -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Text -> String
Txt.unpack Text
x' =
        LocalTime DateTime
-> (DateTime -> DateTime) -> Maybe (LocalTime DateTime)
forall a b. LocalTime a -> (a -> b) -> Maybe (LocalTime b)
modLTime LocalTime DateTime
time ((DateTime -> DateTime) -> Maybe (LocalTime DateTime))
-> (DateTime -> DateTime) -> Maybe (LocalTime DateTime)
forall a b. (a -> b) -> a -> b
$ \DateTime
time' -> DateTime
time' { dtTime = time_ { todMin = toEnum x } }
    | Just Text
x' <- Text -> Text -> Maybe Text
Txt.stripPrefix Text
"second=" Text
op, Just Int
x <- String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Int) -> String -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Text -> String
Txt.unpack Text
x' =
        LocalTime DateTime
-> (DateTime -> DateTime) -> Maybe (LocalTime DateTime)
forall a b. LocalTime a -> (a -> b) -> Maybe (LocalTime b)
modLTime LocalTime DateTime
time ((DateTime -> DateTime) -> Maybe (LocalTime DateTime))
-> (DateTime -> DateTime) -> Maybe (LocalTime DateTime)
forall a b. (a -> b) -> a -> b
$ \DateTime
time' -> DateTime
time' { dtTime = time_ { todSec = toEnum x } }
    | Just Text
x' <- Text -> Text -> Maybe Text
Txt.stripPrefix Text
"nano=" Text
op, Just Int64
x <- String -> Maybe Int64
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Int64) -> String -> Maybe Int64
forall a b. (a -> b) -> a -> b
$ Text -> String
Txt.unpack Text
x' =
        LocalTime DateTime
-> (DateTime -> DateTime) -> Maybe (LocalTime DateTime)
forall a b. LocalTime a -> (a -> b) -> Maybe (LocalTime b)
modLTime LocalTime DateTime
time ((DateTime -> DateTime) -> Maybe (LocalTime DateTime))
-> (DateTime -> DateTime) -> Maybe (LocalTime DateTime)
forall a b. (a -> b) -> a -> b
$ \DateTime
time' -> DateTime
time' { dtTime = time_ { todNSec = NanoSeconds x } }
    | Just Text
x' <- Text -> Text -> Maybe Text
Txt.stripPrefix Text
"zone=" Text
op, Just Int
x <- String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Int) -> String -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Text -> String
Txt.unpack Text
x' =
        LocalTime DateTime -> Maybe (LocalTime DateTime)
forall a. a -> Maybe a
Just (LocalTime DateTime -> Maybe (LocalTime DateTime))
-> LocalTime DateTime -> Maybe (LocalTime DateTime)
forall a b. (a -> b) -> a -> b
$ TimezoneOffset -> LocalTime DateTime -> LocalTime DateTime
forall t. Time t => TimezoneOffset -> LocalTime t -> LocalTime t
localTimeSetTimezone (Int -> TimezoneOffset
TimezoneOffset Int
x) LocalTime DateTime
time
    | Just Text
x' <- Text -> Text -> Maybe Text
Txt.stripPrefix Text
"year/:" Text
op, Just Int
x <- String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Int) -> String -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Text -> String
Txt.unpack Text
x' =
        LocalTime DateTime
-> (DateTime -> DateTime) -> Maybe (LocalTime DateTime)
forall a b. LocalTime a -> (a -> b) -> Maybe (LocalTime b)
modLTime LocalTime DateTime
time ((DateTime -> DateTime) -> Maybe (LocalTime DateTime))
-> (DateTime -> DateTime) -> Maybe (LocalTime DateTime)
forall a b. (a -> b) -> a -> b
$ \DateTime
time' -> DateTime
time' {
            dtDate = date { dateYear = dateYear date * 10 + x }
          }
    | Text
"year/-" <- Text
op = LocalTime DateTime
-> (DateTime -> DateTime) -> Maybe (LocalTime DateTime)
forall a b. LocalTime a -> (a -> b) -> Maybe (LocalTime b)
modLTime LocalTime DateTime
time ((DateTime -> DateTime) -> Maybe (LocalTime DateTime))
-> (DateTime -> DateTime) -> Maybe (LocalTime DateTime)
forall a b. (a -> b) -> a -> b
$ \DateTime
time' -> DateTime
time' {
            dtDate = date { dateYear = dateYear date `div` 10 }
          }
    | Text
"year/" <- Text
op = LocalTime DateTime -> Maybe (LocalTime DateTime)
forall a. a -> Maybe a
Just LocalTime DateTime
time -- Noop, allow viewer.
  where
    date :: Date
date = DateTime -> Date
dtDate (DateTime -> Date) -> DateTime -> Date
forall a b. (a -> b) -> a -> b
$ LocalTime DateTime -> DateTime
forall t. LocalTime t -> t
localTimeUnwrap LocalTime DateTime
time
    time_ :: TimeOfDay
time_ = DateTime -> TimeOfDay
dtTime (DateTime -> TimeOfDay) -> DateTime -> TimeOfDay
forall a b. (a -> b) -> a -> b
$ LocalTime DateTime -> DateTime
forall t. LocalTime t -> t
localTimeUnwrap LocalTime DateTime
time
    isAM :: Bool
isAM | TimeOfDay -> Hours
todHour TimeOfDay
time_ Hours -> Hours -> Bool
forall a. Eq a => a -> a -> Bool
== Hours
24 = Bool
True
        | TimeOfDay -> Hours
todHour TimeOfDay
time_ Hours -> Hours -> Bool
forall a. Ord a => a -> a -> Bool
< Hours
12 = Bool
True
        | Bool
otherwise = Bool
False
-- Written this way to avoid GHC complaining about us pattern-matching too much! Blasphemy!
modifyTime Text
op LocalTime DateTime
time = case Text
op of
    Text
"-year" -> LocalTime DateTime -> Period -> Maybe (LocalTime DateTime)
addPeriod' LocalTime DateTime
time Period
forall a. Monoid a => a
mempty { periodYears = -1 }
    Text
"+year" -> LocalTime DateTime -> Period -> Maybe (LocalTime DateTime)
addPeriod' LocalTime DateTime
time Period
forall a. Monoid a => a
mempty { periodYears = 1 }
    Text
"-month" -> LocalTime DateTime -> Period -> Maybe (LocalTime DateTime)
addPeriod' LocalTime DateTime
time Period
forall a. Monoid a => a
mempty { periodMonths = -1 }
    Text
"+month" -> LocalTime DateTime -> Period -> Maybe (LocalTime DateTime)
addPeriod' LocalTime DateTime
time Period
forall a. Monoid a => a
mempty { periodMonths = 1 }
    Text
"-date" -> LocalTime DateTime -> Period -> Maybe (LocalTime DateTime)
addPeriod' LocalTime DateTime
time Period
forall a. Monoid a => a
mempty { periodDays = -1 }
    Text
"+date" -> LocalTime DateTime -> Period -> Maybe (LocalTime DateTime)
addPeriod' LocalTime DateTime
time Period
forall a. Monoid a => a
mempty { periodDays = 1 }
    Text
"-date7" -> LocalTime DateTime -> Period -> Maybe (LocalTime DateTime)
addPeriod' LocalTime DateTime
time Period
forall a. Monoid a => a
mempty { periodDays = -7 }
    Text
"+date7" -> LocalTime DateTime -> Period -> Maybe (LocalTime DateTime)
addPeriod' LocalTime DateTime
time Period
forall a. Monoid a => a
mempty { periodDays = 7 }
    Text
_ -> Maybe (LocalTime DateTime)
forall a. Maybe a
Nothing
-- | Helper for modifying HourGlass data.
modLTime :: LocalTime a -> (a -> b) -> Maybe (LocalTime b)
modLTime :: forall a b. LocalTime a -> (a -> b) -> Maybe (LocalTime b)
modLTime LocalTime a
a = LocalTime b -> Maybe (LocalTime b)
forall a. a -> Maybe a
Just (LocalTime b -> Maybe (LocalTime b))
-> ((a -> b) -> LocalTime b) -> (a -> b) -> Maybe (LocalTime b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a -> b) -> LocalTime a -> LocalTime b)
-> LocalTime a -> (a -> b) -> LocalTime b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> b) -> LocalTime a -> LocalTime b
forall a b. (a -> b) -> LocalTime a -> LocalTime b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LocalTime a
a
-- | Helper for adding an offset to a HourGlass local time.
addPeriod' :: LocalTime DateTime -> Period -> Maybe (LocalTime DateTime)
addPeriod' :: LocalTime DateTime -> Period -> Maybe (LocalTime DateTime)
addPeriod' LocalTime DateTime
time Period
period = LocalTime DateTime
-> (DateTime -> DateTime) -> Maybe (LocalTime DateTime)
forall a b. LocalTime a -> (a -> b) -> Maybe (LocalTime b)
modLTime LocalTime DateTime
time ((DateTime -> DateTime) -> Maybe (LocalTime DateTime))
-> (DateTime -> DateTime) -> Maybe (LocalTime DateTime)
forall a b. (a -> b) -> a -> b
$ \DateTime
time' -> DateTime
time' {
    dtDate = dtDate time' `dateAddPeriod` period
  }
-- | Helper for adding an offset to the timezone of a local time as stored by HourGlass.
offsetTZ :: Time t => LocalTime t -> Int -> Maybe (LocalTime t)
offsetTZ :: forall t. Time t => LocalTime t -> Int -> Maybe (LocalTime t)
offsetTZ LocalTime t
time Int
mins = LocalTime t -> Maybe (LocalTime t)
forall a. a -> Maybe a
Just (LocalTime t -> Maybe (LocalTime t))
-> LocalTime t -> Maybe (LocalTime t)
forall a b. (a -> b) -> a -> b
$ TimezoneOffset -> LocalTime t -> LocalTime t
forall t. Time t => TimezoneOffset -> LocalTime t -> LocalTime t
localTimeSetTimezone
    (Int -> TimezoneOffset
TimezoneOffset (Int -> TimezoneOffset) -> Int -> TimezoneOffset
forall a b. (a -> b) -> a -> b
$ TimezoneOffset -> Int
timezoneOffsetToMinutes (LocalTime t -> TimezoneOffset
forall t. LocalTime t -> TimezoneOffset
localTimeGetTimezone LocalTime t
time) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
mins)
    LocalTime t
time

-- | Helper for modifying time component of HourGlass data.
modifyTime' :: Txt.Text -> String -> Maybe String
modifyTime' :: Text -> String -> Maybe String
modifyTime' Text
op String
time
    | Just LocalTime DateTime
ret <- Text -> LocalTime DateTime -> Maybe (LocalTime DateTime)
modifyTime Text
op (LocalTime DateTime -> Maybe (LocalTime DateTime))
-> LocalTime DateTime -> Maybe (LocalTime DateTime)
forall a b. (a -> b) -> a -> b
$ IO (LocalTime DateTime) -> LocalTime DateTime
forall a. IO a -> a
unsafePerformIO (IO (LocalTime DateTime) -> LocalTime DateTime)
-> IO (LocalTime DateTime) -> LocalTime DateTime
forall a b. (a -> b) -> a -> b
$ String -> IO (LocalTime DateTime)
timeParseOrNow String
time =
        String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ ISO8601_DateAndTime -> LocalTime DateTime -> String
forall format t.
(TimeFormat format, Timeable t) =>
format -> LocalTime t -> String
localTimePrint ISO8601_DateAndTime
ISO8601_DateAndTime LocalTime DateTime
ret
    | Bool
otherwise = Maybe String
forall a. Maybe a
Nothing
-- | Parse a string to HourGlass data, falling back to the current time.
timeParseOrNow :: String -> IO (LocalTime DateTime)
timeParseOrNow :: String -> IO (LocalTime DateTime)
timeParseOrNow String
txt = case ISO8601_DateAndTime -> String -> Maybe (LocalTime DateTime)
forall format.
TimeFormat format =>
format -> String -> Maybe (LocalTime DateTime)
localTimeParse ISO8601_DateAndTime
ISO8601_DateAndTime String
txt of
    Just LocalTime DateTime
ret -> LocalTime DateTime -> IO (LocalTime DateTime)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return LocalTime DateTime
ret
    Maybe (LocalTime DateTime)
Nothing -> IO (LocalTime DateTime)
localDateCurrent

-- | A sequence to be called from Ginger templates.
gSeqTo :: [(a, GVal m)] -> GVal m
gSeqTo :: forall a (m :: * -> *). [(a, GVal m)] -> GVal m
gSeqTo [(a
_, GVal m
from), (a
_, GVal m
to)]
    | Just Int
x <- GVal m -> Maybe Int
forall (m :: * -> *). GVal m -> Maybe Int
toInt GVal m
from, Just Int
y <- GVal m -> Maybe Int
forall (m :: * -> *). GVal m -> Maybe Int
toInt GVal m
to = [Int] -> GVal m
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal [Int
x..Int
y]
gSeqTo [(a
_, GVal m
from), (a
_, GVal m
than), (a
_, GVal m
to)]
    | Just Int
x <- GVal m -> Maybe Int
forall (m :: * -> *). GVal m -> Maybe Int
toInt GVal m
from, Just Int
y <- GVal m -> Maybe Int
forall (m :: * -> *). GVal m -> Maybe Int
toInt GVal m
than, Just Int
z <- GVal m -> Maybe Int
forall (m :: * -> *). GVal m -> Maybe Int
toInt GVal m
to = [Int] -> GVal m
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal [Int
x,Int
y..Int
z]
gSeqTo [(a, GVal m)]
_ = () -> GVal m
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal ()

-- | A padding function to be called from Ginger templates,
-- prepending 0 when needed to get 2 digits.
gPad2 :: [(a, GVal m)] -> GVal m
gPad2 :: forall a (m :: * -> *). [(a, GVal m)] -> GVal m
gPad2 [(a
_, GVal m
x)] | Just Int
y <- GVal m -> Maybe Int
forall (m :: * -> *). GVal m -> Maybe Int
toInt GVal m
x, Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10 = String -> GVal m
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal (String -> GVal m) -> String -> GVal m
forall a b. (a -> b) -> a -> b
$ Char
'0'Char -> String -> String
forall a. a -> [a] -> [a]
:GVal m -> String
forall a. Show a => a -> String
show GVal m
x
    | Just Int
y <- GVal m -> Maybe Int
forall (m :: * -> *). GVal m -> Maybe Int
toInt GVal m
x = String -> GVal m
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal (String -> GVal m) -> String -> GVal m
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
y
gPad2 [(a, GVal m)]
_ = () -> GVal m
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal ()