From 3704ec294d638ec8bff7ac4cb1480a35930f4e23 Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Mon, 8 Jan 2024 13:18:03 +1300
Subject: [PATCH] Refine internationalization infrastructure & gather strings.

---
 bureaucromancy.cabal       |  2 +-
 i18n/en                    |  0
 i18n/en.txt                | 63 ++++++++++++++++++++++++++++++++++++++
 src/Text/HTML/Form/I18n.hs | 37 +++++++++++-----------
 4 files changed, 82 insertions(+), 20 deletions(-)
 delete mode 100644 i18n/en
 create mode 100644 i18n/en.txt

diff --git a/bureaucromancy.cabal b/bureaucromancy.cabal
index 6757207..b01b99a 100644
--- a/bureaucromancy.cabal
+++ b/bureaucromancy.cabal
@@ -52,7 +52,7 @@ build-type:         Simple
 extra-doc-files:    CHANGELOG.md
 
 -- Extra source files to be distributed with the package, such as examples, or a tutorial module.
--- extra-source-files:
+extra-source-files: tpl/**/*.html, i18n/*.txt
 
 common warnings
     ghc-options: -Wall
diff --git a/i18n/en b/i18n/en
deleted file mode 100644
index e69de29..0000000
diff --git a/i18n/en.txt b/i18n/en.txt
new file mode 100644
index 0000000..0f9fc30
--- /dev/null
+++ b/i18n/en.txt
@@ -0,0 +1,63 @@
+# Colour Pallet
+Slate: Slate
+Gray: Gray
+Zinc: Zinc
+Neutral: Neutral
+Stone: Stone
+Red: Red
+Orange: Orange
+Amber: Amber
+Yellow: Yellow
+Lime: Lime
+Green: Green
+Emerald: Emerald
+Teal: Teal
+Cyan: Cyan
+Sky: Sky
+Blue: Blue
+Indigo: Indigo
+Violet: Violet
+Fuchsia: Fuchsia
+Pink: Pink
+Rose: Rose
+
+# Error messages
+err required: Required!
+err format: Invalid format!
+err min chars: Must be at least %0 characters!
+err max chars: Must be at most %0 characters!
+err min: Must be at least %0!
+err max: Must be at most %0!
+err increments: Must be in increments of %0 from %1!
+err colour: Invalid colour value!
+err email: Obviously invalid email address, needs an '@'!
+err number: Invalid number!
+err URL: Invalid web address!
+err time: Invalid time format!
+errored: Please correct errors listed in sidebar before submitting this form!
+
+# Months
+January: January
+February: February
+March: March
+April: April
+May: May
+June: June
+July: July
+August: August
+September: September
+October: October
+November: November
+December: December
+
+# Keyboard
+SPACE: SPACE
+DEL: DEL
+CLEAR: CLEAR
+
+# Other
+Start!: Start!
+Now: Now
+Upload: Upload
+to: to
+Restore defaults: Restore defaults
diff --git a/src/Text/HTML/Form/I18n.hs b/src/Text/HTML/Form/I18n.hs
index e83df1d..387b0b8 100644
--- a/src/Text/HTML/Form/I18n.hs
+++ b/src/Text/HTML/Form/I18n.hs
@@ -1,10 +1,11 @@
 {-# LANGUAGE TemplateHaskell #-}
-module Text.HTML.Form.I18n(strings, i18n, stringsJSON) where
+module Text.HTML.Form.I18n(strings, i18n, i18n', i18n2, stringsJSON) where
 
 import Data.FileEmbed (embedDir, makeRelativeToProject)
 import Data.Text.Encoding (decodeUtf8Lenient)
-import Data.Text (unpack, pack)
+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
@@ -19,11 +20,17 @@ bs2str :: ByteString -> String
 bs2str = unpack . decodeUtf8Lenient
 
 strings :: String -> [(String, String)]
-strings = fromMaybe [] . flip lookup [(k, parseKVs $ bs2str v) | (k, v) <- files]
+strings = fromMaybe [] .
+        lookup [(dropExtension k, parseKVs $ bs2str v) | (k, v) <- 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)
@@ -33,21 +40,13 @@ stringsJSON = Object . KM.fromList . map inner . strings
 ------
 
 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)
+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 = 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
+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
-- 
2.30.2