{-# LANGUAGE TemplateHaskell #-}
module Text.HTML.Form.I18n(strings, langs, i18n, i18n', i18n2, stringsJSON) where

import Data.FileEmbed (embedDir, makeRelativeToProject)
import Data.Text.Encoding (decodeUtf8Lenient)
import Data.Text (unpack, pack, strip, replace)
import Data.ByteString (ByteString)
import System.FilePath (dropExtension)

import qualified Data.Aeson.KeyMap as KM
import Data.Aeson.Key as K
import Data.Aeson (Value(String, Object))

import Data.List (isPrefixOf)
import Data.Maybe (fromMaybe)

files :: [(FilePath, ByteString)]
files :: [(String, ByteString)]
files = $(embedDir =<< makeRelativeToProject "i18n")
bs2str :: ByteString -> String
bs2str :: ByteString -> String
bs2str = Text -> String
unpack (Text -> String) -> (ByteString -> Text) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8Lenient

strings :: String -> [(String, String)]
strings :: String -> [(String, String)]
strings = [(String, String)]
-> Maybe [(String, String)] -> [(String, String)]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [(String, String)] -> [(String, String)])
-> (String -> Maybe [(String, String)])
-> String
-> [(String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        (String
 -> [(String, [(String, String)])] -> Maybe [(String, String)])
-> [(String, [(String, String)])]
-> String
-> Maybe [(String, String)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip String
-> [(String, [(String, String)])] -> Maybe [(String, String)]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [(String -> String
dropExtension String
k, String -> [(String, String)]
parseKVs (String -> [(String, String)]) -> String -> [(String, String)]
forall a b. (a -> b) -> a -> b
$ ByteString -> String
bs2str ByteString
v) | (String
k, ByteString
v) <- [(String, ByteString)]
files]
langs :: [String]
langs :: [String]
langs = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
dropExtension ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ ((String, ByteString) -> String)
-> [(String, ByteString)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, ByteString) -> String
forall a b. (a, b) -> a
fst [(String, ByteString)]
files

i18n :: String -> String -> String
i18n :: String -> String -> String
i18n String
lang String
key = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
key (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
key ([(String, String)] -> Maybe String)
-> [(String, String)] -> Maybe String
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)]
strings String
lang

i18n' :: Show a => String -> String -> a -> String
i18n' :: forall a. Show a => String -> String -> a -> String
i18n' String
lang String
key a
subs = String -> String -> String -> String
replace' String
"%0" (a -> String
forall a. Show a => a -> String
show a
subs) (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String -> String
i18n String
lang String
key
i18n2 :: (Show a, Show b) => String -> String -> a -> b -> String
i18n2 :: forall a b.
(Show a, Show b) =>
String -> String -> a -> b -> String
i18n2 String
lang String
key a
subs1 b
subs2 = String -> String -> String -> String
replace' String
"%1" (b -> String
forall a. Show a => a -> String
show b
subs2) (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String -> a -> String
forall a. Show a => String -> String -> a -> String
i18n' String
lang String
key a
subs1

stringsJSON :: String -> Value
stringsJSON :: String -> Value
stringsJSON = Object -> Value
Object (Object -> Value) -> (String -> Object) -> String -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Key, Value)] -> Object
forall v. [(Key, v)] -> KeyMap v
KM.fromList ([(Key, Value)] -> Object)
-> (String -> [(Key, Value)]) -> String -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, String) -> (Key, Value))
-> [(String, String)] -> [(Key, Value)]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> (Key, Value)
inner ([(String, String)] -> [(Key, Value)])
-> (String -> [(String, String)]) -> String -> [(Key, Value)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [(String, String)]
strings
  where inner :: (String, String) -> (Key, Value)
inner (String
k, String
v) = (String -> Key
K.fromString String
k, Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
v)

------
--- Support
------

parseKVs :: String -> [(String, String)]
parseKVs :: String -> [(String, String)]
parseKVs = (String -> (String, String)) -> [String] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map String -> (String, String)
inner ([String] -> [(String, String)])
-> (String -> [String]) -> String -> [(String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"#") ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
strip' ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
  where inner :: String -> (String, String)
inner String
line = let (String
k, String
v) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
':') String
line in (String -> String
strip' String
k, String -> String
strip' String
v)

-- | Removes any whitespace at the start or end of a string
strip' :: String -> String
strip' :: String -> String
strip' = Text -> String
unpack (Text -> String) -> (String -> Text) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
strip (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack

-- | Substitutes one string for another
replace' :: String -> String -> String -> String
replace' :: String -> String -> String -> String
replace' String
needle String
alt = Text -> String
unpack (Text -> String) -> (String -> Text) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
replace (String -> Text
pack String
needle) (String -> Text
pack String
alt) (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack