-- 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 DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NoRebindableSyntax #-}

module Duckling.Region
  ( Region(..)
  ) where

import Data.Hashable
import GHC.Generics
import Prelude
import TextShow (TextShow)
import qualified TextShow as TS

-- | ISO 3166-1 alpha-2 Country code (includes regions and territories).
-- See https://en.wikipedia.org/wiki/ISO_3166-1_alpha-2
data Region
  = AR
  | AU
  | BE
  | BZ
  | CA
  | CL
  | CN
  | CO
  | EG
  | ES
  | GB
  | HK
  | IE
  | IN
  | JM
  | MN
  | MX
  | MO
  | NL
  | NZ
  | PE
  | PH
  | TT
  | TW
  | US
  | VE
  | ZA
  deriving (Region
Region -> Region -> Bounded Region
forall a. a -> a -> Bounded a
maxBound :: Region
$cmaxBound :: Region
minBound :: Region
$cminBound :: Region
Bounded, Int -> Region
Region -> Int
Region -> [Region]
Region -> Region
Region -> Region -> [Region]
Region -> Region -> Region -> [Region]
(Region -> Region)
-> (Region -> Region)
-> (Int -> Region)
-> (Region -> Int)
-> (Region -> [Region])
-> (Region -> Region -> [Region])
-> (Region -> Region -> [Region])
-> (Region -> Region -> Region -> [Region])
-> Enum Region
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Region -> Region -> Region -> [Region]
$cenumFromThenTo :: Region -> Region -> Region -> [Region]
enumFromTo :: Region -> Region -> [Region]
$cenumFromTo :: Region -> Region -> [Region]
enumFromThen :: Region -> Region -> [Region]
$cenumFromThen :: Region -> Region -> [Region]
enumFrom :: Region -> [Region]
$cenumFrom :: Region -> [Region]
fromEnum :: Region -> Int
$cfromEnum :: Region -> Int
toEnum :: Int -> Region
$ctoEnum :: Int -> Region
pred :: Region -> Region
$cpred :: Region -> Region
succ :: Region -> Region
$csucc :: Region -> Region
Enum, Region -> Region -> Bool
(Region -> Region -> Bool)
-> (Region -> Region -> Bool) -> Eq Region
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Region -> Region -> Bool
$c/= :: Region -> Region -> Bool
== :: Region -> Region -> Bool
$c== :: Region -> Region -> Bool
Eq, (forall x. Region -> Rep Region x)
-> (forall x. Rep Region x -> Region) -> Generic Region
forall x. Rep Region x -> Region
forall x. Region -> Rep Region x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Region x -> Region
$cfrom :: forall x. Region -> Rep Region x
Generic, Int -> Region -> Int
Region -> Int
(Int -> Region -> Int) -> (Region -> Int) -> Hashable Region
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Region -> Int
$chash :: Region -> Int
hashWithSalt :: Int -> Region -> Int
$chashWithSalt :: Int -> Region -> Int
Hashable, Eq Region
Eq Region
-> (Region -> Region -> Ordering)
-> (Region -> Region -> Bool)
-> (Region -> Region -> Bool)
-> (Region -> Region -> Bool)
-> (Region -> Region -> Bool)
-> (Region -> Region -> Region)
-> (Region -> Region -> Region)
-> Ord Region
Region -> Region -> Bool
Region -> Region -> Ordering
Region -> Region -> Region
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Region -> Region -> Region
$cmin :: Region -> Region -> Region
max :: Region -> Region -> Region
$cmax :: Region -> Region -> Region
>= :: Region -> Region -> Bool
$c>= :: Region -> Region -> Bool
> :: Region -> Region -> Bool
$c> :: Region -> Region -> Bool
<= :: Region -> Region -> Bool
$c<= :: Region -> Region -> Bool
< :: Region -> Region -> Bool
$c< :: Region -> Region -> Bool
compare :: Region -> Region -> Ordering
$ccompare :: Region -> Region -> Ordering
$cp1Ord :: Eq Region
Ord, ReadPrec [Region]
ReadPrec Region
Int -> ReadS Region
ReadS [Region]
(Int -> ReadS Region)
-> ReadS [Region]
-> ReadPrec Region
-> ReadPrec [Region]
-> Read Region
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Region]
$creadListPrec :: ReadPrec [Region]
readPrec :: ReadPrec Region
$creadPrec :: ReadPrec Region
readList :: ReadS [Region]
$creadList :: ReadS [Region]
readsPrec :: Int -> ReadS Region
$creadsPrec :: Int -> ReadS Region
Read, Int -> Region -> ShowS
[Region] -> ShowS
Region -> String
(Int -> Region -> ShowS)
-> (Region -> String) -> ([Region] -> ShowS) -> Show Region
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Region] -> ShowS
$cshowList :: [Region] -> ShowS
show :: Region -> String
$cshow :: Region -> String
showsPrec :: Int -> Region -> ShowS
$cshowsPrec :: Int -> Region -> ShowS
Show)

instance TextShow Region where
  showb :: Region -> Builder
showb = String -> Builder
TS.fromString (String -> Builder) -> (Region -> String) -> Region -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Region -> String
forall a. Show a => a -> String
show