From f283944f5c8dc043b32bee8a507d67acd256e225 Mon Sep 17 00:00:00 2001 From: krasimir Date: Mon, 11 May 2009 06:55:11 +0000 Subject: Setup.hs now builds RGL. the code is borrowed from Make.hs --- Setup.hs | 267 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 267 insertions(+) create mode 100644 Setup.hs (limited to 'Setup.hs') diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 000000000..e08ce7479 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,267 @@ +module Main where + +import Distribution.Simple +import Distribution.Simple.LocalBuildInfo +import Distribution.Simple.BuildPaths +import Distribution.Simple.Utils +import Distribution.Simple.Setup +import Distribution.PackageDescription +import Control.Monad +import Data.Maybe +import System.Cmd +import System.FilePath +import System.Directory +import System.Environment +import System.Exit + +main :: IO () +main = defaultMainWithHooks simpleUserHooks{ preBuild =checkRGLArgs + , postBuild=buildRGL + , preInst =checkRGLArgs + , postInst =installRGL + , sDistHook=sdistRGL + } + +-------------------------------------------------------- +-- Commands for building the Resource Grammar Library +-------------------------------------------------------- + +data Mode + = AllTenses + | Present + | Minimal + deriving Show + +data RGLCommand + = RGLCommand + { cmdName :: String + , cmdIsDef :: Bool + , cmdAction :: Mode -> [String] -> PackageDescription -> LocalBuildInfo -> IO () + } + +rglCommands = + [ RGLCommand "lang" True $ \mode args pkg lbi -> do + mapM_ (gfc mode pkg lbi . lang) (optl langsLang args) + mapM_ (gfc mode pkg lbi . symbol) (optl langsAPI args) + , RGLCommand "compat" True $ \mode args pkg lbi -> do + mapM_ (gfc mode pkg lbi . compat) (optl langsCompat args) + , RGLCommand "api" True $ \mode args pkg lbi -> do + mapM_ (gfc mode pkg lbi . try) (optl langsAPI args) + mapM_ (gfc mode pkg lbi . symbolic) (optl langsAPI args) +-- , RGLCommand "minimal" True $ \pres args lbi -> do +-- mapM_ (gfcmin lbi . syntax) (optl langsMinimal args) + , RGLCommand "pgf" False $ \mode args pkg lbi -> do + let dir = getRGLBuildDir lbi mode + createDirectoryIfMissing True dir + run_gfc pkg lbi $ ["-s","--make","--name=langs","--parser=off", + "--output-dir=" ++ dir] + ++ [dir ++ "/Lang" ++ la ++ ".gfo" | (_,la) <- optl langsPGF args] + , RGLCommand "test" False $ \mode args pkg lbi -> do + let dir = getRGLBuildDir lbi mode + let ls = optl langsTest args + createDirectoryIfMissing True dir + gf (treeb "Lang" ls) $ unwords [dir ++ "/Lang" ++ la ++ ".gfo" | (_,la) <- ls] + return () + , RGLCommand "demo" False $ \mode args pkg lbi -> do + let ls = optl langsDemo args + gf (demos "Demo" ls) $ unwords ["demo/Demo" ++ la ++ ".gf" | (_,la) <- ls] + return () + , RGLCommand "parse" False $ \mode args pkg lbi -> do + mapM_ (gfc mode pkg lbi . parse) (optl langsParse args) + ] + where + optl ls args = fromMaybe ls $ getOptLangs args + +-------------------------------------------------------- + +checkRGLArgs args flags = do + let args' = filter (\arg -> not (arg == "present" || + arg == "minimal" || + take (length rgl_prefix) arg == rgl_prefix || + take (length langs_prefix) arg == langs_prefix)) args + if null args' + then return emptyHookedBuildInfo + else die $ "Unrecognised flags: " ++ intercalate ", " args' + +buildRGL args flags pkg lbi = do + let cmds = getRGLCommands args + let mode = getOptMode args + mapM_ (\cmd -> cmdAction cmd mode args pkg lbi) cmds + +installRGL args flags pkg lbi = do + let mode = getOptMode args + let inst_gf_lib_dir = datadir (absoluteInstallDirs pkg lbi NoCopyDest) "lib" + copyAll mode (getRGLBuildDir lbi mode) (inst_gf_lib_dir getRGLBuildSubDir lbi mode) + where + copyAll mode from to = do + putStrLn $ "Installing [" ++ show mode ++ "] " ++ to + createDirectoryIfMissing True to + files <- fmap (drop 2) $ getDirectoryContents from + mapM_ (\file -> copyFile (from file) (to file)) files + +sdistRGL pkg mb_lbi hooks flags = do + paths <- getRGLFiles rgl_dir [] + let pkg' = pkg{dataFiles=paths} + sDistHook simpleUserHooks pkg' mb_lbi hooks flags + where + getRGLFiles dir paths = do + files <- getDirectoryContents dir + foldM (processFile dir) paths [file | file <- files, file /= "." && file /= ".."] + + processFile dir paths file = do + let path = dir file + print path + isFile <- doesFileExist path + if isFile + then if takeExtension file == ".gf" || file == "LICENSE" + then return (path : paths) + else return paths + else getRGLFiles path paths + +rgl_dir = "next-lib" "src" + +-- the languages have long directory names and short ISO codes (3 letters) +-- we also give the decodings for postprocessing linearizations, as long as grammars +-- don't support all flags needed; they are used in tests + +langsCoding = [ + (("arabic", "Ara"),""), + (("bulgarian","Bul"),""), + (("catalan", "Cat"),""), + (("danish", "Dan"),""), + (("english", "Eng"),""), + (("finnish", "Fin"),""), + (("french", "Fre"),""), + (("hindi", "Hin"),"to_devanagari"), + (("german", "Ger"),""), +-- (("interlingua","Ina"),""), + (("italian", "Ita"),""), + (("latin", "Lat"),""), + (("norwegian","Nor"),""), + (("polish", "Pol"),""), + (("romanian", "Ron"),""), + (("russian", "Rus"),""), + (("spanish", "Spa"),""), + (("swedish", "Swe"),""), + (("thai", "Tha"),"to_thai"), + (("turkish", "Tur"),"") + ] + +langs = map fst langsCoding + +-- languagues for which to compile Lang +langsLang = langs `except` ["Ara","Lat","Pol","Ron","Tur"] + +-- languages for which to compile Try +langsAPI = langsLang `except` ["Bul","Hin","Ina","Rus","Tha"] + +-- languages for which to run treebank test +langsTest = langsLang `except` ["Ara","Bul","Cat","Hin","Rus","Spa","Tha"] + +-- languages for which to run demo test +langsDemo = langsLang `except` ["Ara","Hin","Ina","Tha"] + +-- languages for which to compile parsing grammars +langsParse = langs `only` ["Eng"] + +-- languages for which langs.pgf is built +langsPGF = langsTest `only` ["Eng","Fre","Swe"] + +-- languages for which Compatibility exists (to be extended) +langsCompat = langsLang `only` ["Cat","Eng","Fin","Fre","Ita","Spa","Swe"] + +treebankExx = "exx-resource.gft" +treebankResults = "exx-resource.gftb" + +gfc mode pkg lbi file = do + let dir = getRGLBuildDir lbi mode + preproc = case mode of + AllTenses -> "" + Present -> "-preproc="++(rgl_dir "mkPresent") + Minimal -> "-preproc="++(rgl_dir "mkMinimal") + createDirectoryIfMissing True dir + putStrLn $ "Compiling [" ++ show mode ++ "] " ++ file + run_gfc pkg lbi ["-s", preproc, "--gfo-dir="++dir, file] + +gf comm file = do + putStrLn $ "Reading " ++ file + let cmd = "echo \"" ++ comm ++ "\" | gf -s " ++ file + putStrLn cmd + system cmd + +treeb abstr ls = "rf -lines -tree -file=" ++ treebankExx ++ + " | l -treebank " ++ unlexer abstr ls ++ " | wf -file=" ++ treebankResults + +demos abstr ls = "gr -number=100 | l -treebank " ++ unlexer abstr ls ++ + " | ps -to_html | wf -file=resdemo.html" + +lang (lla,la) = rgl_dir lla ("All" ++ la ++ ".gf") +compat (lla,la) = rgl_dir lla ("Compatibility" ++ la ++ ".gf") +symbol (lla,la) = rgl_dir lla ("Symbol" ++ la ++ ".gf") + +try (lla,la) = rgl_dir "api" ("Try" ++ la ++ ".gf") +syntax (lla,la) = rgl_dir "api" ("Syntax" ++ la ++ ".gf") + +symbolic (lla,la) = rgl_dir "api" ("Symbolic" ++ la ++ ".gf") +parse (lla,la) = rgl_dir "parse" ("Parse" ++ la ++ ".gf") + +except ls es = filter (flip notElem es . snd) ls +only ls es = filter (flip elem es . snd) ls + +getOptMode args + | elem "present" args = Present + | elem "minimal" args = Minimal + | otherwise = AllTenses + +-- list of languages overriding the definitions above +getOptLangs args = case [ls | arg <- args, let (f,ls) = splitAt (length langs_prefix) arg, f==langs_prefix] of + ls:_ -> return $ findLangs $ seps ls + _ -> Nothing + where + seps = words . map (\c -> if c==',' then ' ' else c) + findLangs ls = [lang | lang@(_,la) <- langs, elem la ls] + +getRGLBuildSubDir lbi mode = + case mode of + AllTenses -> "alltenses" + Present -> "present" + Minimal -> "minimal" + +getRGLBuildDir lbi mode = buildDir lbi "rgl" getRGLBuildSubDir lbi mode + +getRGLCommands args = + let cmds0 = [cmd | arg <- args, + let (prefix,name) = splitAt (length rgl_prefix) arg, + prefix == rgl_prefix, + cmd <- rglCommands, + cmdName cmd == name] + in if null cmds0 + then [cmd | cmd <- rglCommands, cmdIsDef cmd] + else cmds0 + +langs_prefix = "langs=" +rgl_prefix = "rgl-" + +unlexer abstr ls = + "-unlexer=\\\"" ++ unwords + [abstr ++ la ++ "=" ++ unl | + lla@(_,la) <- ls, let unl = unlex lla, not (null unl)] ++ + "\\\"" + where + unlex lla = maybe "" id $ lookup lla langsCoding + +-- | Runs the gf executable in compile mode with the given arguments. +run_gfc :: PackageDescription -> LocalBuildInfo -> [String] -> IO () +run_gfc pkg lbi args = + do let args' = ["-batch","-gf-lib-path="++rgl_dir] ++ filter (not . null) args ++ ["+RTS"] ++ rts_flags ++ ["-RTS"] + let exeName' = (exeName . head . executables) pkg + exeNameReal = exeName' <.> (if null $ takeExtension exeName' then exeExtension else "") + default_gf = buildDir lbi exeName' exeNameReal + putStrLn $ "Running: " ++ default_gf ++ " " ++ unwords (map showArg args') + e <- rawSystem default_gf args' + case e of + ExitSuccess -> return () + ExitFailure i -> die $ "gf exited with exit code: " ++ show i + where rts_flags = ["-K100M"] + showArg arg = "'" ++ arg ++ "'" + -- cgit v1.2.3