module Data.Locale where
import Data.Eq (Eq(..))
import Data.Function (($), (.))
import Data.Functor ((<$>))
import Data.Map.Strict (Map)
import Data.Maybe (Maybe(..), isJust)
import Data.Ord (Ord(..), Ordering(..))
import Data.Semigroup (Semigroup(..))
import Data.String (String)
import Data.Text (Text)
import Data.Tuple (swap)
import Data.Type.Equality ((:~:)(..))
import Prelude (Enum(..), error, max)
import Text.Show (Show(..))
import qualified Data.Char as Char
import qualified Data.Map.Strict as Map
import qualified Data.Text as Text
data Zero
data Succ p
type family Index xs x where
Index (x ': xs) x = Zero
Index (not_x ': xs) x = Succ (Index xs x)
data Locale (ls::[*]) (l:: *) where
LocaleZ :: FullLocale l -> Locale (l ': ls) l
LocaleS :: Locale ls l -> Locale (not_l ': ls) l
infixr 5 `LocaleS`
instance ( Show (FullLocale l)
, Show (Locale ls l)
) => Show (Locale (l ': ls) l) where
show (LocaleZ fl) = showFullLocale fl
show (LocaleS l) = show l
showFullLocale :: Show (FullLocale l) => FullLocale l -> String
showFullLocale fl =
case show fl of
s0:s1:s@('_':_) -> Char.toLower s0:Char.toLower s1:s
s -> s
eqLocale ::
Eq (FullLocale x) =>
Eq (FullLocale y) =>
Locale ls x ->
Locale ls y ->
Maybe (x:~:y)
eqLocale (LocaleZ x) (LocaleZ y) =
if x == y then Just Refl else Nothing
eqLocale (LocaleS x) (LocaleS y) = eqLocale x y
eqLocale _x _y = Nothing
compareLocale ::
Ord (FullLocale x) =>
Ord (FullLocale y) =>
Locale ls x ->
Locale ls y ->
Ordering
compareLocale (LocaleZ x) (LocaleZ y) = compare x y
compareLocale (LocaleS x) (LocaleS y) = compareLocale x y
compareLocale LocaleZ{} LocaleS{} = LT
compareLocale LocaleS{} LocaleZ{} = GT
data family FullLocale (l:: *) :: *
data LocaleIn ls =
forall l.
( Eq (FullLocale l)
, Ord (FullLocale l)
) => LocaleIn (Locale ls l)
instance Eq (LocaleIn ls) where
LocaleIn x == LocaleIn y = isJust (eqLocale x y)
instance Ord (LocaleIn ls) where
compare (LocaleIn x) (LocaleIn y) = compareLocale x y
instance Locales ls => Show (LocaleIn ls) where
show = Text.unpack . (textLocales @ls Map.!)
type LocaleInj ls l
= LocaleInjP (Index ls l) ls l
localeInj :: forall l ls. LocaleInj ls l => FullLocale l -> Locale ls l
localeInj = localeInjP @(Index ls l)
class LocaleInjP p ls l where
localeInjP :: FullLocale l -> Locale ls l
instance LocaleInjP Zero (l ': ls) l where
localeInjP = LocaleZ
instance LocaleInjP p ls l =>
LocaleInjP (Succ p) (not_t ': ls) l where
localeInjP = LocaleS . localeInjP @p
class Localize ls msg a where
localize :: LocaleIn ls -> a -> msg
instance LocalizeIn l msg a => Localize '[l] msg a where
localize (LocaleIn li) =
case li of
LocaleZ l -> localizeIn @l l
LocaleS{} -> error "localize: impossible locale"
instance ( LocalizeIn l msg a
, Localize (l1 ': ls) msg a
) => Localize (l ': l1 ': ls) msg a where
localize (LocaleIn (LocaleZ l)) = localizeIn @l l
localize (LocaleIn (LocaleS l)) = localize (LocaleIn l)
class LocalizeIn l msg a where
localizeIn :: FullLocale l -> a -> msg
class Locales ls where
locales :: Map Text (LocaleIn ls)
textLocales :: Locales ls => Map (LocaleIn ls) Text
textLocales = Map.fromListWith max $ swap <$> Map.toList locales
countryCode :: forall ls. Locales ls => LocaleIn ls -> Text
countryCode = Text.takeWhile Char.isAlphaNum . (textLocales @ls Map.!)
instance Locales '[] where
locales = Map.empty
instance (LocalesFor l, Locales ls, Ord (FullLocale l)) => Locales (l ': ls) where
locales =
Map.unionWithKey
(\k _n _o -> error $ "locales: duplicate locale: "<>Text.unpack k)
(LocaleIn . localeInj <$> localesFor @l)
((\(LocaleIn l) -> LocaleIn $ LocaleS l) <$> locales @ls)
class LocalesFor l where
localesFor :: Map Text (FullLocale l)
fullLocales :: Show (FullLocale l) => [FullLocale l] -> [(Text, FullLocale l)]
fullLocales = ((\fl -> (Text.pack (showFullLocale fl), fl)) <$>)
data FR
data instance FullLocale FR
= FR_BE
| FR_CA
| FR_CH
| FR_FR
| FR_LU
deriving (Enum,Eq,Ord,Show)
instance LocalesFor FR where
localesFor = Map.fromList $
("fr", FR_FR) :
fullLocales [toEnum 0 ..]
fr_FR :: LocaleInj ls FR => Locale ls FR
fr_FR = localeInj FR_FR
data EN
data instance FullLocale EN
= EN_AG
| EN_AU
| EN_BW
| EN_CA
| EN_DK
| EN_GB
| EN_HK
| EN_IE
| EN_IL
| EN_IN
| EN_NG
| EN_NZ
| EN_PH
| EN_SG
| EN_US
| EN_ZA
| EN_ZM
| EN_ZW
deriving (Enum,Eq,Ord,Show)
instance LocalesFor EN where
localesFor = Map.fromList $
("en", EN_US) :
fullLocales [toEnum 0 ..]
en_US :: LocaleInj ls EN => Locale ls EN
en_US = localeInj EN_US