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