From dd62695e6ba89e67cfdf570d98eb63036684ad19 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Sun, 15 Mar 2020 16:00:59 +0100 Subject: [PATCH] chore: automate translation workflow --- missing-translations.sh | 30 +++- translate.hs | 301 ++++++++++++++++++++++++++++++++++++++++ 2 files changed, 328 insertions(+), 3 deletions(-) create mode 100755 translate.hs diff --git a/missing-translations.sh b/missing-translations.sh index 86fff3026..afaed1073 100755 --- a/missing-translations.sh +++ b/missing-translations.sh @@ -6,6 +6,17 @@ typeset -a requiredLangs requiredLangs=(de en) +fix=1 +while getopts ':f' arg; do + case $arg in + f) fix=0 ;; + \*) print nothing: $OPTARG; exit 2;; + \?) print invalid option: $OPTARG; exit 2;; + esac +done +shift $OPTIND-1 + + function translations() { msgFile=$1 @@ -67,8 +78,17 @@ for msgDirectory (${msgDirectories}); do done # printf ">>> %s\n" ${msgDirectory} - diff -u0 --suppress-common-lines -wB ${diffArgs} | grep -vE '^@@.*@@' - diffStatus=$pipestatus[0] + if [[ $fix != 0 ]]; then + diff -u0 --suppress-common-lines -wB ${diffArgs} | grep -vE '^@@.*@@' + diffStatus=$pipestatus[0] + else + diff -u0 --suppress-common-lines -wB ${diffArgs} >/dev/null + diffStatus=$? + + if [[ ${diffStatus} == 1 ]]; then + ./translate.hs msgs ${dirMsgFiles} && diffStatus=0 + fi + fi return ${diffStatus} ) || msgDifference=1 @@ -103,7 +123,11 @@ for templateDirectory (templates/i18n/**/*(FN)); do if [[ $foundLang -ne 1 ]]; then templateDifference=1 - printf "%s: %s (%s)\n" $templateDirectory $lang $ext + [[ $fix != 0 ]] && printf "%s: %s (%s)\n" $templateDirectory $lang $ext + + if [[ $fix == 0 ]]; then + ./translate.hs dir $templateDirectory && templateDifference=0 + fi fi done done diff --git a/translate.hs b/translate.hs new file mode 100755 index 000000000..36270305b --- /dev/null +++ b/translate.hs @@ -0,0 +1,301 @@ +#!/usr/bin/env stack +-- stack runghc --package unordered-containers --package text --package editor-open --package cmdargs --package pointedlist --package filepath --package temporary --package directory --package process --package exceptions + +{-# OPTIONS_GHC -fno-warn-missing-fields #-} + +{-# LANGUAGE OverloadedStrings + , ViewPatterns + , NamedFieldPuns + , RecordWildCards + , TemplateHaskell + , DeriveGeneric, DeriveDataTypeable + , MagicHash + , MultiWayIf + #-} + +import Data.Text (Text) +import qualified Data.Text.IO as Text +import qualified Data.Text as Text +import qualified Data.Text.Encoding as Text + +import Data.HashSet (HashSet) +import qualified Data.HashSet as HashSet + +import Data.HashMap.Strict (HashMap) +import qualified Data.HashMap.Strict as HashMap + +import Text.Editor (mkTemplate, runUserEditorDWIM, userEditorDefault, _default_editor) + +import Numeric.Natural + +import System.Environment (getArgs) + +import Control.Monad +import Control.Arrow +import Data.Maybe +import Data.List +import Data.List.PointedList (PointedList) +import qualified Data.List.PointedList as P + +import System.Console.CmdArgs.Implicit +import System.Console.CmdArgs.Quote + +import Data.Foldable + +import Data.Data (Data) +import GHC.Generics (Generic) +import Data.Typeable (Typeable) + +import System.FilePath hiding (combine) +import System.Directory +import System.Process + +import System.IO (hPutStrLn, stderr) +import System.Exit +import System.IO.Temp (writeSystemTempFile) + +import Data.Ord (Down(..)) + +import Control.Monad.Catch + + +data Translate + = TranslateMsgs + { msgFiles :: [FilePath] + } + | TranslateI18nDirectory + { i18nDir :: FilePath + , i18nOnlyLang :: Bool + , i18nRequiredLangs :: [String] + , i18nSourceLangs :: [String] + } + deriving (Eq, Ord, Read, Show, Generic, Typeable, Data) + +$(cmdArgsQuote [d| + messages = TranslateMsgs + { msgFiles = [] &=# args + &=# typFile + } + i18n = TranslateI18nDirectory + { i18nDir = def &=# argPos 0 + &=# typDir + , i18nOnlyLang = True + &=# name "only-lang" + &=# help "Should only the language compononent (en, de, ...) be considered?" + , i18nRequiredLangs = [] + &=# name "required" + &=# help "Which languages are required to exist?" + &=# typ "LANG" + , i18nSourceLangs = [] + &=# name "source" + &=# help "Preference order for source of translation" + &=# typ "LANG" + } + + run = cmdArgs# (modes# [ messages &=# auto &=# name "msgs" + , i18n &=# name "dir" + ]) :: IO Translate + |]) + + +type LineNumber = Natural +type MsgName = Text +type ArgName = Text +type ArgType = Text + +data MsgDefinition = MsgDefinition + { msgName :: MsgName + , msgArgs :: [(ArgName, Maybe ArgType)] + , msgTrans :: Text + } + +data MsgFile = MsgFile + { msgFile :: FilePath + , msgDefinitions :: [MsgDefinition] + , msgNames :: HashSet MsgName + } + + +main :: IO () +main = main' =<< run + where + main' TranslateMsgs{..} = do + let + filePairs :: [(FilePath, FilePath)] + filePairs = concat $ zipWith (fmap . (,)) msgFiles (tail $ tails msgFiles) + mapM_ (\(f1, f2) -> join $ combine <$> readMsgFile f1 <*> readMsgFile f2) filePairs + main' m@TranslateI18nDirectory{..} + | null i18nRequiredLangs = main' m{ i18nRequiredLangs = ["de-de-formal", "en-eu"] } + | null i18nSourceLangs = main' m{ i18nSourceLangs = ["de-de-formal"] } + | otherwise = do + missing <- getMissingFiles m + forM_ missing $ \missing' -> do + translateSource <- getTranslateSource m + case translateSource of + Just src -> translateFrom src missing' + Nothing -> do + hPutStrLn stderr "Could not determine translation source." + exitWith $ ExitFailure 1 + + +readMsgFile :: FilePath -> IO MsgFile +readMsgFile f = readMsgText f <$> Text.readFile f + +readMsgText :: FilePath -> Text -> MsgFile +readMsgText f (Text.lines -> ls) = + let defs = mapMaybe readMsgLine ls + names = HashSet.fromList $ map msgName defs + in MsgFile + { msgFile = f + , msgDefinitions = defs + , msgNames = names + } + +readMsgLine :: Text -> Maybe MsgDefinition +readMsgLine l = do + guard . not $ "#" `Text.isPrefixOf` l + let + (msgPrefix, trans) = Text.breakOn ":" l + parts = filter (not . Text.null) $ Text.splitOn " " msgPrefix + parseArg arg = (argName, Text.stripPrefix "@" argType) + where + (argName, argType) = Text.breakOn "@" arg + if | msgName : args <- parts + -> do + t <- Text.stripPrefix ":" trans + return MsgDefinition + { msgName + , msgArgs = map parseArg args + , msgTrans = Text.strip t + } + | otherwise + -> Nothing + + +computeMissing :: MsgFile -> MsgFile -> [MsgDefinition] +computeMissing f1 f2 = filter f $ msgDefinitions f1 + where f MsgDefinition{..} = not $ msgName `HashSet.member` msgNames f2 + +renderMsg :: MsgDefinition -> Text +renderMsg MsgDefinition{..} = (<> (": " <> msgTrans)) . Text.unwords $ + [ msgName ] ++ + [ argName <> maybe Text.empty ("@" <>) mArgType + | (argName, mArgType) <- msgArgs + ] + +insertIntoFile :: MsgFile -> MsgFile -> MsgFile -> IO () +insertIntoFile target reference source = do + + forM_ (msgDefinitions source) $ \msgDef -> do + targetLines <- P.fromListEnd . Text.lines <$> Text.readFile (msgFile target) + referenceLines <- P.fromListEnd . Text.lines <$> Text.readFile (msgFile reference) + + case toList <$> targetLines of + Just lines -> do + let template = takeFileName (msgFile target) <.> Text.unpack (msgName msgDef) <.> "..bak" + void . writeSystemTempFile template . Text.unpack $ Text.unlines lines + Nothing -> return () + + let -- fName = "/tmp" takeFileName (msgFile target) <.> Text.unpack (msgName msgDef) + fName = msgFile target + Text.writeFile fName . Text.unlines $ if + | Just targetLines' <- targetLines + , Just referenceLines' <- referenceLines + -> toList $ insertInto targetLines' referenceLines' msgDef + | otherwise + -> renderMsg msgDef : maybe [] toList targetLines + where + insertInto ts rs msgDef + = let rs' = focusDef rs + where focusDef rs + | Just f <- readMsgLine $ P._focus rs + , msgName f == msgName msgDef + = rs + | otherwise + = maybe rs focusDef $ P.previous rs + ts' = alignFocus 0 ts rs' + where alignFocus off cts crs + | Just rp <- P.previous crs + , Just rdef <- readMsgLine $ P._focus rp + , Just tdef <- readMsgLine $ P._focus cts + = if | msgName tdef /= msgName rdef + , Just nts <- P.previous cts + -> alignFocus off nts crs + | msgName tdef /= msgName rdef + , Just nrs <- P.previous crs + -> alignFocus 0 ts nrs + | otherwise + -> insertOffset off cts crs + | Just nrs <- P.previous crs + , Just _ <- readMsgLine $ P._focus cts + = alignFocus (succ off) cts nrs + | Just nts <- P.previous cts + = alignFocus off nts crs + | otherwise + = P.insertRight (renderMsg msgDef) ts + insertOffset 0 cts _ = P.insertRight (renderMsg msgDef) cts + insertOffset n cts crs + | Just nrs <- P.next crs + = insertOffset (pred n) (P.insertRight (P._focus crs) cts) nrs + | otherwise + = P.insertRight (renderMsg msgDef) cts + in ts' + +combine :: MsgFile -> MsgFile -> IO () +combine f1 f2 = insertMissing f1 f2 >> insertMissing f2 f1 + where + insertMissing :: MsgFile -> MsgFile -> IO () + insertMissing f1' f2' = do + let missing = computeMissing f1' f2' + header = Text.unlines + [ "# Translate from: " <> Text.pack (msgFile f1') + , "# Target: " <> Text.pack (msgFile f2') + ] + queryBS = Text.encodeUtf8 . (Text.unlines . (header :) . pure) . Text.unlines $ map renderMsg missing + unless (null missing) $ do + responseBS <- runUserEditorDWIM (mkTemplate "msg") queryBS + let responseMsgs = readMsgText "" $ Text.decodeUtf8 responseBS + insertIntoFile f2' f1' responseMsgs + + +normalizeLang :: Bool -> String -> String +normalizeLang onlyLang + | onlyLang = fst . break (== '-') + | otherwise = id + +getLang :: Bool -> FilePath -> String +getLang onlyLang = normalizeLang onlyLang . takeFileName + +replaceLang :: FilePath -> String -> FilePath +replaceLang reference l = takeDirectory reference l <.> takeExtensions reference + +getFiles :: FilePath -> IO [FilePath] +getFiles dir = filterM doesFileExist . map (dir ) =<< listDirectory dir + +getTranslateSource :: Translate -> IO (Maybe FilePath) +getTranslateSource TranslateI18nDirectory{..} = do + fs <- getFiles i18nDir + let fs' = sortOn (\(getLang i18nOnlyLang -> l) -> Down . elemIndex l . reverse $ map (normalizeLang i18nOnlyLang) i18nSourceLangs) fs + return $ listToMaybe fs' + +getMissingFiles :: Translate -> IO [FilePath] +getMissingFiles TranslateI18nDirectory{..} = do + fs <- getFiles i18nDir + + let + exts :: HashMap String [FilePath] + exts = HashMap.fromListWith (<>) $ map (takeExtensions &&& pure) fs + + return . flip concatMap exts $ \refs@(r : _) -> + let ls :: [String] + ls = map (getLang i18nOnlyLang) refs + missing :: [String] + missing = filter (\l -> not $ any (== normalizeLang i18nOnlyLang l) ls) i18nRequiredLangs + in map (replaceLang r) missing + +translateFrom :: FilePath -> FilePath -> IO () +translateFrom from to = do + editor <- userEditorDefault _default_editor + flip onError (removeFile to) $ do + copyFile from to + callProcess editor [to]