1
0
forked from GitHub/gf-rgl

Update Clone.hs to add copy api files and add language to config

This commit is contained in:
John J. Camilleri
2018-08-07 11:21:58 +02:00
parent 0130a0012d
commit faf66b4a88

View File

@@ -6,19 +6,24 @@ import Data.Char
import Data.List import Data.List
import System.Process import System.Process
import System.Directory import System.Directory
import System.FilePath
import System.Environment (getArgs) import System.Environment (getArgs)
import System.Exit import System.Exit
import Text.Printf
-- To clone a project from one language to another: -- To clone a project from one language to another:
-- Clone fromdir todir fromlang tolang (--comment) -- Clone fromdir todir fromlang tolang
-- --
-- 1. for each Module in 'fromdir', copy Module(fromlang) to todir/Module(tolang) ; create todir if it doesn't exist -- 1. for each Module in 'fromdir', copy Module(fromlang) to todir/Module(tolang) ; create todir if it doesn't exist
-- 2. in each Module(tolang), replace substrings fromlang by tolang, if proper suffixes of identifiers -- 2. in each Module(tolang), replace substrings fromlang by tolang, if proper suffixes of identifiers
-- 3. If the option --comment is present, comment out every line in the body -- 3. repeat the above for api/Module(fromlang) to api/Module(tolang)
-- 4. add the language to config file if not present
-- - If the option --comment-body is present, comment out every line in the body
-- - If the option --comment-body is present, comment out every line in the body
-- --
-- Example: runghc Clone swedish danish Swe Dan -- Example: runghc Clone swedish danish Swe Dan
main :: IO ()
main = do main = do
args <- getArgs args <- getArgs
if length args < 4 if length args < 4
@@ -31,15 +36,32 @@ main = do
createDirectoryIfMissing True todir createDirectoryIfMissing True todir
mapM_ (clone options fromdir todir fromlang tolang) modules mapM_ (clone options fromdir todir fromlang tolang) modules
mapM_ (\md -> clone options "api" "api" fromlang tolang (md,"")) apiModules
conf <- readFile configFile
if not (any (isPrefixOf tolang) (lines conf))
then do
appendFile configFile (printf "%s,%s\n" tolang todir)
printf "Language '%s' has been added to %s\n" tolang configFile
else return ()
configFile :: FilePath
configFile = ".." </> "languages.csv"
apiModules :: [String]
apiModules = ["Try","Symbolic","Syntax","Constructors","Combinators"]
clone :: [String] -> String -> String -> String -> String -> (String, String) -> IO ()
clone options fromdir todir from to (absname,absfx) = do clone options fromdir todir from to (absname,absfx) = do
s <- readFile (fromdir ++ "/" ++ absname ++ from ++ absfx ++ ".gf") s <- readFile (fromdir ++ "/" ++ absname ++ from ++ absfx ++ ".gf")
writeAndReportFile (todir ++ "/" ++ absname ++ to ++ absfx ++ ".gf") (commentIf options (replaceLang from to s)) writeAndReportFile (todir ++ "/" ++ absname ++ to ++ absfx ++ ".gf") (commentIf options (replaceLang from to s))
getAbstractName :: String -> String -> (String, String)
getAbstractName from file getAbstractName from file
| isSuffixOf (from ++ "Abs.gf") file = (take (length file - (length from + 6)) file, "Abs") -- (NewDict, Abs) | isSuffixOf (from ++ "Abs.gf") file = (take (length file - (length from + 6)) file, "Abs") -- (NewDict, Abs)
| isSuffixOf (from ++ ".gf") file = (take (length file - (length from + 3)) file, "") -- (NewDict, []) | isSuffixOf (from ++ ".gf") file = (take (length file - (length from + 3)) file, "") -- (NewDict, [])
| otherwise = error ("Need suffix " ++ (from ++ ".gf") ++ " or " ++ (from ++ "Abs.gf") ++ " therefore cannot clone file name " ++ file) | otherwise = error ("Need suffix " ++ (from ++ ".gf") ++ " or " ++ (from ++ "Abs.gf") ++ " therefore cannot clone file name " ++ file)
replaceLang :: String -> String -> String -> String
replaceLang s1 s2 = repl where replaceLang s1 s2 = repl where
repl s = case s of repl s = case s of
c:cs -> case splitAt lgs s of c:cs -> case splitAt lgs s of
@@ -49,12 +71,14 @@ replaceLang s1 s2 = repl where
_ -> s _ -> s
lgs = length s1 lgs = length s1
commentIf :: [String] -> String -> String
commentIf options = commentIf options =
let commentbody = if (elem "--comment-body" options) then commentBody else id let commentbody = if (elem "--comment-body" options) then commentBody else id
dropcomments = if (elem "--drop-comments" options) then dropComments else id dropcomments = if (elem "--drop-comments" options) then dropComments else id
in in
unlines . commentbody . dropcomments . lines unlines . commentbody . dropcomments . lines
commentBody :: [String] -> [String]
commentBody ss = header ++ map comment body ++ ["}"] where commentBody ss = header ++ map comment body ++ ["}"] where
(header,body) = break (isJment . words) ss (header,body) = break (isJment . words) ss
isJment ws = case ws of isJment ws = case ws of
@@ -65,12 +89,14 @@ commentBody ss = header ++ map comment body ++ ["}"] where
_ | all isSpace l -> l -- empty line _ | all isSpace l -> l -- empty line
_ -> "--" ++ l _ -> "--" ++ l
dropComments :: [String] -> [String]
dropComments = filter (not . isComment) where dropComments = filter (not . isComment) where
isComment line = case dropWhile isSpace line of isComment line = case dropWhile isSpace line of
'-':'-':'#':_ -> False '-':'-':'#':_ -> False
'-':'-':_ -> True '-':'-':_ -> True
_ -> False _ -> False
writeAndReportFile :: FilePath -> String -> IO ()
writeAndReportFile file s = do writeAndReportFile file s = do
writeFile file s writeFile file s
putStrLn $ "wrote " ++ file putStrLn $ "wrote " ++ file