From 685d044d48b41c05329d15ae86253c77a03c1561 Mon Sep 17 00:00:00 2001 From: "John J. Camilleri" Date: Sat, 7 Jul 2018 13:47:18 +0200 Subject: [PATCH] Update Clone.hs script for copying RGs (and other projects) to new langs --- src/Clone.hs | 75 ++++++++++++++++++++++++++++----------------------- src/MkLang.hs | 49 --------------------------------- 2 files changed, 42 insertions(+), 82 deletions(-) delete mode 100644 src/MkLang.hs diff --git a/src/Clone.hs b/src/Clone.hs index 9346aa740..06c57bbe0 100644 --- a/src/Clone.hs +++ b/src/Clone.hs @@ -3,57 +3,57 @@ module Main where import Control.Monad import Data.Maybe import Data.Char -import System.Cmd +import Data.List +import System.Process import System.Directory -import System.Environment +import System.Environment (getArgs) import System.Exit -- To clone a project from one language to another: +-- Clone fromdir todir fromlang tolang (--comment) -- --- 1. for each Module in 'modules', copy ModuleFROM to ModuleTO --- 2. in each ModuleTO, replace substrings FROM by TO, if not prefixes of an Ident --- 3. in each ModuleTO in 'specifics', comment out every line in the body, except --- those whose first word is in 'commons'. +-- 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 -- --- Syntax: runghc Clone FROM TO --- Example: runhugs Clone Swe Nor - --- The following lines are for the resource grammar project, and can be changed --- to fit other projects. - -modules = [ - "Adjective", "Adverb", "Cat", "Conjunction", "Extra", "Grammar", "Idiom", "Lang", "Noun", "Numeral", - "Phrase", "Question", "Relative", "Sentence", "Symbol", "Text", "Verb", - "All", "Res", "Paradigms"] - ++ specifics -specifics = ["Lexicon","Structural"] -commons = [] +-- Example: runghc Clone swedish danish Swe Dan main = do - from:to:_ <- getArgs - mapM_ (clone from to) modules + args <- getArgs + if length args < 4 + then putStrLn "usage: Clone (--comment-body|--drop-comments) fromdir todir fromlang tolang" + else do + let (options,[fromdir,todir,fromlang,tolang]) = span ((=='-') . head) args + allfromfiles <- getDirectoryContents fromdir + let fromfiles = filter (\f -> isSuffixOf (fromlang ++ ".gf") f || isSuffixOf (fromlang ++ "Abs.gf") f) allfromfiles + let modules = map (getAbstractName fromlang) fromfiles + createDirectoryIfMissing True todir + mapM_ (clone options fromdir todir fromlang tolang) modules -clone from to pref = do - s <- readFile (pref ++ from ++ ".gf") - writeFile (pref ++ to ++ ".gf") (commentIf (isSpecific pref) (replaceLang from to s)) +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)) -isSpecific = flip elem specifics +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 s1 s2 = repl where repl s = case s of c:cs -> case splitAt lgs s of + (pre,'A':'b':'s':c:rest) | pre == s1 && elem c " \n\t,:=(){}.-[];" -> s2 ++ "Abs" ++ [c] ++ repl rest (pre,c:rest) | pre == s1 && elem c " \n\t,:=(){}.-[];" -> s2 ++ [c] ++ repl rest _ -> c : repl cs _ -> s - lgs = 3 -- length s1 + lgs = length s1 --- the file name has the form p....pLLL.gf, i.e. 3-letter lang name, suffix .gf -getLangName fi = - let (nal,ferp) = splitAt 3 (drop 3 (reverse fi)) in - (reverse ferp,reverse nal) - -commentIf c = if c then (unlines . commentBody . lines) else id +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 ss = header ++ map comment body ++ ["}"] where (header,body) = break (isJment . words) ss @@ -63,5 +63,14 @@ commentBody ss = header ++ map comment body ++ ["}"] where comment l = case l of _ | take 2 l == "--" -> l -- already commented _ | all isSpace l -> l -- empty line - _ | elem (head (words l)) commons -> l -- in 'commons' _ -> "--" ++ l + +dropComments = filter (not . isComment) where + isComment line = case dropWhile isSpace line of + '-':'-':'#':_ -> False + '-':'-':_ -> True + _ -> False + +writeAndReportFile file s = do + writeFile file s + putStrLn $ "wrote " ++ file diff --git a/src/MkLang.hs b/src/MkLang.hs deleted file mode 100644 index 6c1b83b45..000000000 --- a/src/MkLang.hs +++ /dev/null @@ -1,49 +0,0 @@ -module Main where - --- Prepare a new resource directory. Usage: --- 1. $ cp german/*.gf dutch/ --- 2. $ cd dutch/ --- 3. $ runghc ../MkLang.hs Ger Dut --- AR 6/11/2009 - -import System.Cmd -import System.Environment -import Data.List - -main = do - xx <- getArgs - change xx - -change xx = case xx of - from:to:_ -> do - system "ls *.gf > files.tmp" - files <- readFile "files.tmp" >>= return . lines - mapM_ (changeFileName from to) files - system "ls *.gf > files.tmp" - files <- readFile "files.tmp" >>= return . lines - mapM_ (changeIdents from to) files ----- mapM_ commentOut files - comment -> do - files <- readFile "files.tmp" >>= return . lines - mapM_ commentOut files - -changeFileName from to file = system $ "mv " ++ file ++ " " ++ to_file where - to_file = take (length file - 3 - length from) (takeWhile (/='.') file) ++ to ++ ".gf" - -changeIdents from to = changeInFile changes - where - lg = length from - changes s = case s of - c:cs - | take lg s == from -> to ++ changes (drop lg s) - | otherwise -> c : changes cs - _ -> s - -commentOut = changeInFile comm where - comm s = let (hd,tl) = break (=='{') s in - hd ++ "\n{\n" ++ unlines ["--" ++ l | l <- lines tl] ++ "\n}\n" - -changeInFile ch file = do - s <- readFile file - writeFile "gf.tmp" (ch s) - system $ "mv gf.tmp " ++ file