forked from GitHub/gf-rgl
Update Clone.hs to add copy api files and add language to config
This commit is contained in:
32
src/Clone.hs
32
src/Clone.hs
@@ -6,19 +6,24 @@ import Data.Char
|
||||
import Data.List
|
||||
import System.Process
|
||||
import System.Directory
|
||||
import System.FilePath
|
||||
import System.Environment (getArgs)
|
||||
import System.Exit
|
||||
|
||||
import Text.Printf
|
||||
|
||||
-- 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
|
||||
-- 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
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
args <- getArgs
|
||||
if length args < 4
|
||||
@@ -31,15 +36,32 @@ main = do
|
||||
createDirectoryIfMissing True todir
|
||||
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
|
||||
s <- readFile (fromdir ++ "/" ++ absname ++ from ++ absfx ++ ".gf")
|
||||
writeAndReportFile (todir ++ "/" ++ absname ++ to ++ absfx ++ ".gf") (commentIf options (replaceLang from to s))
|
||||
|
||||
getAbstractName :: String -> String -> (String, String)
|
||||
getAbstractName from file
|
||||
| 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, [])
|
||||
| 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
|
||||
repl s = case s of
|
||||
c:cs -> case splitAt lgs s of
|
||||
@@ -49,12 +71,14 @@ replaceLang s1 s2 = repl where
|
||||
_ -> s
|
||||
lgs = length s1
|
||||
|
||||
commentIf :: [String] -> String -> String
|
||||
commentIf options =
|
||||
let commentbody = if (elem "--comment-body" options) then commentBody else id
|
||||
dropcomments = if (elem "--drop-comments" options) then dropComments else id
|
||||
in
|
||||
unlines . commentbody . dropcomments . lines
|
||||
|
||||
commentBody :: [String] -> [String]
|
||||
commentBody ss = header ++ map comment body ++ ["}"] where
|
||||
(header,body) = break (isJment . words) ss
|
||||
isJment ws = case ws of
|
||||
@@ -65,12 +89,14 @@ commentBody ss = header ++ map comment body ++ ["}"] where
|
||||
_ | all isSpace l -> l -- empty line
|
||||
_ -> "--" ++ l
|
||||
|
||||
dropComments :: [String] -> [String]
|
||||
dropComments = filter (not . isComment) where
|
||||
isComment line = case dropWhile isSpace line of
|
||||
'-':'-':'#':_ -> False
|
||||
'-':'-':_ -> True
|
||||
_ -> False
|
||||
|
||||
writeAndReportFile :: FilePath -> String -> IO ()
|
||||
writeAndReportFile file s = do
|
||||
writeFile file s
|
||||
putStrLn $ "wrote " ++ file
|
||||
|
||||
Reference in New Issue
Block a user