script for cloning a resource grammar project

lib/src/Clone.hs

@@ -0,0 +1,67 @@
+module Main where
+
+import Control.Monad
+import Data.Maybe
+import Data.Char
+import System.Cmd
+import System.Directory
+import System.Environment
+import System.Exit
+
+
+-- To clone a project from one language to another:
+--
+-- 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'.
+--
+-- 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 = []
+
+main = do
+  from:to:_ <- getArgs
+  mapM_ (clone from to) modules
+
+clone from to pref = do
+  s <- readFile (pref ++ from ++ ".gf")
+  writeFile (pref ++ to ++ ".gf") (commentIf (isSpecific pref) (replaceLang from to s))
+
+isSpecific = flip elem specifics
+
+replaceLang s1 s2 = repl where
+  repl s = case s of
+    c:cs -> case splitAt lgs s of
+      (pre,c:rest) | pre == s1 && elem c " \n\t,:=(){}.-[];" -> s2 ++ [c] ++ repl rest
+      _                      -> c : repl cs
+    _ -> s
+  lgs = 3 -- 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
+
+commentBody ss = header ++ map comment body ++ ["}"] where
+  (header,body) = break (isJment . words) ss
+  isJment ws = case ws of
+    k:_ | elem k ["flags","lin","lincat","oper","param"] -> True
+    _ -> False
+  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