tools/darkMagic.hs
author antonc27 <antonc27@mail.ru>
Sat, 08 Aug 2015 20:51:12 +0200
branchios-revival
changeset 11079 2e025063ca12
parent 10433 27d34e33dabc
child 13517 b62b14aa88d4
permissions -rw-r--r--
- Xcode projects updated to recommended settings (auto done by Xcode) - Deployment target now 7.0
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