Backed out
changeset e60e2e7dd43a to restore pre-0.9.25 string changes
{-# LANGUAGE FlexibleContexts #-}
module Main where
import System.Directory
import Control.Monad
import Data.List
import Text.Parsec
import Control.Monad.IO.Class
import Data.Maybe
data LuaCode =
Comments String
| LuaLocString LuaCode LuaCode
| LuaString String LuaCode
| CodeChunk String LuaCode
| LuaOp String LuaCode
| BlocksList Char [LuaCode]
| NoCode
deriving (Show, Eq)
toChunk a = CodeChunk a NoCode
isLuaString LuaLocString{} = True
isLuaString LuaString{} = True
isLuaString _ = False
isLocString (BlocksList _ blocks) = or $ map isLocString blocks
isLocString LuaLocString{} = True
isLocString (LuaString _ lc) = isLocString lc
isLocString (CodeChunk _ lc) = isLocString lc
isLocString (LuaOp _ lc) = isLocString lc
isLocString _ = False
many1Till :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
many1Till p end = do
res <- scan
if null res then unexpected "many1Till" else return res
where
scan = do{ end; return [] }
<|>
do{ x <- p; xs <- scan; return (x:xs) }
processScript :: String -> IO [LuaCode]
processScript fileName = do
r <- runParserT processFile () "" ""
case r of
(Left a) -> do
putStrLn $ "Error: " ++ (show a)
return []
(Right a) -> return a
where
processFile = do
--liftIO $ putStrLn $ "Processing: " ++ fileName
f <- liftIO (readFile fileName)
setInput f
process
comment :: ParsecT String u IO LuaCode
comment = liftM Comments $ choice [
(try $ string "--[[") >> manyTill anyChar (try $ string "]]") >>= \s -> return $ "--[[" ++ s ++ "]]"
, (try $ string "--") >> manyTill anyChar (try newline) >>= \s -> return $ "--" ++ s ++ "\n"
]
stringConcat :: ParsecT String u IO ()
stringConcat = try $ string ".." >> spaces
locString :: ParsecT String u IO LuaCode
locString = do
s <- (try $ optional stringConcat >> string "loc(") >> luaString >>= \s -> char ')' >> return s
subString <- liftM (fromMaybe NoCode) . optionMaybe . try $ spaces >> string ".." >> spaces >> codeBlock
return $ LuaLocString s subString
luaString :: ParsecT String u IO LuaCode
luaString = do
s <- choice[
(try $ optional stringConcat >> char '\'') >> many (noneOf "'\n") >>= \s -> char '\'' >> return s
, (try $ optional stringConcat >> char '"') >> many (noneOf "\"\n") >>= \s -> char '"' >> return s
]
subString <- liftM (fromMaybe NoCode) . optionMaybe . try $ spaces >> string ".." >> spaces >> codeBlock
return $ LuaString s subString
luaOp :: ParsecT String u IO LuaCode
luaOp = do
s <- many1Till anyChar (lookAhead $ (oneOf "=-.,()[]{}'\"" >> return ()) <|> (try (string "end") >> return ()))
subCode <- liftM (fromMaybe NoCode) . optionMaybe . try $ codeBlock
return $ LuaOp s subCode
codeBlock :: ParsecT String u IO LuaCode
codeBlock = do
s <- choice [
comment
, liftM toChunk $ many1 space
, locString
, luaString
, luaOp
, liftM (BlocksList '[') . brackets $ commaSep luaOp
, liftM (BlocksList '{') . braces $ commaSep luaOp
, liftM (BlocksList '(') . parens $ commaSep luaOp
]
return s
brackets = between (char '[') (char ']')
braces = between (char '{') (char '}')
parens = between (char '(') (char ')')
commaSep p = p `sepBy` (char ',')
otherStuff :: ParsecT String u IO LuaCode
otherStuff = liftM (\s -> CodeChunk s NoCode) $ manyTill anyChar (try $ lookAhead codeBlock)
process :: ParsecT String u IO [LuaCode]
process = do
codes <- many $ try $ do
a <- otherStuff
b <- liftM (fromMaybe (CodeChunk "" NoCode)) $ optionMaybe $ try codeBlock
return [a, b]
liftIO . putStrLn . unlines . map (renderLua . processLocString) . filter isLocString $ concat codes
return $ concat codes
listFilesRecursively :: FilePath -> IO [FilePath]
listFilesRecursively dir = do
fs <- liftM (map (\d -> dir ++ ('/' : d)) . filter ((/=) '.' . head)) $ getDirectoryContents dir
dirs <- filterM doesDirectoryExist fs
recfs <- mapM listFilesRecursively dirs
return . concat $ fs : recfs
renderLua :: LuaCode -> String
renderLua (Comments str) = str
renderLua (LuaLocString lc1 lc2) = let r = renderLua lc2 in "loc(" ++ renderLua lc1 ++ ")" ++ r
renderLua (LuaString str lc) = let r = renderLua lc in "\"" ++ str ++ "\"" ++ r
renderLua (CodeChunk str lc) = str ++ renderLua lc
renderLua (LuaOp str lc) = str ++ renderLua lc
renderLua (BlocksList t lcs) = t : (concat . intersperse "," . map renderLua) lcs ++ [mirror t]
renderLua NoCode = ""
processLocString :: LuaCode -> LuaCode
processLocString lcode = let (str, params) = pp lcode in
LuaLocString (LuaString str NoCode)
(if null params then NoCode else (CodeChunk ".format" $ BlocksList '(' params))
where
pp (Comments _) = ("", [])
pp (LuaLocString lc1 lc2) = let (s1, p1) = pp lc1; (s2, p2) = pp lc2 in (s1 ++ s2, p1 ++ p2)
pp (LuaString str lc) = let (s, p) = pp lc in (str ++ s, p)
pp (CodeChunk str lc) = let (s, p) = pp lc in ("%s" ++ s, p)
pp (LuaOp str lc) = let (s, p) = pp lc in ("%s" ++ s, [LuaOp str (head $ p ++ [NoCode])])
pp (BlocksList t lcs) = ("", [BlocksList t lcs])
pp NoCode = ("", [])
mirror '(' = ')'
mirror '[' = ']'
mirror '{' = '}'
main = do
(l18ns, scripts) <- liftM (partition (isPrefixOf "share/hedgewars/Data/Locale") . filter (isSuffixOf ".lua"))
$ listFilesRecursively "share/hedgewars/Data"
mapM_ processScript scripts
--putStrLn $ unlines l18ns