-- Copyright (c) 2016-present, Facebook, Inc.
-- All rights reserved.
--
-- This source code is licensed under the BSD-style license found in the
-- LICENSE file in the root directory of this source tree.


{-# LANGUAGE OverloadedStrings #-}

module Duckling.Time.TimeZone.Parse
  ( parseTimezone
  ) where

import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.String
import Data.Text (Text)
import Data.Time (TimeZone(..))
import Prelude

-- `TimeZone` reads anything but only accepts timezones known
-- from the provided locale.
parseTimezone :: Text -> Maybe TimeZone
parseTimezone :: Text -> Maybe TimeZone
parseTimezone Text
x = Text -> HashMap Text TimeZone -> Maybe TimeZone
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
x HashMap Text TimeZone
tzs

tzs :: HashMap Text TimeZone
tzs :: HashMap Text TimeZone
tzs = [(Text, TimeZone)] -> HashMap Text TimeZone
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
  [ ( Text
"YEKT", Int -> Bool -> String -> TimeZone
TimeZone Int
300 Bool
False String
"YEKT" )
  , ( Text
"YEKST", Int -> Bool -> String -> TimeZone
TimeZone Int
360 Bool
True String
"YEKST" )
  , ( Text
"YAKT", Int -> Bool -> String -> TimeZone
TimeZone Int
540 Bool
False String
"YAKT" )
  , ( Text
"YAKST", Int -> Bool -> String -> TimeZone
TimeZone Int
600 Bool
True String
"YAKST" )
  , ( Text
"WITA", Int -> Bool -> String -> TimeZone
TimeZone Int
480 Bool
False String
"WITA" )
  , ( Text
"WIT", Int -> Bool -> String -> TimeZone
TimeZone Int
420 Bool
False String
"WIT" )
  , ( Text
"WIB", Int -> Bool -> String -> TimeZone
TimeZone Int
420 Bool
False String
"WIB" )
  , ( Text
"WGT", Int -> Bool -> String -> TimeZone
TimeZone (-Int
180) Bool
False String
"WGT" )
  , ( Text
"WGST", Int -> Bool -> String -> TimeZone
TimeZone (-Int
120) Bool
True String
"WGST" )
  , ( Text
"WFT", Int -> Bool -> String -> TimeZone
TimeZone Int
720 Bool
False String
"WFT" )
  , ( Text
"WET", Int -> Bool -> String -> TimeZone
TimeZone Int
0 Bool
False String
"WET" )
  , ( Text
"WEST", Int -> Bool -> String -> TimeZone
TimeZone Int
60 Bool
True String
"WEST" )
  , ( Text
"WAT", Int -> Bool -> String -> TimeZone
TimeZone Int
60 Bool
False String
"WAT" )
  , ( Text
"WAST", Int -> Bool -> String -> TimeZone
TimeZone Int
120 Bool
True String
"WAST" )
  , ( Text
"VUT", Int -> Bool -> String -> TimeZone
TimeZone Int
660 Bool
False String
"VUT" )
  , ( Text
"VLAT", Int -> Bool -> String -> TimeZone
TimeZone Int
660 Bool
False String
"VLAT" )
  , ( Text
"VLAST", Int -> Bool -> String -> TimeZone
TimeZone Int
660 Bool
True String
"VLAST" )
  , ( Text
"VET", Int -> Bool -> String -> TimeZone
TimeZone (-Int
270) Bool
False String
"VET" )
  , ( Text
"UZT", Int -> Bool -> String -> TimeZone
TimeZone Int
300 Bool
False String
"UZT" )
  , ( Text
"UYT", Int -> Bool -> String -> TimeZone
TimeZone (-Int
180) Bool
False String
"UYT" )
  , ( Text
"UYST", Int -> Bool -> String -> TimeZone
TimeZone (-Int
120) Bool
True String
"UYST" )
  , ( Text
"UTC", Int -> Bool -> String -> TimeZone
TimeZone Int
0 Bool
False String
"UTC" )
  , ( Text
"ULAT", Int -> Bool -> String -> TimeZone
TimeZone Int
480 Bool
False String
"ULAT" )
  , ( Text
"TVT", Int -> Bool -> String -> TimeZone
TimeZone Int
720 Bool
False String
"TVT" )
  , ( Text
"TMT", Int -> Bool -> String -> TimeZone
TimeZone Int
300 Bool
False String
"TMT" )
  , ( Text
"TLT", Int -> Bool -> String -> TimeZone
TimeZone Int
540 Bool
False String
"TLT" )
  , ( Text
"TKT", Int -> Bool -> String -> TimeZone
TimeZone Int
780 Bool
False String
"TKT" )
  , ( Text
"TJT", Int -> Bool -> String -> TimeZone
TimeZone Int
300 Bool
False String
"TJT" )
  , ( Text
"TFT", Int -> Bool -> String -> TimeZone
TimeZone Int
300 Bool
False String
"TFT" )
  , ( Text
"TAHT", Int -> Bool -> String -> TimeZone
TimeZone (-Int
600) Bool
False String
"TAHT" )
  , ( Text
"SST", Int -> Bool -> String -> TimeZone
TimeZone (-Int
660) Bool
False String
"SST" )
  , ( Text
"SRT", Int -> Bool -> String -> TimeZone
TimeZone (-Int
180) Bool
False String
"SRT" )
  , ( Text
"SGT", Int -> Bool -> String -> TimeZone
TimeZone Int
480 Bool
False String
"SGT" )
  , ( Text
"SCT", Int -> Bool -> String -> TimeZone
TimeZone Int
240 Bool
False String
"SCT" )
  , ( Text
"SBT", Int -> Bool -> String -> TimeZone
TimeZone Int
660 Bool
False String
"SBT" )
  , ( Text
"SAST", Int -> Bool -> String -> TimeZone
TimeZone Int
120 Bool
False String
"SAST" )
  , ( Text
"SAMT", Int -> Bool -> String -> TimeZone
TimeZone Int
300 Bool
False String
"SAMT" )
  , ( Text
"RET", Int -> Bool -> String -> TimeZone
TimeZone Int
240 Bool
False String
"RET" )
  , ( Text
"PYT", Int -> Bool -> String -> TimeZone
TimeZone (-Int
240) Bool
False String
"PYT" )
  , ( Text
"PYST", Int -> Bool -> String -> TimeZone
TimeZone (-Int
180) Bool
True String
"PYST" )
  , ( Text
"PWT", Int -> Bool -> String -> TimeZone
TimeZone (-Int
420) Bool
True String
"PWT" )
  , ( Text
"PST", Int -> Bool -> String -> TimeZone
TimeZone (-Int
480) Bool
False String
"PST" )
  , ( Text
"PONT", Int -> Bool -> String -> TimeZone
TimeZone Int
660 Bool
False String
"PONT" )
  , ( Text
"PMST", Int -> Bool -> String -> TimeZone
TimeZone (-Int
180) Bool
False String
"PMST" )
  , ( Text
"PMDT", Int -> Bool -> String -> TimeZone
TimeZone (-Int
120) Bool
True String
"PMDT" )
  , ( Text
"PKT", Int -> Bool -> String -> TimeZone
TimeZone Int
300 Bool
False String
"PKT" )
  , ( Text
"PHT", Int -> Bool -> String -> TimeZone
TimeZone Int
480 Bool
False String
"PHT" )
  , ( Text
"PHOT", Int -> Bool -> String -> TimeZone
TimeZone Int
780 Bool
False String
"PHOT" )
  , ( Text
"PGT", Int -> Bool -> String -> TimeZone
TimeZone Int
600 Bool
False String
"PGT" )
  , ( Text
"PETT", Int -> Bool -> String -> TimeZone
TimeZone Int
720 Bool
False String
"PETT" )
  , ( Text
"PETST", Int -> Bool -> String -> TimeZone
TimeZone Int
720 Bool
True String
"PETST" )
  , ( Text
"PET", Int -> Bool -> String -> TimeZone
TimeZone (-Int
300) Bool
False String
"PET" )
  , ( Text
"PDT", Int -> Bool -> String -> TimeZone
TimeZone (-Int
420) Bool
False String
"PDT" )
  , ( Text
"OMST", Int -> Bool -> String -> TimeZone
TimeZone Int
360 Bool
False String
"OMST" )
  , ( Text
"OMSST", Int -> Bool -> String -> TimeZone
TimeZone Int
420 Bool
True String
"OMSST" )
  , ( Text
"NZST", Int -> Bool -> String -> TimeZone
TimeZone Int
720 Bool
False String
"NZST" )
  , ( Text
"NZDT", Int -> Bool -> String -> TimeZone
TimeZone Int
780 Bool
False String
"NZDT" )
  , ( Text
"NUT", Int -> Bool -> String -> TimeZone
TimeZone (-Int
660) Bool
False String
"NUT" )
  , ( Text
"NST", Int -> Bool -> String -> TimeZone
TimeZone (-Int
660) Bool
False String
"NST" )
  , ( Text
"NPT", Int -> Bool -> String -> TimeZone
TimeZone (-Int
600) Bool
True String
"NPT" )
  , ( Text
"NOVT", Int -> Bool -> String -> TimeZone
TimeZone Int
360 Bool
False String
"NOVT" )
  , ( Text
"NOVST", Int -> Bool -> String -> TimeZone
TimeZone Int
420 Bool
True String
"NOVST" )
  , ( Text
"NFT", Int -> Bool -> String -> TimeZone
TimeZone Int
690 Bool
False String
"NFT" )
  , ( Text
"NDT", Int -> Bool -> String -> TimeZone
TimeZone (-Int
150) Bool
True String
"NDT" )
  , ( Text
"NCT", Int -> Bool -> String -> TimeZone
TimeZone Int
660 Bool
False String
"NCT" )
  , ( Text
"MYT", Int -> Bool -> String -> TimeZone
TimeZone Int
480 Bool
False String
"MYT" )
  , ( Text
"MVT", Int -> Bool -> String -> TimeZone
TimeZone Int
300 Bool
False String
"MVT" )
  , ( Text
"MUT", Int -> Bool -> String -> TimeZone
TimeZone Int
240 Bool
False String
"MUT" )
  , ( Text
"MST", Int -> Bool -> String -> TimeZone
TimeZone (-Int
420) Bool
False String
"MST" )
  , ( Text
"MSK", Int -> Bool -> String -> TimeZone
TimeZone Int
180 Bool
False String
"MSK" )
  , ( Text
"MSD", Int -> Bool -> String -> TimeZone
TimeZone Int
240 Bool
True String
"MSD" )
  , ( Text
"MMT", Int -> Bool -> String -> TimeZone
TimeZone Int
390 Bool
False String
"MMT" )
  , ( Text
"MHT", Int -> Bool -> String -> TimeZone
TimeZone Int
720 Bool
False String
"MHT" )
  , ( Text
"MDT", Int -> Bool -> String -> TimeZone
TimeZone (-Int
360) Bool
True String
"MDT" )
  , ( Text
"MAWT", Int -> Bool -> String -> TimeZone
TimeZone Int
300 Bool
False String
"MAWT" )
  , ( Text
"MART", Int -> Bool -> String -> TimeZone
TimeZone (-Int
570) Bool
False String
"MART" )
  , ( Text
"MAGT", Int -> Bool -> String -> TimeZone
TimeZone Int
600 Bool
False String
"MAGT" )
  , ( Text
"MAGST", Int -> Bool -> String -> TimeZone
TimeZone Int
720 Bool
True String
"MAGST" )
  , ( Text
"LINT", Int -> Bool -> String -> TimeZone
TimeZone Int
840 Bool
False String
"LINT" )
  , ( Text
"LHST", Int -> Bool -> String -> TimeZone
TimeZone Int
630 Bool
False String
"LHST" )
  , ( Text
"LHDT", Int -> Bool -> String -> TimeZone
TimeZone Int
660 Bool
True String
"LHDT" )
  , ( Text
"KUYT", Int -> Bool -> String -> TimeZone
TimeZone Int
180 Bool
False String
"KUYT" )
  , ( Text
"KST", Int -> Bool -> String -> TimeZone
TimeZone Int
540 Bool
False String
"KST" )
  , ( Text
"KRAT", Int -> Bool -> String -> TimeZone
TimeZone Int
420 Bool
False String
"KRAT" )
  , ( Text
"KRAST", Int -> Bool -> String -> TimeZone
TimeZone Int
480 Bool
True String
"KRAST" )
  , ( Text
"KGT", Int -> Bool -> String -> TimeZone
TimeZone Int
360 Bool
False String
"KGT" )
  , ( Text
"JST", Int -> Bool -> String -> TimeZone
TimeZone Int
540 Bool
False String
"JST" )
  , ( Text
"IST", Int -> Bool -> String -> TimeZone
TimeZone Int
330 Bool
False String
"IST" )
  , ( Text
"IRST", Int -> Bool -> String -> TimeZone
TimeZone Int
210 Bool
False String
"IRST" )
  , ( Text
"IRKT", Int -> Bool -> String -> TimeZone
TimeZone Int
480 Bool
False String
"IRKT" )
  , ( Text
"IRKST", Int -> Bool -> String -> TimeZone
TimeZone Int
540 Bool
True String
"IRKST" )
  , ( Text
"IRDT", Int -> Bool -> String -> TimeZone
TimeZone Int
270 Bool
True String
"IRDT" )
  , ( Text
"IOT", Int -> Bool -> String -> TimeZone
TimeZone Int
360 Bool
False String
"IOT" )
  , ( Text
"IDT", Int -> Bool -> String -> TimeZone
TimeZone Int
180 Bool
True String
"IDT" )
  , ( Text
"ICT", Int -> Bool -> String -> TimeZone
TimeZone Int
420 Bool
False String
"ICT" )
  , ( Text
"HOVT", Int -> Bool -> String -> TimeZone
TimeZone Int
420 Bool
False String
"HOVT" )
  , ( Text
"HKT", Int -> Bool -> String -> TimeZone
TimeZone Int
480 Bool
False String
"HKT" )
  , ( Text
"GYT", Int -> Bool -> String -> TimeZone
TimeZone (-Int
240) Bool
False String
"GYT" )
  , ( Text
"GST", Int -> Bool -> String -> TimeZone
TimeZone Int
240 Bool
False String
"GST" )
  , ( Text
"GMT", Int -> Bool -> String -> TimeZone
TimeZone Int
0 Bool
False String
"GMT" )
  , ( Text
"GILT", Int -> Bool -> String -> TimeZone
TimeZone Int
720 Bool
False String
"GILT" )
  , ( Text
"GFT", Int -> Bool -> String -> TimeZone
TimeZone (-Int
180) Bool
False String
"GFT" )
  , ( Text
"GET", Int -> Bool -> String -> TimeZone
TimeZone Int
240 Bool
False String
"GET" )
  , ( Text
"GAMT", Int -> Bool -> String -> TimeZone
TimeZone (-Int
540) Bool
False String
"GAMT" )
  , ( Text
"GALT", Int -> Bool -> String -> TimeZone
TimeZone (-Int
360) Bool
False String
"GALT" )
  , ( Text
"FNT", Int -> Bool -> String -> TimeZone
TimeZone (-Int
120) Bool
False String
"FNT" )
  , ( Text
"FKT", Int -> Bool -> String -> TimeZone
TimeZone (-Int
240) Bool
False String
"FKT" )
  , ( Text
"FKST", Int -> Bool -> String -> TimeZone
TimeZone (-Int
180) Bool
False String
"FKST" )
  , ( Text
"FJT", Int -> Bool -> String -> TimeZone
TimeZone Int
720 Bool
False String
"FJT" )
  , ( Text
"FJST", Int -> Bool -> String -> TimeZone
TimeZone Int
780 Bool
True String
"FJST" )
  , ( Text
"EST", Int -> Bool -> String -> TimeZone
TimeZone (-Int
300) Bool
False String
"EST" )
  , ( Text
"EGT", Int -> Bool -> String -> TimeZone
TimeZone (-Int
60) Bool
False String
"EGT" )
  , ( Text
"EGST", Int -> Bool -> String -> TimeZone
TimeZone Int
0 Bool
True String
"EGST" )
  , ( Text
"EET", Int -> Bool -> String -> TimeZone
TimeZone Int
120 Bool
False String
"EET" )
  , ( Text
"EEST", Int -> Bool -> String -> TimeZone
TimeZone Int
180 Bool
True String
"EEST" )
  , ( Text
"EDT", Int -> Bool -> String -> TimeZone
TimeZone (-Int
240) Bool
True String
"EDT" )
  , ( Text
"ECT", Int -> Bool -> String -> TimeZone
TimeZone (-Int
300) Bool
False String
"ECT" )
  , ( Text
"EAT", Int -> Bool -> String -> TimeZone
TimeZone Int
180 Bool
False String
"EAT" )
  , ( Text
"EAST", Int -> Bool -> String -> TimeZone
TimeZone (-Int
300) Bool
False String
"EAST" )
  , ( Text
"EASST", Int -> Bool -> String -> TimeZone
TimeZone (-Int
300) Bool
True String
"EASST" )
  , ( Text
"DAVT", Int -> Bool -> String -> TimeZone
TimeZone Int
420 Bool
False String
"DAVT" )
  , ( Text
"ChST", Int -> Bool -> String -> TimeZone
TimeZone Int
600 Bool
False String
"ChST" )
  , ( Text
"CXT", Int -> Bool -> String -> TimeZone
TimeZone Int
420 Bool
False String
"CXT" )
  , ( Text
"CVT", Int -> Bool -> String -> TimeZone
TimeZone (-Int
60) Bool
False String
"CVT" )
  , ( Text
"CST", Int -> Bool -> String -> TimeZone
TimeZone (-Int
360) Bool
False String
"CST" )
  , ( Text
"COT", Int -> Bool -> String -> TimeZone
TimeZone (-Int
300) Bool
False String
"COT" )
  , ( Text
"CLT", Int -> Bool -> String -> TimeZone
TimeZone (-Int
180) Bool
False String
"CLT" )
  , ( Text
"CLST", Int -> Bool -> String -> TimeZone
TimeZone (-Int
180) Bool
True String
"CLST" )
  , ( Text
"CKT", Int -> Bool -> String -> TimeZone
TimeZone (-Int
600) Bool
False String
"CKT" )
  , ( Text
"CHAST", Int -> Bool -> String -> TimeZone
TimeZone Int
765 Bool
False String
"CHAST" )
  , ( Text
"CHADT", Int -> Bool -> String -> TimeZone
TimeZone Int
825 Bool
True String
"CHADT" )
  , ( Text
"CET", Int -> Bool -> String -> TimeZone
TimeZone Int
60 Bool
False String
"CET" )
  , ( Text
"CEST", Int -> Bool -> String -> TimeZone
TimeZone Int
120 Bool
True String
"CEST" )
  , ( Text
"CDT", Int -> Bool -> String -> TimeZone
TimeZone (-Int
300) Bool
True String
"CDT" )
  , ( Text
"CCT", Int -> Bool -> String -> TimeZone
TimeZone Int
390 Bool
False String
"CCT" )
  , ( Text
"CAT", Int -> Bool -> String -> TimeZone
TimeZone Int
120 Bool
False String
"CAT" )
  , ( Text
"CAST", Int -> Bool -> String -> TimeZone
TimeZone Int
180 Bool
True String
"CAST" )
  , ( Text
"BTT", Int -> Bool -> String -> TimeZone
TimeZone Int
360 Bool
False String
"BTT" )
  , ( Text
"BST", Int -> Bool -> String -> TimeZone
TimeZone Int
60 Bool
False String
"BST" )
  , ( Text
"BRT", Int -> Bool -> String -> TimeZone
TimeZone (-Int
180) Bool
False String
"BRT" )
  , ( Text
"BRST", Int -> Bool -> String -> TimeZone
TimeZone (-Int
120) Bool
True String
"BRST" )
  , ( Text
"BOT", Int -> Bool -> String -> TimeZone
TimeZone (-Int
240) Bool
False String
"BOT" )
  , ( Text
"BNT", Int -> Bool -> String -> TimeZone
TimeZone Int
480 Bool
False String
"BNT" )
  , ( Text
"AZT", Int -> Bool -> String -> TimeZone
TimeZone Int
240 Bool
False String
"AZT" )
  , ( Text
"AZST", Int -> Bool -> String -> TimeZone
TimeZone Int
300 Bool
True String
"AZST" )
  , ( Text
"AZOT", Int -> Bool -> String -> TimeZone
TimeZone (-Int
60) Bool
False String
"AZOT" )
  , ( Text
"AZOST", Int -> Bool -> String -> TimeZone
TimeZone Int
0 Bool
True String
"AZOST" )
  , ( Text
"AWST", Int -> Bool -> String -> TimeZone
TimeZone Int
480 Bool
False String
"AWST" )
  , ( Text
"AWDT", Int -> Bool -> String -> TimeZone
TimeZone Int
540 Bool
True String
"AWDT" )
  , ( Text
"AST", Int -> Bool -> String -> TimeZone
TimeZone (-Int
240) Bool
False String
"AST" )
  , ( Text
"ART", Int -> Bool -> String -> TimeZone
TimeZone (-Int
180) Bool
False String
"ART" )
  , ( Text
"AQTT", Int -> Bool -> String -> TimeZone
TimeZone Int
300 Bool
False String
"AQTT" )
  , ( Text
"ANAT", Int -> Bool -> String -> TimeZone
TimeZone Int
720 Bool
False String
"ANAT" )
  , ( Text
"ANAST", Int -> Bool -> String -> TimeZone
TimeZone Int
720 Bool
True String
"ANAST" )
  , ( Text
"AMT", Int -> Bool -> String -> TimeZone
TimeZone Int
240 Bool
False String
"AMT" )
  , ( Text
"AMST", Int -> Bool -> String -> TimeZone
TimeZone Int
300 Bool
True String
"AMST" )
  , ( Text
"ALMT", Int -> Bool -> String -> TimeZone
TimeZone Int
360 Bool
False String
"ALMT" )
  , ( Text
"AKST", Int -> Bool -> String -> TimeZone
TimeZone (-Int
540) Bool
False String
"AKST" )
  , ( Text
"AKDT", Int -> Bool -> String -> TimeZone
TimeZone (-Int
480) Bool
True String
"AKDT" )
  , ( Text
"AFT", Int -> Bool -> String -> TimeZone
TimeZone Int
270 Bool
False String
"AFT" )
  , ( Text
"AEST", Int -> Bool -> String -> TimeZone
TimeZone Int
600 Bool
False String
"AEST" )
  , ( Text
"AEDT", Int -> Bool -> String -> TimeZone
TimeZone Int
660 Bool
True String
"AEDT" )
  , ( Text
"ADT", Int -> Bool -> String -> TimeZone
TimeZone (-Int
180) Bool
True String
"ADT" )
  , ( Text
"ACST", Int -> Bool -> String -> TimeZone
TimeZone Int
570 Bool
False String
"ACST" )
  , ( Text
"ACDT", Int -> Bool -> String -> TimeZone
TimeZone Int
630 Bool
True String
"ACDT" )
  ]