{-# LANGUAGE TemplateHaskell #-} module Text.HTML.Form.I18n(strings, i18n, stringsJSON) where import Data.FileEmbed (embedDir, makeRelativeToProject) import Data.Text.Encoding (decodeUtf8Lenient) import Data.Text (unpack, pack) import Data.ByteString (ByteString) 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 = $(embedDir =<< makeRelativeToProject "i18n") bs2str :: ByteString -> String bs2str = unpack . decodeUtf8Lenient strings :: String -> [(String, String)] strings = fromMaybe [] . flip lookup [(k, parseKVs $ bs2str v) | (k, v) <- files] i18n :: String -> String -> String i18n lang key = fromMaybe key $ lookup key $ strings lang stringsJSON :: String -> Value stringsJSON = Object . KM.fromList . map inner . strings where inner (k, v) = (K.fromString k, String $ pack v) ------ --- Support ------ parseKVs :: String -> [(String, String)] parseKVs = map inner . filter (isPrefixOf "#") . filter null . map strip . lines where inner line = let (key, val) = break (==':') line in (strip key, strip val) -- | Removes any whitespace at the start or end of a string strip :: String -> String strip = lstrip . rstrip -- | Same as 'strip', but applies only to the left side of the string. lstrip :: String -> String lstrip s = case s of [] -> [] (x:xs) -> if elem x " \t\r\n" then lstrip xs else s -- | Same as 'strip', but applies only to the right side of the string. rstrip :: String -> String rstrip = reverse . lstrip . reverse