{-# 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 = $(embedDir =<< makeRelativeToProject "i18n")
bs2str :: ByteString -> String
bs2str = unpack . decodeUtf8Lenient

strings :: String -> [(String, String)]
strings = fromMaybe [] .
        flip lookup [(dropExtension k, parseKVs $ bs2str v) | (k, v) <- files]
langs :: [String]
langs = map dropExtension $ map fst files

i18n :: String -> String -> String
i18n lang key = fromMaybe key $ lookup key $ strings lang

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

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 (k, v) = break (==':') line in (strip' k, strip' v)

-- | Removes any whitespace at the start or end of a string
strip' :: String -> String
strip' = unpack . strip . pack

-- | Substitutes one string for another
replace' :: String -> String -> String -> String
replace' needle alt = unpack . replace (pack needle) (pack alt) . pack