10433
|
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 |