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