{-# LANGUAGE OverloadedStrings #-}
-- | Exposes data for a menu of timezones.
module Text.HTML.Form.WebApp.Ginger.TZ(tzdata, continents) where

import Text.Ginger.GVal as V (GVal, toGVal, orderedDict, (~>), list)
import qualified Data.Map.Strict as M
import Data.Time.Zones.All (tzNameLabelMap, tzByLabel)
import Data.Time.Zones (diffForPOSIX)

import Data.Int (Int64)
import Data.List (nub)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC

-- | Parses timezone data into a menu for Ginger templates.
tzdata :: Int64 -> String -> GVal m
tzdata :: forall (m :: * -> *). Int64 -> String -> GVal m
tzdata Int64
now String
prefix = Cons m -> GVal m
forall (m :: * -> *). Cons m -> GVal m
list [[Pair m] -> GVal m
forall (m :: * -> *). [Pair m] -> GVal m
orderedDict [
        Text
"label" Text -> ByteString -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> ByteString
label,
        Text
"value" Text -> Int -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> (TZ -> Int64 -> Int
diffForPOSIX TZ
tz' Int64
now Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
60),
        Text
"offset" Text -> String -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Int -> String
forall a. (Show a, Integral a) => a -> String
formatOffset (TZ -> Int64 -> Int
diffForPOSIX TZ
tz' Int64
now Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
60)
    ] | (ByteString
label, TZLabel
tz) <- Map ByteString TZLabel -> [(ByteString, TZLabel)]
forall k a. Map k a -> [(k, a)]
M.toList Map ByteString TZLabel
tzNameLabelMap,
        String -> ByteString
BSC.pack String
prefix ByteString -> ByteString -> Bool
`contains` ByteString
label,
        let tz' :: TZ
tz' = TZLabel -> TZ
tzByLabel TZLabel
tz]
  where
    contains :: ByteString -> ByteString -> Bool
contains ByteString
"" = Char -> ByteString -> Bool
BSC.notElem Char
'/'
    contains ByteString
"..." = Char -> ByteString -> Bool
BSC.notElem Char
'/'
    contains ByteString
x = ByteString -> ByteString -> Bool
BS.isPrefixOf ByteString
x
-- | Serialize an offset to string, ensuring 0 is prepended to minutes when needed.
formatOffset :: (Show a, Integral a) => a -> [Char]
formatOffset :: forall a. (Show a, Integral a) => a -> String
formatOffset a
offset
    | a
minutes a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
10 = a -> String
forall a. Show a => a -> String
show a
hours String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
':'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'0'Char -> String -> String
forall a. a -> [a] -> [a]
: a -> String
forall a. Show a => a -> String
show a
minutes
    | Bool
otherwise = a -> String
forall a. Show a => a -> String
show a
hours String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
':'Char -> String -> String
forall a. a -> [a] -> [a]
: a -> String
forall a. Show a => a -> String
show a
minutes
  where
    hours :: a
hours = a
offset a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
60
    minutes :: a
minutes = a -> a
forall a. Num a => a -> a
abs (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a
offset a -> a -> a
forall a. Integral a => a -> a -> a
`rem` a
60

-- | Retrieves continents list for Ginger templates.
continents :: GVal m
continents :: forall (m :: * -> *). GVal m
continents = Cons m -> GVal m
forall (m :: * -> *). Cons m -> GVal m
list (Cons m -> GVal m) -> Cons m -> GVal m
forall a b. (a -> b) -> a -> b
$ (ByteString -> GVal m) -> [ByteString] -> Cons m
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> GVal m
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal ([ByteString] -> Cons m) -> [ByteString] -> Cons m
forall a b. (a -> b) -> a -> b
$ [ByteString] -> [ByteString]
forall a. Eq a => [a] -> [a]
nub ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ ByteString
"..."ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString
prefix |
        (ByteString
label, TZLabel
_) <- Map ByteString TZLabel -> [(ByteString, TZLabel)]
forall k a. Map k a -> [(k, a)]
M.toList Map ByteString TZLabel
tzNameLabelMap,
        let (ByteString
prefix, ByteString
_) = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BSC.breakEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') ByteString
label]