{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

module ROC.ID.Location
  ( Location (..)
  , parseLocation
  , printLocation
  , randomLocation
  ) where

import Control.Monad.Random.Class
    ( MonadRandom (..) )
import Data.Text
    ( Text )
import GHC.Generics
    ( Generic )
import ROC.ID.Language
    ( Language (..) )
import ROC.ID.Utilities

-- | A location, encodable within an ROC identification number.
--
-- To generate the name of a 'Location', use the 'printLocation' function.
--
-- To parse a 'Location', use the 'parseLocation' function.
--
-- To generate a random 'Location', use the 'randomLocation' function.
--
data Location
  = A -- ^ 臺北市 Taipei City
  | B -- ^ 臺中市 Taichung City
  | C -- ^ 基隆市 Keelung City
  | D -- ^ 臺南市 Tainan City
  | E -- ^ 高雄市 Kaohsiung City
  | F -- ^ 新北市 New Taipei City
  | G -- ^ 宜蘭縣 Yilan County
  | H -- ^ 桃園市 Taoyuan City
  | I -- ^ 嘉義市 Chiayi City
  | J -- ^ 新竹縣 Hsinchu County
  | K -- ^ 苗栗縣 Miaoli County
  | L -- ^ 臺中縣 Taichung County
  | M -- ^ 南投縣 Nantou County
  | N -- ^ 彰化縣 Changhua County
  | O -- ^ 新竹市 Hsinchu City
  | P -- ^ 雲林縣 Yunlin County
  | Q -- ^ 嘉義縣 Chiayi County
  | R -- ^ 臺南縣 Pingtung County
  | S -- ^ 高雄縣 Kaohsiung County
  | T -- ^ 屏東縣 Pingtung County
  | U -- ^ 花蓮縣 Hualien County
  | V -- ^ 臺東縣 Taitung County
  | W -- ^ 金門縣 Kinmen County
  | X -- ^ 澎湖縣 Penghu County
  | Y -- ^ 陽明山 Yangmingshan
  | Z -- ^ 連江縣 Lienchiang County
  deriving (Location
Location -> Location -> Bounded Location
forall a. a -> a -> Bounded a
$cminBound :: Location
minBound :: Location
$cmaxBound :: Location
maxBound :: Location
Bounded, Int -> Location
Location -> Int
Location -> [Location]
Location -> Location
Location -> Location -> [Location]
Location -> Location -> Location -> [Location]
(Location -> Location)
-> (Location -> Location)
-> (Int -> Location)
-> (Location -> Int)
-> (Location -> [Location])
-> (Location -> Location -> [Location])
-> (Location -> Location -> [Location])
-> (Location -> Location -> Location -> [Location])
-> Enum Location
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Location -> Location
succ :: Location -> Location
$cpred :: Location -> Location
pred :: Location -> Location
$ctoEnum :: Int -> Location
toEnum :: Int -> Location
$cfromEnum :: Location -> Int
fromEnum :: Location -> Int
$cenumFrom :: Location -> [Location]
enumFrom :: Location -> [Location]
$cenumFromThen :: Location -> Location -> [Location]
enumFromThen :: Location -> Location -> [Location]
$cenumFromTo :: Location -> Location -> [Location]
enumFromTo :: Location -> Location -> [Location]
$cenumFromThenTo :: Location -> Location -> Location -> [Location]
enumFromThenTo :: Location -> Location -> Location -> [Location]
Enum, Location -> Location -> Bool
(Location -> Location -> Bool)
-> (Location -> Location -> Bool) -> Eq Location
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Location -> Location -> Bool
== :: Location -> Location -> Bool
$c/= :: Location -> Location -> Bool
/= :: Location -> Location -> Bool
Eq, (forall x. Location -> Rep Location x)
-> (forall x. Rep Location x -> Location) -> Generic Location
forall x. Rep Location x -> Location
forall x. Location -> Rep Location x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Location -> Rep Location x
from :: forall x. Location -> Rep Location x
$cto :: forall x. Rep Location x -> Location
to :: forall x. Rep Location x -> Location
Generic, Eq Location
Eq Location =>
(Location -> Location -> Ordering)
-> (Location -> Location -> Bool)
-> (Location -> Location -> Bool)
-> (Location -> Location -> Bool)
-> (Location -> Location -> Bool)
-> (Location -> Location -> Location)
-> (Location -> Location -> Location)
-> Ord Location
Location -> Location -> Bool
Location -> Location -> Ordering
Location -> Location -> Location
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
$ccompare :: Location -> Location -> Ordering
compare :: Location -> Location -> Ordering
$c< :: Location -> Location -> Bool
< :: Location -> Location -> Bool
$c<= :: Location -> Location -> Bool
<= :: Location -> Location -> Bool
$c> :: Location -> Location -> Bool
> :: Location -> Location -> Bool
$c>= :: Location -> Location -> Bool
>= :: Location -> Location -> Bool
$cmax :: Location -> Location -> Location
max :: Location -> Location -> Location
$cmin :: Location -> Location -> Location
min :: Location -> Location -> Location
Ord, ReadPrec [Location]
ReadPrec Location
Int -> ReadS Location
ReadS [Location]
(Int -> ReadS Location)
-> ReadS [Location]
-> ReadPrec Location
-> ReadPrec [Location]
-> Read Location
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Location
readsPrec :: Int -> ReadS Location
$creadList :: ReadS [Location]
readList :: ReadS [Location]
$creadPrec :: ReadPrec Location
readPrec :: ReadPrec Location
$creadListPrec :: ReadPrec [Location]
readListPrec :: ReadPrec [Location]
Read, Int -> Location -> ShowS
[Location] -> ShowS
Location -> [Char]
(Int -> Location -> ShowS)
-> (Location -> [Char]) -> ([Location] -> ShowS) -> Show Location
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Location -> ShowS
showsPrec :: Int -> Location -> ShowS
$cshow :: Location -> [Char]
show :: Location -> [Char]
$cshowList :: [Location] -> ShowS
showList :: [Location] -> ShowS
Show)

-- | Parse the specified uppercase alphabetic character as a 'Location'.
--
-- Returns 'Nothing' if the specified character is not an uppercase alphabetic
-- character.
--
parseLocation :: Char -> Maybe Location
parseLocation :: Char -> Maybe Location
parseLocation Char
c = [Char] -> Maybe Location
forall a. Read a => [Char] -> Maybe a
maybeRead [Char
c]

-- | Pretty-print the specified 'Location'.
printLocation :: Language -> Location -> Text
printLocation :: Language -> Location -> Text
printLocation = \case
  Language
English -> Location -> Text
printLocationEnglish
  Language
Chinese -> Location -> Text
printLocationChinese

printLocationChinese :: Location -> Text
printLocationChinese :: Location -> Text
printLocationChinese = \case
  Location
A -> Text
"臺北市"
  Location
B -> Text
"臺中市"
  Location
C -> Text
"基隆市"
  Location
D -> Text
"臺南市"
  Location
E -> Text
"高雄市"
  Location
F -> Text
"新北市"
  Location
G -> Text
"宜蘭縣"
  Location
H -> Text
"桃園市"
  Location
I -> Text
"嘉義市"
  Location
J -> Text
"新竹縣"
  Location
K -> Text
"苗栗縣"
  Location
L -> Text
"臺中縣"
  Location
M -> Text
"南投縣"
  Location
N -> Text
"彰化縣"
  Location
O -> Text
"新竹市"
  Location
P -> Text
"雲林縣"
  Location
Q -> Text
"嘉義縣"
  Location
R -> Text
"臺南縣"
  Location
S -> Text
"高雄縣"
  Location
T -> Text
"屏東縣"
  Location
U -> Text
"花蓮縣"
  Location
V -> Text
"臺東縣"
  Location
W -> Text
"金門縣"
  Location
X -> Text
"澎湖縣"
  Location
Y -> Text
"陽明山"
  Location
Z -> Text
"連江縣"

printLocationEnglish :: Location -> Text
printLocationEnglish :: Location -> Text
printLocationEnglish = \case
  Location
A -> Text
"Taipei City"
  Location
B -> Text
"Taichung City"
  Location
C -> Text
"Keelung City"
  Location
D -> Text
"Tainan City"
  Location
E -> Text
"Kaohsiung City"
  Location
F -> Text
"New Taipei City"
  Location
G -> Text
"Yilan County"
  Location
H -> Text
"Taoyuan City"
  Location
I -> Text
"Chiayi City"
  Location
J -> Text
"Hsinchu County"
  Location
K -> Text
"Miaoli County"
  Location
L -> Text
"Taichung County"
  Location
M -> Text
"Nantou County"
  Location
N -> Text
"Changhua County"
  Location
O -> Text
"Hsinchu City"
  Location
P -> Text
"Yunlin County"
  Location
Q -> Text
"Chiayi County"
  Location
R -> Text
"Pingtung County"
  Location
S -> Text
"Kaohsiung County"
  Location
T -> Text
"Pingtung County"
  Location
U -> Text
"Hualien County"
  Location
V -> Text
"Taitung County"
  Location
W -> Text
"Kinmen County"
  Location
X -> Text
"Penghu County"
  Location
Y -> Text
"Yangmingshan"
  Location
Z -> Text
"Lienchiang County"

-- | Generate a random 'Location'.
--
randomLocation :: MonadRandom m => m Location
randomLocation :: forall (m :: * -> *). MonadRandom m => m Location
randomLocation = m Location
forall a (m :: * -> *). (MonadRandom m, Bounded a, Enum a) => m a
randomBoundedEnum