tools/darkMagic.hs
author Wuzzy <Wuzzy2@mail.ru>
Wed, 25 Oct 2017 23:09:41 +0200
changeset 12768 ad67a3804981
parent 10433 27d34e33dabc
child 13516 b62b14aa88d4
permissions -rw-r--r--
Fix sometimes ammo schemes not being saved after changing before an ammo scheme got deleted in session This was because the bool isDeleting is not initialized, so its initial value is unpredictable. Which means there's chance it starts with true, confusing the frontend.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
10433
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
     1
module Main where
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
     2
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
     3
import System.Directory
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
     4
import Control.Monad
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
     5
import Data.List
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
     6
import Text.Parsec
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
     7
import Control.Monad.IO.Class
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
     8
import Data.Maybe
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
     9
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    10
data LuaCode =
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    11
    Comments String
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    12
        | LuaLocString LuaCode LuaCode
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    13
        | LuaString String LuaCode
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    14
        | CodeChunk String LuaCode
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    15
        | LuaOp String LuaCode
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    16
        | BlocksList Char [LuaCode]
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    17
        | NoCode
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    18
        deriving (Show, Eq)
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    19
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    20
toChunk a = CodeChunk a NoCode
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    21
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    22
isLuaString LuaLocString{} = True
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    23
isLuaString LuaString{} = True
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    24
isLuaString _ = False
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    25
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    26
isLocString (BlocksList _ blocks) = or $ map isLocString blocks
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    27
isLocString LuaLocString{} = True
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    28
isLocString (LuaString _ lc) = isLocString lc
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    29
isLocString (CodeChunk _ lc) = isLocString lc
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    30
isLocString (LuaOp _ lc) = isLocString lc
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    31
isLocString _ = False
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    32
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    33
many1Till :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    34
many1Till p end      = do
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    35
    res <- scan
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    36
    if null res then unexpected "many1Till" else return res
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    37
                    where
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    38
                    scan  = do{ end; return [] }
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    39
                            <|>
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    40
                            do{ x <- p; xs <- scan; return (x:xs) }
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    41
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    42
processScript :: String -> IO [LuaCode]
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    43
processScript fileName = do
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    44
    r <- runParserT processFile () "" ""
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    45
    case r of
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    46
         (Left a) -> do
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    47
             putStrLn $ "Error: " ++ (show a)
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    48
             return []
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    49
         (Right a) -> return a
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    50
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    51
    where
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    52
    processFile = do
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    53
        --liftIO $ putStrLn $ "Processing: " ++ fileName
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    54
        f <- liftIO (readFile fileName)
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    55
        setInput f
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    56
        process
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    57
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    58
    comment :: ParsecT String u IO LuaCode
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    59
    comment = liftM Comments $ choice [
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    60
            (try $ string "--[[") >> manyTill anyChar (try $ string "]]") >>= \s -> return $ "--[[" ++ s ++ "]]"
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    61
            , (try $ string "--") >> manyTill anyChar (try newline) >>= \s -> return $ "--" ++ s ++ "\n"
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    62
            ]
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    63
            
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    64
    stringConcat :: ParsecT String u IO ()
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    65
    stringConcat = try $ string ".." >> spaces
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    66
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    67
    locString :: ParsecT String u IO LuaCode
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    68
    locString = do
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    69
        s <- (try $ optional stringConcat >> string "loc(") >> luaString >>= \s -> char ')' >> return s
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    70
        subString <- liftM (fromMaybe NoCode) . optionMaybe . try $ spaces >> string ".." >> spaces >> codeBlock
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    71
        return $ LuaLocString s subString
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    72
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    73
    luaString :: ParsecT String u IO LuaCode
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    74
    luaString = do
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    75
        s <- choice[
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    76
            (try $ optional stringConcat >> char '\'') >> many (noneOf "'\n") >>= \s -> char '\'' >> return s
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    77
            , (try $ optional stringConcat >> char '"') >> many (noneOf "\"\n") >>= \s -> char '"' >> return s
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    78
            ]
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    79
        subString <- liftM (fromMaybe NoCode) . optionMaybe . try $ spaces >> string ".." >> spaces >> codeBlock
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    80
        return $ LuaString s subString
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    81
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    82
    luaOp :: ParsecT String u IO LuaCode
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    83
    luaOp = do
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    84
        s <- many1Till anyChar (lookAhead $ (oneOf "=-.,()[]{}'\"" >> return ()) <|> (try (string "end") >> return ()))
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    85
        subCode <- liftM (fromMaybe NoCode) . optionMaybe . try $ codeBlock
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    86
        return $ LuaOp s subCode
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    87
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    88
    codeBlock :: ParsecT String u IO LuaCode
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    89
    codeBlock = do
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    90
        s <- choice [
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    91
            comment
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    92
            , liftM toChunk $ many1 space
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    93
            , locString
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    94
            , luaString
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    95
            , luaOp
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    96
            , liftM (BlocksList '[') . brackets $ commaSep luaOp
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    97
            , liftM (BlocksList '{') . braces $ commaSep luaOp
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    98
            , liftM (BlocksList '(') . parens $ commaSep luaOp
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
    99
            ]
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   100
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   101
        return s
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   102
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   103
    brackets = between (char '[') (char ']')
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   104
    braces = between (char '{') (char '}')
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   105
    parens = between (char '(') (char ')')
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   106
    commaSep p  = p `sepBy` (char ',')
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   107
    
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   108
    otherStuff :: ParsecT String u IO LuaCode
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   109
    otherStuff = liftM (\s -> CodeChunk s NoCode) $ manyTill anyChar (try $ lookAhead codeBlock)
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   110
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   111
    process :: ParsecT String u IO [LuaCode]
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   112
    process = do
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   113
        codes <- many $ try $ do
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   114
            a <- otherStuff
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   115
            b <- liftM (fromMaybe (CodeChunk "" NoCode)) $ optionMaybe $ try codeBlock
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   116
            return [a, b]
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   117
        liftIO . putStrLn . unlines . map (renderLua . processLocString) . filter isLocString $ concat codes
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   118
        return $ concat codes
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   119
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   120
listFilesRecursively :: FilePath -> IO [FilePath]
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   121
listFilesRecursively dir = do
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   122
    fs <- liftM (map (\d -> dir ++ ('/' : d)) . filter ((/=) '.' . head)) $ getDirectoryContents dir
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   123
    dirs <- filterM doesDirectoryExist fs
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   124
    recfs <- mapM listFilesRecursively dirs
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   125
    return . concat $ fs : recfs
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   126
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   127
renderLua :: LuaCode -> String
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   128
renderLua (Comments str) = str
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   129
renderLua (LuaLocString lc1 lc2) = let r = renderLua lc2 in "loc(" ++ renderLua lc1 ++ ")" ++ r
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   130
renderLua (LuaString str lc) = let r = renderLua lc in "\"" ++ str ++ "\"" ++ r
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   131
renderLua (CodeChunk str lc) = str ++ renderLua lc
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   132
renderLua (LuaOp str lc) = str ++ renderLua lc
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   133
renderLua (BlocksList t lcs) = t : (concat . intersperse "," . map renderLua) lcs ++ [mirror t]
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   134
renderLua NoCode = ""
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   135
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   136
processLocString :: LuaCode -> LuaCode
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   137
processLocString lcode = let (str, params) = pp lcode in
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   138
                          LuaLocString (LuaString str NoCode) 
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   139
                            (if null params then NoCode else (CodeChunk ".format" $ BlocksList '(' params))
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   140
    where
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   141
        pp (Comments _) = ("", [])
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   142
        pp (LuaLocString lc1 lc2) = let (s1, p1) = pp lc1; (s2, p2) = pp lc2 in (s1 ++ s2, p1 ++ p2)
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   143
        pp (LuaString str lc) = let (s, p) = pp lc in (str ++ s, p)
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   144
        pp (CodeChunk str lc) = let (s, p) = pp lc in ("%s" ++ s, p)
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   145
        pp (LuaOp str lc) = let (s, p) = pp lc in ("%s" ++ s, [LuaOp str (head $ p ++ [NoCode])])
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   146
        pp (BlocksList t lcs) = ("", [BlocksList t lcs])
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   147
        pp NoCode = ("", [])
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   148
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   149
mirror '(' = ')'
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   150
mirror '[' = ']'
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   151
mirror '{' = '}'
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   152
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   153
main = do
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   154
    (l18ns, scripts) <- liftM (partition (isPrefixOf "share/hedgewars/Data/Locale") . filter (isSuffixOf ".lua")) 
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   155
        $ listFilesRecursively "share/hedgewars/Data"
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   156
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   157
    mapM_ processScript scripts
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   158
27d34e33dabc some unfinished stuff
unc0rr
parents:
diff changeset
   159
    --putStrLn $ unlines l18ns