-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2022 Wire Swiss GmbH <opensource@wire.com>
--
-- This program is free software: you can redistribute it and/or modify it under
-- the terms of the GNU Affero General Public License as published by the Free
-- Software Foundation, either version 3 of the License, or (at your option) any
-- later version.
--
-- This program is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
-- details.
--
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see <https://www.gnu.org/licenses/>.

module Wire.API.Locale
  ( Locale (..),
    Language (..),
    Country (..),
    timeLocale,
    formatDateTime,
    deDe,
    frFr,
    locToText,
    parseLocale,
    lan2Text,
    parseLanguage,
    con2Text,
    parseCountry,
  )
where

import Cassandra as C
import Control.Applicative (optional)
import Control.Error.Util (hush, note)
import Data.Aeson (FromJSON, ToJSON)
import Data.Attoparsec.Text
import Data.ISO3166_CountryCodes (CountryCode)
import Data.LanguageCodes (ISO639_1 (DE, FR))
import Data.OpenApi qualified as S
import Data.Schema
import Data.Text qualified as Text
import Data.Time.Clock (UTCTime)
import Data.Time.Format
import Data.Time.LocalTime (TimeZone (..), utc)
import Imports
import Test.QuickCheck
import Wire.API.User.Orphans ()
import Wire.Arbitrary

timeLocale :: Locale -> TimeLocale
timeLocale :: Locale -> TimeLocale
timeLocale (Locale (Language ISO639_1
DE) Maybe Country
_) = TimeLocale
deDe
timeLocale (Locale (Language ISO639_1
FR) Maybe Country
_) = TimeLocale
frFr
timeLocale Locale
_ = TimeLocale
defaultTimeLocale

formatDateTime :: String -> TimeLocale -> UTCTime -> Text
formatDateTime :: String -> TimeLocale -> UTCTime -> Text
formatDateTime String
s TimeLocale
l = String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> (UTCTime -> String) -> UTCTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
l String
s

deDe :: TimeLocale
deDe :: TimeLocale
deDe =
  TimeLocale
    { wDays :: [(String, String)]
wDays =
        [ (String
"Sonntag", String
"Son"),
          (String
"Montag", String
"Mon"),
          (String
"Dienstag", String
"Die"),
          (String
"Mittwoch", String
"Mit"),
          (String
"Donnerstag", String
"Don"),
          (String
"Freitag", String
"Fre"),
          (String
"Samstag", String
"Sam")
        ],
      months :: [(String, String)]
months =
        [ (String
"Januar", String
"Jan"),
          (String
"Februar", String
"Feb"),
          (String
"März", String
"Mär"),
          (String
"April", String
"Apr"),
          (String
"Mai", String
"Mai"),
          (String
"Juni", String
"Jun"),
          (String
"Juli", String
"Jul"),
          (String
"August", String
"Aug"),
          (String
"September", String
"Sep"),
          (String
"Oktober", String
"Okt"),
          (String
"November", String
"Nov"),
          (String
"Dezember", String
"Dez")
        ],
      amPm :: (String, String)
amPm = (String
"", String
""),
      dateTimeFmt :: String
dateTimeFmt = String
"%d. %B %Y %H:%M:%S %Z",
      dateFmt :: String
dateFmt = String
"%d.%m.%Y",
      timeFmt :: String
timeFmt = String
"%H:%M:%S",
      time12Fmt :: String
time12Fmt = String
"%H:%M:%S",
      knownTimeZones :: [TimeZone]
knownTimeZones =
        [ TimeZone
utc,
          Int -> Bool -> String -> TimeZone
TimeZone Int
60 Bool
False String
"MEZ",
          Int -> Bool -> String -> TimeZone
TimeZone Int
120 Bool
True String
"MESZ"
        ]
    }

frFr :: TimeLocale
frFr :: TimeLocale
frFr =
  TimeLocale
    { wDays :: [(String, String)]
wDays =
        [ (String
"dimanche", String
"dim"),
          (String
"lundi", String
"lun"),
          (String
"mardi", String
"mar"),
          (String
"mercredi", String
"mer"),
          (String
"jeudi", String
"jeu"),
          (String
"vendredi", String
"ven"),
          (String
"samedi", String
"sam")
        ],
      months :: [(String, String)]
months =
        [ (String
"janvier", String
"jan"),
          (String
"février", String
"fév"),
          (String
"mars", String
"mar"),
          (String
"avril", String
"avr"),
          (String
"mai", String
"mai"),
          (String
"juin", String
"jun"),
          (String
"juillet", String
"jul"),
          (String
"août", String
"aoû"),
          (String
"septembre", String
"sep"),
          (String
"octobre", String
"oct"),
          (String
"novembre", String
"nov"),
          (String
"décembre", String
"déc")
        ],
      amPm :: (String, String)
amPm = (String
"", String
""),
      dateTimeFmt :: String
dateTimeFmt = String
"%d %B %Y %H h %M %Z",
      dateFmt :: String
dateFmt = String
"%d/%m/%Y",
      timeFmt :: String
timeFmt = String
"%H h %M",
      time12Fmt :: String
time12Fmt = String
"%H h %M",
      knownTimeZones :: [TimeZone]
knownTimeZones =
        [ TimeZone
utc,
          Int -> Bool -> String -> TimeZone
TimeZone Int
60 Bool
False String
"HNEC",
          Int -> Bool -> String -> TimeZone
TimeZone Int
120 Bool
True String
"HAEC"
        ]
    }

--------------------------------------------------------------------------------
-- Locale

data Locale = Locale
  { Locale -> Language
lLanguage :: Language,
    Locale -> Maybe Country
lCountry :: Maybe Country
  }
  deriving stock (Locale -> Locale -> Bool
(Locale -> Locale -> Bool)
-> (Locale -> Locale -> Bool) -> Eq Locale
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Locale -> Locale -> Bool
== :: Locale -> Locale -> Bool
$c/= :: Locale -> Locale -> Bool
/= :: Locale -> Locale -> Bool
Eq, Eq Locale
Eq Locale =>
(Locale -> Locale -> Ordering)
-> (Locale -> Locale -> Bool)
-> (Locale -> Locale -> Bool)
-> (Locale -> Locale -> Bool)
-> (Locale -> Locale -> Bool)
-> (Locale -> Locale -> Locale)
-> (Locale -> Locale -> Locale)
-> Ord Locale
Locale -> Locale -> Bool
Locale -> Locale -> Ordering
Locale -> Locale -> Locale
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 :: Locale -> Locale -> Ordering
compare :: Locale -> Locale -> Ordering
$c< :: Locale -> Locale -> Bool
< :: Locale -> Locale -> Bool
$c<= :: Locale -> Locale -> Bool
<= :: Locale -> Locale -> Bool
$c> :: Locale -> Locale -> Bool
> :: Locale -> Locale -> Bool
$c>= :: Locale -> Locale -> Bool
>= :: Locale -> Locale -> Bool
$cmax :: Locale -> Locale -> Locale
max :: Locale -> Locale -> Locale
$cmin :: Locale -> Locale -> Locale
min :: Locale -> Locale -> Locale
Ord, (forall x. Locale -> Rep Locale x)
-> (forall x. Rep Locale x -> Locale) -> Generic Locale
forall x. Rep Locale x -> Locale
forall x. Locale -> Rep Locale x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Locale -> Rep Locale x
from :: forall x. Locale -> Rep Locale x
$cto :: forall x. Rep Locale x -> Locale
to :: forall x. Rep Locale x -> Locale
Generic)
  deriving (Gen Locale
Gen Locale -> (Locale -> [Locale]) -> Arbitrary Locale
Locale -> [Locale]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen Locale
arbitrary :: Gen Locale
$cshrink :: Locale -> [Locale]
shrink :: Locale -> [Locale]
Arbitrary) via (GenericUniform Locale)
  deriving (Value -> Parser [Locale]
Value -> Parser Locale
(Value -> Parser Locale)
-> (Value -> Parser [Locale]) -> FromJSON Locale
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Locale
parseJSON :: Value -> Parser Locale
$cparseJSONList :: Value -> Parser [Locale]
parseJSONList :: Value -> Parser [Locale]
FromJSON, [Locale] -> Value
[Locale] -> Encoding
Locale -> Value
Locale -> Encoding
(Locale -> Value)
-> (Locale -> Encoding)
-> ([Locale] -> Value)
-> ([Locale] -> Encoding)
-> ToJSON Locale
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Locale -> Value
toJSON :: Locale -> Value
$ctoEncoding :: Locale -> Encoding
toEncoding :: Locale -> Encoding
$ctoJSONList :: [Locale] -> Value
toJSONList :: [Locale] -> Value
$ctoEncodingList :: [Locale] -> Encoding
toEncodingList :: [Locale] -> Encoding
ToJSON, Typeable Locale
Typeable Locale =>
(Proxy Locale -> Declare (Definitions Schema) NamedSchema)
-> ToSchema Locale
Proxy Locale -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy Locale -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy Locale -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema Locale

instance ToSchema Locale where
  schema :: ValueSchema NamedSwaggerDoc Locale
schema = Locale -> Text
locToText (Locale -> Text)
-> SchemaP NamedSwaggerDoc Value Value Text Locale
-> ValueSchema NamedSwaggerDoc Locale
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (Text -> Either String Locale)
-> SchemaP NamedSwaggerDoc Value Value Text Locale
forall a.
Text
-> (Text -> Either String a)
-> SchemaP NamedSwaggerDoc Value Value Text a
parsedText Text
"Locale" (String -> Maybe Locale -> Either String Locale
forall a b. a -> Maybe b -> Either a b
note String
err (Maybe Locale -> Either String Locale)
-> (Text -> Maybe Locale) -> Text -> Either String Locale
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Locale
parseLocale)
    where
      err :: String
err = String
"Invalid locale. Expected <ISO 639-1>(-<ISO 3166-1-alpha2>)? format"

instance Show Locale where
  show :: Locale -> String
show = Text -> String
Text.unpack (Text -> String) -> (Locale -> Text) -> Locale -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Locale -> Text
locToText

locToText :: Locale -> Text
locToText :: Locale -> Text
locToText (Locale Language
l Maybe Country
c) = Language -> Text
lan2Text Language
l Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Country -> Text) -> Maybe Country -> Text
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Text
"-" <>) (Text -> Text) -> (Country -> Text) -> Country -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Country -> Text
con2Text) Maybe Country
c

parseLocale :: Text -> Maybe Locale
parseLocale :: Text -> Maybe Locale
parseLocale = Either String Locale -> Maybe Locale
forall a b. Either a b -> Maybe b
hush (Either String Locale -> Maybe Locale)
-> (Text -> Either String Locale) -> Text -> Maybe Locale
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Locale -> Text -> Either String Locale
forall a. Parser a -> Text -> Either String a
parseOnly Parser Locale
localeParser
  where
    localeParser :: Parser Locale
    localeParser :: Parser Locale
localeParser =
      Language -> Maybe Country -> Locale
Locale
        (Language -> Maybe Country -> Locale)
-> Parser Text Language -> Parser Text (Maybe Country -> Locale)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Text Language
languageParser Parser Text Language -> String -> Parser Text Language
forall i a. Parser i a -> String -> Parser i a
<?> String
"Language code")
        Parser Text (Maybe Country -> Locale)
-> Parser Text (Maybe Country) -> Parser Locale
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser Text Country -> Parser Text (Maybe Country)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> Parser Char
char Char
'-' Parser Char -> Parser Text Country -> Parser Text Country
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Country
countryParser) Parser Text (Maybe Country)
-> String -> Parser Text (Maybe Country)
forall i a. Parser i a -> String -> Parser i a
<?> String
"Country code")

--------------------------------------------------------------------------------
-- Language

newtype Language = Language {Language -> ISO639_1
fromLanguage :: ISO639_1}
  deriving stock (Language -> Language -> Bool
(Language -> Language -> Bool)
-> (Language -> Language -> Bool) -> Eq Language
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Language -> Language -> Bool
== :: Language -> Language -> Bool
$c/= :: Language -> Language -> Bool
/= :: Language -> Language -> Bool
Eq, Eq Language
Eq Language =>
(Language -> Language -> Ordering)
-> (Language -> Language -> Bool)
-> (Language -> Language -> Bool)
-> (Language -> Language -> Bool)
-> (Language -> Language -> Bool)
-> (Language -> Language -> Language)
-> (Language -> Language -> Language)
-> Ord Language
Language -> Language -> Bool
Language -> Language -> Ordering
Language -> Language -> Language
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 :: Language -> Language -> Ordering
compare :: Language -> Language -> Ordering
$c< :: Language -> Language -> Bool
< :: Language -> Language -> Bool
$c<= :: Language -> Language -> Bool
<= :: Language -> Language -> Bool
$c> :: Language -> Language -> Bool
> :: Language -> Language -> Bool
$c>= :: Language -> Language -> Bool
>= :: Language -> Language -> Bool
$cmax :: Language -> Language -> Language
max :: Language -> Language -> Language
$cmin :: Language -> Language -> Language
min :: Language -> Language -> Language
Ord, Int -> Language -> ShowS
[Language] -> ShowS
Language -> String
(Int -> Language -> ShowS)
-> (Language -> String) -> ([Language] -> ShowS) -> Show Language
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Language -> ShowS
showsPrec :: Int -> Language -> ShowS
$cshow :: Language -> String
show :: Language -> String
$cshowList :: [Language] -> ShowS
showList :: [Language] -> ShowS
Show, (forall x. Language -> Rep Language x)
-> (forall x. Rep Language x -> Language) -> Generic Language
forall x. Rep Language x -> Language
forall x. Language -> Rep Language x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Language -> Rep Language x
from :: forall x. Language -> Rep Language x
$cto :: forall x. Rep Language x -> Language
to :: forall x. Rep Language x -> Language
Generic)
  deriving newtype (Gen Language
Gen Language -> (Language -> [Language]) -> Arbitrary Language
Language -> [Language]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen Language
arbitrary :: Gen Language
$cshrink :: Language -> [Language]
shrink :: Language -> [Language]
Arbitrary, Typeable Language
Typeable Language =>
(Proxy Language -> Declare (Definitions Schema) NamedSchema)
-> ToSchema Language
Proxy Language -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy Language -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy Language -> Declare (Definitions Schema) NamedSchema
S.ToSchema)

instance C.Cql Language where
  ctype :: Tagged Language ColumnType
ctype = ColumnType -> Tagged Language ColumnType
forall a b. b -> Tagged a b
C.Tagged ColumnType
C.AsciiColumn
  toCql :: Language -> Value
toCql = Text -> Value
forall a. Cql a => a -> Value
C.toCql (Text -> Value) -> (Language -> Text) -> Language -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Language -> Text
lan2Text

  fromCql :: Value -> Either String Language
fromCql (C.CqlAscii Text
l) = case Text -> Maybe Language
parseLanguage Text
l of
    Just Language
l' -> Language -> Either String Language
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Language
l'
    Maybe Language
Nothing -> String -> Either String Language
forall a b. a -> Either a b
Left String
"Language: ISO 639-1 expected."
  fromCql Value
_ = String -> Either String Language
forall a b. a -> Either a b
Left String
"Language: ASCII expected"

languageParser :: Parser Language
languageParser :: Parser Text Language
languageParser = String -> (String -> Maybe Language) -> Parser Text Language
forall a. String -> (String -> Maybe a) -> Parser a
codeParser String
"language" ((String -> Maybe Language) -> Parser Text Language)
-> (String -> Maybe Language) -> Parser Text Language
forall a b. (a -> b) -> a -> b
$ (ISO639_1 -> Language) -> Maybe ISO639_1 -> Maybe Language
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ISO639_1 -> Language
Language (Maybe ISO639_1 -> Maybe Language)
-> (String -> Maybe ISO639_1) -> String -> Maybe Language
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> Maybe ISO639_1
forall a. Read a => (Char -> Bool) -> String -> Maybe a
checkAndConvert Char -> Bool
isLower

lan2Text :: Language -> Text
lan2Text :: Language -> Text
lan2Text = Text -> Text
Text.toLower (Text -> Text) -> (Language -> Text) -> Language -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Text) -> (Language -> String) -> Language -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ISO639_1 -> String
forall a. Show a => a -> String
show (ISO639_1 -> String)
-> (Language -> ISO639_1) -> Language -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Language -> ISO639_1
fromLanguage

parseLanguage :: Text -> Maybe Language
parseLanguage :: Text -> Maybe Language
parseLanguage = Either String Language -> Maybe Language
forall a b. Either a b -> Maybe b
hush (Either String Language -> Maybe Language)
-> (Text -> Either String Language) -> Text -> Maybe Language
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Text Language -> Text -> Either String Language
forall a. Parser a -> Text -> Either String a
parseOnly Parser Text Language
languageParser

--------------------------------------------------------------------------------
-- Country

newtype Country = Country {Country -> CountryCode
fromCountry :: CountryCode}
  deriving stock (Country -> Country -> Bool
(Country -> Country -> Bool)
-> (Country -> Country -> Bool) -> Eq Country
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Country -> Country -> Bool
== :: Country -> Country -> Bool
$c/= :: Country -> Country -> Bool
/= :: Country -> Country -> Bool
Eq, Eq Country
Eq Country =>
(Country -> Country -> Ordering)
-> (Country -> Country -> Bool)
-> (Country -> Country -> Bool)
-> (Country -> Country -> Bool)
-> (Country -> Country -> Bool)
-> (Country -> Country -> Country)
-> (Country -> Country -> Country)
-> Ord Country
Country -> Country -> Bool
Country -> Country -> Ordering
Country -> Country -> Country
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 :: Country -> Country -> Ordering
compare :: Country -> Country -> Ordering
$c< :: Country -> Country -> Bool
< :: Country -> Country -> Bool
$c<= :: Country -> Country -> Bool
<= :: Country -> Country -> Bool
$c> :: Country -> Country -> Bool
> :: Country -> Country -> Bool
$c>= :: Country -> Country -> Bool
>= :: Country -> Country -> Bool
$cmax :: Country -> Country -> Country
max :: Country -> Country -> Country
$cmin :: Country -> Country -> Country
min :: Country -> Country -> Country
Ord, Int -> Country -> ShowS
[Country] -> ShowS
Country -> String
(Int -> Country -> ShowS)
-> (Country -> String) -> ([Country] -> ShowS) -> Show Country
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Country -> ShowS
showsPrec :: Int -> Country -> ShowS
$cshow :: Country -> String
show :: Country -> String
$cshowList :: [Country] -> ShowS
showList :: [Country] -> ShowS
Show, (forall x. Country -> Rep Country x)
-> (forall x. Rep Country x -> Country) -> Generic Country
forall x. Rep Country x -> Country
forall x. Country -> Rep Country x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Country -> Rep Country x
from :: forall x. Country -> Rep Country x
$cto :: forall x. Rep Country x -> Country
to :: forall x. Rep Country x -> Country
Generic)
  deriving newtype (Gen Country
Gen Country -> (Country -> [Country]) -> Arbitrary Country
Country -> [Country]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen Country
arbitrary :: Gen Country
$cshrink :: Country -> [Country]
shrink :: Country -> [Country]
Arbitrary, Typeable Country
Typeable Country =>
(Proxy Country -> Declare (Definitions Schema) NamedSchema)
-> ToSchema Country
Proxy Country -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy Country -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy Country -> Declare (Definitions Schema) NamedSchema
S.ToSchema)

instance C.Cql Country where
  ctype :: Tagged Country ColumnType
ctype = ColumnType -> Tagged Country ColumnType
forall a b. b -> Tagged a b
C.Tagged ColumnType
C.AsciiColumn
  toCql :: Country -> Value
toCql = Text -> Value
forall a. Cql a => a -> Value
C.toCql (Text -> Value) -> (Country -> Text) -> Country -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Country -> Text
con2Text

  fromCql :: Value -> Either String Country
fromCql (C.CqlAscii Text
c) = case Text -> Maybe Country
parseCountry Text
c of
    Just Country
c' -> Country -> Either String Country
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Country
c'
    Maybe Country
Nothing -> String -> Either String Country
forall a b. a -> Either a b
Left String
"Country: ISO 3166-1-alpha2 expected."
  fromCql Value
_ = String -> Either String Country
forall a b. a -> Either a b
Left String
"Country: ASCII expected"

countryParser :: Parser Country
countryParser :: Parser Text Country
countryParser = String -> (String -> Maybe Country) -> Parser Text Country
forall a. String -> (String -> Maybe a) -> Parser a
codeParser String
"country" ((String -> Maybe Country) -> Parser Text Country)
-> (String -> Maybe Country) -> Parser Text Country
forall a b. (a -> b) -> a -> b
$ (CountryCode -> Country) -> Maybe CountryCode -> Maybe Country
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CountryCode -> Country
Country (Maybe CountryCode -> Maybe Country)
-> (String -> Maybe CountryCode) -> String -> Maybe Country
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> Maybe CountryCode
forall a. Read a => (Char -> Bool) -> String -> Maybe a
checkAndConvert Char -> Bool
isUpper

con2Text :: Country -> Text
con2Text :: Country -> Text
con2Text = String -> Text
Text.pack (String -> Text) -> (Country -> String) -> Country -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CountryCode -> String
forall a. Show a => a -> String
show (CountryCode -> String)
-> (Country -> CountryCode) -> Country -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Country -> CountryCode
fromCountry

parseCountry :: Text -> Maybe Country
parseCountry :: Text -> Maybe Country
parseCountry = Either String Country -> Maybe Country
forall a b. Either a b -> Maybe b
hush (Either String Country -> Maybe Country)
-> (Text -> Either String Country) -> Text -> Maybe Country
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Text Country -> Text -> Either String Country
forall a. Parser a -> Text -> Either String a
parseOnly Parser Text Country
countryParser

--------------------------------------------------------------------------------
-- helpers

-- Common language / country functions
checkAndConvert :: (Read a) => (Char -> Bool) -> String -> Maybe a
checkAndConvert :: forall a. Read a => (Char -> Bool) -> String -> Maybe a
checkAndConvert Char -> Bool
f String
t =
  if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
f String
t
    then String -> Maybe a
forall a. Read a => String -> Maybe a
readMaybe ((Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper String
t)
    else String -> Maybe a
forall a. String -> Maybe a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Format not supported."

codeParser :: String -> (String -> Maybe a) -> Parser a
codeParser :: forall a. String -> (String -> Maybe a) -> Parser a
codeParser String
err String -> Maybe a
conv = do
  String
code <- Int -> Parser Char -> Parser Text String
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
2 Parser Char
anyChar
  Parser a -> (a -> Parser a) -> Maybe a -> Parser a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser a
forall a. String -> Parser Text a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err) a -> Parser a
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Maybe a
conv String
code)