From 122e87dc812cf8b4840858229f863c88b0d25b98 Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Fri, 5 Jan 2024 16:20:27 +1300
Subject: [PATCH] Get internationalization infrastructure working!

---
 bureaucromancy.cabal       |  4 +--
 src/Text/HTML/Form/I18n.hs | 53 ++++++++++++++++++++++++++++++++++++++
 2 files changed, 55 insertions(+), 2 deletions(-)
 create mode 100644 src/Text/HTML/Form/I18n.hs

diff --git a/bureaucromancy.cabal b/bureaucromancy.cabal
index 16ca592..6757207 100644
--- a/bureaucromancy.cabal
+++ b/bureaucromancy.cabal
@@ -68,7 +68,7 @@ library
         Text.HTML.Form.Colours, Text.HTML.Form.Validate
 
     -- Modules included in this library but not exported.
-    -- other-modules:
+    other-modules:  Text.HTML.Form.I18n
 
     -- LANGUAGE extensions used by modules in this package.
     -- other-extensions:
@@ -78,7 +78,7 @@ library
             file-embed-lzma >=0.0.1 && <1, file-embed >=0.0.15 && < 0.1, mtl >2 && <3,
             bytestring >=0.11 && <1, text >=2 && <3, containers >=0.6 && <1,
             xml-conduit >= 1.9 && <2, network-uri >=2.6 && <3, regex-tdfa >=1.3 && <2,
-            filepath >=1.4 && <2, directory >=1.2 && <2,
+            filepath >=1.4 && <2, directory >=1.2 && <2, aeson,
             hourglass >= 0.2.12 && < 0.3, tz >= 0.1 && < 0.2
 
     -- Directories containing source files.
diff --git a/src/Text/HTML/Form/I18n.hs b/src/Text/HTML/Form/I18n.hs
new file mode 100644
index 0000000..e83df1d
--- /dev/null
+++ b/src/Text/HTML/Form/I18n.hs
@@ -0,0 +1,53 @@
+{-# 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
-- 
2.30.2