--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/darkMagic.hs	Thu Oct 09 22:14:55 2014 +0400
@@ -0,0 +1,159 @@
+module Main where
+
+import System.Directory
+import Control.Monad
+import Data.List
+import Text.Parsec
+import Control.Monad.IO.Class
+import Data.Maybe
+
+data LuaCode =
+    Comments String
+        | LuaLocString LuaCode LuaCode
+        | LuaString String LuaCode
+        | CodeChunk String LuaCode
+        | LuaOp String LuaCode
+        | BlocksList Char [LuaCode]
+        | NoCode
+        deriving (Show, Eq)
+
+toChunk a = CodeChunk a NoCode
+
+isLuaString LuaLocString{} = True
+isLuaString LuaString{} = True
+isLuaString _ = False
+
+isLocString (BlocksList _ blocks) = or $ map isLocString blocks
+isLocString LuaLocString{} = True
+isLocString (LuaString _ lc) = isLocString lc
+isLocString (CodeChunk _ lc) = isLocString lc
+isLocString (LuaOp _ lc) = isLocString lc
+isLocString _ = False
+
+many1Till :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
+many1Till p end      = do
+    res <- scan
+    if null res then unexpected "many1Till" else return res
+                    where
+                    scan  = do{ end; return [] }
+                            <|>
+                            do{ x <- p; xs <- scan; return (x:xs) }
+
+processScript :: String -> IO [LuaCode]
+processScript fileName = do
+    r <- runParserT processFile () "" ""
+    case r of
+         (Left a) -> do
+             putStrLn $ "Error: " ++ (show a)
+             return []
+         (Right a) -> return a
+
+    where
+    processFile = do
+        --liftIO $ putStrLn $ "Processing: " ++ fileName
+        f <- liftIO (readFile fileName)
+        setInput f
+        process
+
+    comment :: ParsecT String u IO LuaCode
+    comment = liftM Comments $ choice [
+            (try $ string "--[[") >> manyTill anyChar (try $ string "]]") >>= \s -> return $ "--[[" ++ s ++ "]]"
+            , (try $ string "--") >> manyTill anyChar (try newline) >>= \s -> return $ "--" ++ s ++ "\n"
+            ]
+            
+    stringConcat :: ParsecT String u IO ()
+    stringConcat = try $ string ".." >> spaces
+
+    locString :: ParsecT String u IO LuaCode
+    locString = do
+        s <- (try $ optional stringConcat >> string "loc(") >> luaString >>= \s -> char ')' >> return s
+        subString <- liftM (fromMaybe NoCode) . optionMaybe . try $ spaces >> string ".." >> spaces >> codeBlock
+        return $ LuaLocString s subString
+
+    luaString :: ParsecT String u IO LuaCode
+    luaString = do
+        s <- choice[
+            (try $ optional stringConcat >> char '\'') >> many (noneOf "'\n") >>= \s -> char '\'' >> return s
+            , (try $ optional stringConcat >> char '"') >> many (noneOf "\"\n") >>= \s -> char '"' >> return s
+            ]
+        subString <- liftM (fromMaybe NoCode) . optionMaybe . try $ spaces >> string ".." >> spaces >> codeBlock
+        return $ LuaString s subString
+
+    luaOp :: ParsecT String u IO LuaCode
+    luaOp = do
+        s <- many1Till anyChar (lookAhead $ (oneOf "=-.,()[]{}'\"" >> return ()) <|> (try (string "end") >> return ()))
+        subCode <- liftM (fromMaybe NoCode) . optionMaybe . try $ codeBlock
+        return $ LuaOp s subCode
+
+    codeBlock :: ParsecT String u IO LuaCode
+    codeBlock = do
+        s <- choice [
+            comment
+            , liftM toChunk $ many1 space
+            , locString
+            , luaString
+            , luaOp
+            , liftM (BlocksList '[') . brackets $ commaSep luaOp
+            , liftM (BlocksList '{') . braces $ commaSep luaOp
+            , liftM (BlocksList '(') . parens $ commaSep luaOp
+            ]
+
+        return s
+
+    brackets = between (char '[') (char ']')
+    braces = between (char '{') (char '}')
+    parens = between (char '(') (char ')')
+    commaSep p  = p `sepBy` (char ',')
+    
+    otherStuff :: ParsecT String u IO LuaCode
+    otherStuff = liftM (\s -> CodeChunk s NoCode) $ manyTill anyChar (try $ lookAhead codeBlock)
+
+    process :: ParsecT String u IO [LuaCode]
+    process = do
+        codes <- many $ try $ do
+            a <- otherStuff
+            b <- liftM (fromMaybe (CodeChunk "" NoCode)) $ optionMaybe $ try codeBlock
+            return [a, b]
+        liftIO . putStrLn . unlines . map (renderLua . processLocString) . filter isLocString $ concat codes
+        return $ concat codes
+
+listFilesRecursively :: FilePath -> IO [FilePath]
+listFilesRecursively dir = do
+    fs <- liftM (map (\d -> dir ++ ('/' : d)) . filter ((/=) '.' . head)) $ getDirectoryContents dir
+    dirs <- filterM doesDirectoryExist fs
+    recfs <- mapM listFilesRecursively dirs
+    return . concat $ fs : recfs
+
+renderLua :: LuaCode -> String
+renderLua (Comments str) = str
+renderLua (LuaLocString lc1 lc2) = let r = renderLua lc2 in "loc(" ++ renderLua lc1 ++ ")" ++ r
+renderLua (LuaString str lc) = let r = renderLua lc in "\"" ++ str ++ "\"" ++ r
+renderLua (CodeChunk str lc) = str ++ renderLua lc
+renderLua (LuaOp str lc) = str ++ renderLua lc
+renderLua (BlocksList t lcs) = t : (concat . intersperse "," . map renderLua) lcs ++ [mirror t]
+renderLua NoCode = ""
+
+processLocString :: LuaCode -> LuaCode
+processLocString lcode = let (str, params) = pp lcode in
+                          LuaLocString (LuaString str NoCode) 
+                            (if null params then NoCode else (CodeChunk ".format" $ BlocksList '(' params))
+    where
+        pp (Comments _) = ("", [])
+        pp (LuaLocString lc1 lc2) = let (s1, p1) = pp lc1; (s2, p2) = pp lc2 in (s1 ++ s2, p1 ++ p2)
+        pp (LuaString str lc) = let (s, p) = pp lc in (str ++ s, p)
+        pp (CodeChunk str lc) = let (s, p) = pp lc in ("%s" ++ s, p)
+        pp (LuaOp str lc) = let (s, p) = pp lc in ("%s" ++ s, [LuaOp str (head $ p ++ [NoCode])])
+        pp (BlocksList t lcs) = ("", [BlocksList t lcs])
+        pp NoCode = ("", [])
+
+mirror '(' = ')'
+mirror '[' = ']'
+mirror '{' = '}'
+
+main = do
+    (l18ns, scripts) <- liftM (partition (isPrefixOf "share/hedgewars/Data/Locale") . filter (isSuffixOf ".lua")) 
+        $ listFilesRecursively "share/hedgewars/Data"
+
+    mapM_ processScript scripts
+
+    --putStrLn $ unlines l18ns
\ No newline at end of file