{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}

module Continent.Unsafe
  ( Continent(..)
  , pattern Africa
  , pattern Asia
  , pattern Antarctica
  , pattern Europe
  , pattern NorthAmerica
  , pattern Oceania
  , pattern SouthAmerica
  , continentNameDb
  ) where

import Data.Text (Text)
import Data.Word (Word8)


newtype Continent = Continent Word8
  deriving(Continent -> Continent -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Continent -> Continent -> Bool
$c/= :: Continent -> Continent -> Bool
== :: Continent -> Continent -> Bool
$c== :: Continent -> Continent -> Bool
Eq,Eq Continent
Continent -> Continent -> Bool
Continent -> Continent -> Ordering
Continent -> Continent -> Continent
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 :: Continent -> Continent -> Continent
$cmin :: Continent -> Continent -> Continent
max :: Continent -> Continent -> Continent
$cmax :: Continent -> Continent -> Continent
>= :: Continent -> Continent -> Bool
$c>= :: Continent -> Continent -> Bool
> :: Continent -> Continent -> Bool
$c> :: Continent -> Continent -> Bool
<= :: Continent -> Continent -> Bool
$c<= :: Continent -> Continent -> Bool
< :: Continent -> Continent -> Bool
$c< :: Continent -> Continent -> Bool
compare :: Continent -> Continent -> Ordering
$ccompare :: Continent -> Continent -> Ordering
Ord,Int -> Continent
Continent -> Int
Continent -> [Continent]
Continent -> Continent
Continent -> Continent -> [Continent]
Continent -> Continent -> Continent -> [Continent]
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 :: Continent -> Continent -> Continent -> [Continent]
$cenumFromThenTo :: Continent -> Continent -> Continent -> [Continent]
enumFromTo :: Continent -> Continent -> [Continent]
$cenumFromTo :: Continent -> Continent -> [Continent]
enumFromThen :: Continent -> Continent -> [Continent]
$cenumFromThen :: Continent -> Continent -> [Continent]
enumFrom :: Continent -> [Continent]
$cenumFrom :: Continent -> [Continent]
fromEnum :: Continent -> Int
$cfromEnum :: Continent -> Int
toEnum :: Int -> Continent
$ctoEnum :: Int -> Continent
pred :: Continent -> Continent
$cpred :: Continent -> Continent
succ :: Continent -> Continent
$csucc :: Continent -> Continent
Enum)


{-# COMPLETE Africa, Asia, Antarctica, Europe, NorthAmerica, Oceania, SouthAmerica #-}
pattern Africa, Asia, Antarctica, Europe, NorthAmerica, Oceania, SouthAmerica :: Continent
pattern $bAfrica :: Continent
$mAfrica :: forall {r}. Continent -> ((# #) -> r) -> ((# #) -> r) -> r
Africa = Continent 0
pattern $bAsia :: Continent
$mAsia :: forall {r}. Continent -> ((# #) -> r) -> ((# #) -> r) -> r
Asia = Continent 1
pattern $bAntarctica :: Continent
$mAntarctica :: forall {r}. Continent -> ((# #) -> r) -> ((# #) -> r) -> r
Antarctica = Continent 2
pattern $bEurope :: Continent
$mEurope :: forall {r}. Continent -> ((# #) -> r) -> ((# #) -> r) -> r
Europe = Continent 3
pattern $bNorthAmerica :: Continent
$mNorthAmerica :: forall {r}. Continent -> ((# #) -> r) -> ((# #) -> r) -> r
NorthAmerica = Continent 4
pattern $bOceania :: Continent
$mOceania :: forall {r}. Continent -> ((# #) -> r) -> ((# #) -> r) -> r
Oceania = Continent 5
pattern $bSouthAmerica :: Continent
$mSouthAmerica :: forall {r}. Continent -> ((# #) -> r) -> ((# #) -> r) -> r
SouthAmerica = Continent 6


continentNameDb :: [(Word8,Text,(Char,Char))]
continentNameDb :: [(Word8, Text, (Char, Char))]
continentNameDb =
  [ (Word8
0, Text
"Africa", (Char
'A', Char
'F'))
  , (Word8
1, Text
"Asia", (Char
'A', Char
'N'))
  , (Word8
2, Text
"Antarctica", (Char
'A', Char
'S'))
  , (Word8
3, Text
"Europe", (Char
'E', Char
'U'))
  , (Word8
4, Text
"North america", (Char
'N', Char
'A'))
  , (Word8
5, Text
"Oceania", (Char
'O', Char
'C'))
  , (Word8
6, Text
"South america", (Char
'S', Char
'A'))
  ]

instance Bounded Continent where
  minBound :: Continent
minBound = Word8 -> Continent
Continent Word8
0
  maxBound :: Continent
maxBound = Word8 -> Continent
Continent Word8
6

instance Show Continent where
  show :: Continent -> String
show Continent
Africa = String
"Africa"
  show Continent
Asia = String
"Asia"
  show Continent
Antarctica = String
"Antarctica"
  show Continent
Europe = String
"Europe"
  show Continent
NorthAmerica = String
"NorthAmerica"
  show Continent
Oceania = String
"Oceania"
  show Continent
SouthAmerica = String
"SouthAmerica"