tools/darkMagic.hs
author Wuzzy <Wuzzy2@mail.ru>
Mon, 13 Nov 2017 22:14:45 +0100
changeset 12836 8610462e3d33
parent 10433 27d34e33dabc
child 13511 b62b14aa88d4
permissions -rw-r--r--
Remove 2 unused number tags in Construction Mode GUI These numbers are shown aside the power tag, but the numbers never change. They don't serve any purpose and are just visual clutter and annoying, since they partially overlap. They are probably a leftover from copying code over from other scripts. With this changeset, only the power and turn time are left visible, as it is supposed to.

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