chore: automate translation workflow
This commit is contained in:
Gregor Kleen
parent
605869204f
commit
dd62695e6b
@ -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
|
||||
|
||||
301
translate.hs
Executable file
301
translate.hs
Executable file
@ -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]
|
||||
Loading…
Reference in New Issue
Block a user