~alcinnz/bureaucromancy

3704ec294d638ec8bff7ac4cb1480a35930f4e23 — Adrian Cochrane 11 months ago 122e87d
Refine internationalization infrastructure & gather strings.
4 files changed, 82 insertions(+), 20 deletions(-)

M bureaucromancy.cabal
D i18n/en
A i18n/en.txt
M src/Text/HTML/Form/I18n.hs
M bureaucromancy.cabal => bureaucromancy.cabal +1 -1
@@ 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

D i18n/en => i18n/en +0 -0
A i18n/en.txt => i18n/en.txt +63 -0
@@ 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

M src/Text/HTML/Form/I18n.hs => src/Text/HTML/Form/I18n.hs +18 -19
@@ 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