mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-23 03:32:51 -06:00
Cleanup in Setup.hs; include custom-setup:setup-depends in cabal file.
This commit is contained in:
68
Setup.hs
68
Setup.hs
@@ -2,20 +2,16 @@ import Distribution.Simple(defaultMainWithHooks,UserHooks(..),simpleUserHooks)
|
|||||||
import Distribution.Simple.LocalBuildInfo(LocalBuildInfo(..),absoluteInstallDirs,datadir)
|
import Distribution.Simple.LocalBuildInfo(LocalBuildInfo(..),absoluteInstallDirs,datadir)
|
||||||
import Distribution.Simple.BuildPaths(exeExtension)
|
import Distribution.Simple.BuildPaths(exeExtension)
|
||||||
import Distribution.Simple.Utils(intercalate)
|
import Distribution.Simple.Utils(intercalate)
|
||||||
import Distribution.Simple.Setup(BuildFlags(..),Flag(..),InstallFlags(..),CopyDest(..),CopyFlags(..))
|
import Distribution.Simple.Setup(BuildFlags(..),Flag(..),InstallFlags(..),CopyDest(..),CopyFlags(..),SDistFlags(..))
|
||||||
import Distribution.PackageDescription(PackageDescription(..),emptyHookedBuildInfo)
|
import Distribution.PackageDescription(PackageDescription(..),HookedBuildInfo(..),emptyHookedBuildInfo)
|
||||||
import Control.Monad(unless,when)
|
import Control.Monad(unless)
|
||||||
import Data.List(isPrefixOf,intersect)
|
import Data.List(isPrefixOf,intersect)
|
||||||
import qualified Control.Exception as E
|
|
||||||
import System.Process(readProcess)
|
import System.Process(readProcess)
|
||||||
import System.FilePath((</>),(<.>))
|
import System.FilePath((</>),(<.>))
|
||||||
import System.Directory(createDirectoryIfMissing,copyFile,getDirectoryContents)
|
import System.Directory(createDirectoryIfMissing,copyFile,getDirectoryContents,listDirectory)
|
||||||
|
|
||||||
import WebSetup
|
import WebSetup
|
||||||
|
|
||||||
tryIOE :: IO a -> IO (Either E.IOException a)
|
|
||||||
tryIOE = E.try
|
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = defaultMainWithHooks simpleUserHooks{ preBuild = gfPreBuild
|
main = defaultMainWithHooks simpleUserHooks{ preBuild = gfPreBuild
|
||||||
, postBuild = gfPostBuild
|
, postBuild = gfPostBuild
|
||||||
@@ -34,8 +30,7 @@ main = defaultMainWithHooks simpleUserHooks{ preBuild = gfPreBuild
|
|||||||
return h
|
return h
|
||||||
|
|
||||||
gfPostBuild args flags pkg lbi =
|
gfPostBuild args flags pkg lbi =
|
||||||
do --writeFile "running" ""
|
do buildRGL args flags (flags,pkg,lbi)
|
||||||
buildRGL args flags (flags,pkg,lbi)
|
|
||||||
-- let gf = default_gf lbi
|
-- let gf = default_gf lbi
|
||||||
-- buildWeb gf (pkg,lbi)
|
-- buildWeb gf (pkg,lbi)
|
||||||
|
|
||||||
@@ -69,13 +64,14 @@ bf (i,_,_) = i
|
|||||||
--pd (_,i,_) = i
|
--pd (_,i,_) = i
|
||||||
lbi (_,_,i) = i
|
lbi (_,_,i) = i
|
||||||
|
|
||||||
|
rglCommands :: [RGLCommand]
|
||||||
rglCommands =
|
rglCommands =
|
||||||
[ RGLCommand "prelude" True $ \mode args bi -> do
|
[ RGLCommand "prelude" True $ \mode args bi -> do
|
||||||
putStrLn $ "Compiling [prelude]"
|
putStrLn $ "Compiling [prelude]"
|
||||||
let prelude_src_dir = rgl_src_dir </> "prelude"
|
let prelude_src_dir = rgl_src_dir </> "prelude"
|
||||||
prelude_dst_dir = rgl_dst_dir (lbi bi) </> "prelude"
|
prelude_dst_dir = rgl_dst_dir (lbi bi) </> "prelude"
|
||||||
createDirectoryIfMissing True prelude_dst_dir
|
createDirectoryIfMissing True prelude_dst_dir
|
||||||
files <- list_files prelude_src_dir
|
files <- listDirectory prelude_src_dir
|
||||||
run_gfc bi (["-s", "--gfo-dir="++prelude_dst_dir] ++ [prelude_src_dir </> file | file <- files])
|
run_gfc bi (["-s", "--gfo-dir="++prelude_dst_dir] ++ [prelude_src_dir </> file | file <- files])
|
||||||
|
|
||||||
, RGLCommand "all" True $ gfcp [l,s,c,t,sc]
|
, RGLCommand "all" True $ gfcp [l,s,c,t,sc]
|
||||||
@@ -126,6 +122,7 @@ rglCommands =
|
|||||||
|
|
||||||
--------------------------------------------------------
|
--------------------------------------------------------
|
||||||
|
|
||||||
|
checkRGLArgs :: [String] -> IO HookedBuildInfo
|
||||||
checkRGLArgs args = do
|
checkRGLArgs args = do
|
||||||
let args' = filter (\arg -> not (arg `elem` all_modes ||
|
let args' = filter (\arg -> not (arg `elem` all_modes ||
|
||||||
rgl_prefix `isPrefixOf` arg ||
|
rgl_prefix `isPrefixOf` arg ||
|
||||||
@@ -134,17 +131,20 @@ checkRGLArgs args = do
|
|||||||
putStrLn $ "Unrecognised flags: " ++ intercalate ", " args'
|
putStrLn $ "Unrecognised flags: " ++ intercalate ", " args'
|
||||||
return emptyHookedBuildInfo
|
return emptyHookedBuildInfo
|
||||||
|
|
||||||
|
buildRGL :: [String] -> BuildFlags -> Info -> IO ()
|
||||||
buildRGL args flags bi = do
|
buildRGL args flags bi = do
|
||||||
let cmds = getRGLCommands args
|
let cmds = getRGLCommands args
|
||||||
let modes = getOptMode args
|
let modes = getOptMode args
|
||||||
mapM_ (\cmd -> cmdAction cmd modes args bi) cmds
|
mapM_ (\cmd -> cmdAction cmd modes args bi) cmds
|
||||||
|
|
||||||
|
installRGL :: [String] -> InstallFlags -> (PackageDescription, LocalBuildInfo) -> IO ()
|
||||||
installRGL args flags bi = do
|
installRGL args flags bi = do
|
||||||
let modes = getOptMode args
|
let modes = getOptMode args
|
||||||
let inst_gf_lib_dir = datadir (uncurry absoluteInstallDirs bi NoCopyDest) </> "lib"
|
let inst_gf_lib_dir = datadir (uncurry absoluteInstallDirs bi NoCopyDest) </> "lib"
|
||||||
copyAll "prelude" (rgl_dst_dir (snd bi) </> "prelude") (inst_gf_lib_dir </> "prelude")
|
copyAll "prelude" (rgl_dst_dir (snd bi) </> "prelude") (inst_gf_lib_dir </> "prelude")
|
||||||
sequence_ [copyAll (show mode) (getRGLBuildDir (snd bi) mode) (inst_gf_lib_dir </> getRGLBuildSubDir mode)|mode<-modes]
|
sequence_ [copyAll (show mode) (getRGLBuildDir (snd bi) mode) (inst_gf_lib_dir </> getRGLBuildSubDir mode)|mode<-modes]
|
||||||
|
|
||||||
|
copyRGL :: [String] -> CopyFlags -> (PackageDescription, LocalBuildInfo) -> IO ()
|
||||||
copyRGL args flags bi = do
|
copyRGL args flags bi = do
|
||||||
let modes = getOptMode args
|
let modes = getOptMode args
|
||||||
dest = case copyDest flags of
|
dest = case copyDest flags of
|
||||||
@@ -154,11 +154,14 @@ copyRGL args flags bi = do
|
|||||||
copyAll "prelude" (rgl_dst_dir (snd bi) </> "prelude") (inst_gf_lib_dir </> "prelude")
|
copyAll "prelude" (rgl_dst_dir (snd bi) </> "prelude") (inst_gf_lib_dir </> "prelude")
|
||||||
sequence_ [copyAll (show mode) (getRGLBuildDir (snd bi) mode) (inst_gf_lib_dir </> getRGLBuildSubDir mode)|mode<-modes]
|
sequence_ [copyAll (show mode) (getRGLBuildDir (snd bi) mode) (inst_gf_lib_dir </> getRGLBuildSubDir mode)|mode<-modes]
|
||||||
|
|
||||||
|
copyAll :: String -> FilePath -> FilePath -> IO ()
|
||||||
copyAll s from to = do
|
copyAll s from to = do
|
||||||
putStrLn $ "Installing [" ++ s ++ "] " ++ to
|
putStrLn $ "Installing [" ++ s ++ "] " ++ to
|
||||||
createDirectoryIfMissing True to
|
createDirectoryIfMissing True to
|
||||||
mapM_ (\file -> copyFile (from </> file) (to </> file)) =<< list_files from
|
mapM_ (\file -> copyFile (from </> file) (to </> file)) =<< listDirectory from
|
||||||
|
|
||||||
{-
|
{-
|
||||||
|
sdistRGL :: PackageDescription -> Maybe LocalBuildInfo -> UserHooks -> SDistFlags -> IO ()
|
||||||
sdistRGL pkg mb_lbi hooks flags = do
|
sdistRGL pkg mb_lbi hooks flags = do
|
||||||
paths <- getRGLFiles rgl_src_dir []
|
paths <- getRGLFiles rgl_src_dir []
|
||||||
let pkg' = pkg{dataFiles=paths}
|
let pkg' = pkg{dataFiles=paths}
|
||||||
@@ -180,15 +183,17 @@ sdistRGL pkg mb_lbi hooks flags = do
|
|||||||
-- | Cabal doesn't know how to correctly create the source distribution, so
|
-- | Cabal doesn't know how to correctly create the source distribution, so
|
||||||
-- we print an error message with the correct instructions when someone tries
|
-- we print an error message with the correct instructions when someone tries
|
||||||
-- `cabal sdist`.
|
-- `cabal sdist`.
|
||||||
|
sdistError :: PackageDescription -> Maybe LocalBuildInfo -> UserHooks -> SDistFlags -> IO ()
|
||||||
sdistError _ _ _ _ = fail "Error: Use `make sdist` to create the source distribution file"
|
sdistError _ _ _ _ = fail "Error: Use `make sdist` to create the source distribution file"
|
||||||
|
|
||||||
rgl_src_dir = "lib" </> "src"
|
rgl_src_dir = "lib" </> "src"
|
||||||
rgl_dst_dir lbi = buildDir lbi </> "rgl"
|
rgl_dst_dir lbi = buildDir lbi </> "rgl"
|
||||||
|
|
||||||
-- the languages have long directory names and short ISO codes (3 letters)
|
-- the languages have long directory names and short ISO codes (3 letters)
|
||||||
-- we also give the decodings for postprocessing linearizations, as long as grammars
|
-- we also give the decodings for postprocessing linearizations, as long as grammars
|
||||||
-- don't support all flags needed; they are used in tests
|
-- don't support all flags needed; they are used in tests
|
||||||
|
|
||||||
|
langsCoding :: [((String, String), String)]
|
||||||
langsCoding = [
|
langsCoding = [
|
||||||
(("afrikaans","Afr"),""),
|
(("afrikaans","Afr"),""),
|
||||||
(("amharic", "Amh"),""),
|
(("amharic", "Amh"),""),
|
||||||
@@ -233,6 +238,7 @@ langsCoding = [
|
|||||||
(("urdu", "Urd"),"")
|
(("urdu", "Urd"),"")
|
||||||
]
|
]
|
||||||
|
|
||||||
|
langs :: [(String, String)]
|
||||||
langs = map fst langsCoding
|
langs = map fst langsCoding
|
||||||
|
|
||||||
-- default set of languages to compile
|
-- default set of languages to compile
|
||||||
@@ -242,7 +248,7 @@ langs = map fst langsCoding
|
|||||||
langsLang = langs -- `except` ["Amh","Ara","Lat","Tur"]
|
langsLang = langs -- `except` ["Amh","Ara","Lat","Tur"]
|
||||||
--langsLang = langs `only` ["Fin"] --test
|
--langsLang = langs `only` ["Fin"] --test
|
||||||
|
|
||||||
-- languagues that have notpresent marked
|
-- languages that have notpresent marked
|
||||||
langsPresent = langsLang `except` ["Afr","Chi","Eus","Gre","Heb","Ice","Jpn","Mlt","Mon","Nep","Pes","Snd","Tha","Thb","Est"]
|
langsPresent = langsLang `except` ["Afr","Chi","Eus","Gre","Heb","Ice","Jpn","Mlt","Mon","Nep","Pes","Snd","Tha","Thb","Est"]
|
||||||
|
|
||||||
-- languages for which to compile Try
|
-- languages for which to compile Try
|
||||||
@@ -265,8 +271,11 @@ langsPGF = langsLang `except` ["Ara","Hin","Ron","Tha"]
|
|||||||
-- languages for which Compatibility exists (to be extended)
|
-- languages for which Compatibility exists (to be extended)
|
||||||
langsCompat = langsLang `only` ["Cat","Eng","Fin","Fre","Ita","Lav","Spa","Swe"]
|
langsCompat = langsLang `only` ["Cat","Eng","Fin","Fre","Ita","Lav","Spa","Swe"]
|
||||||
|
|
||||||
|
gfc :: Info -> [Mode] -> [Char] -> [[Char]] -> IO ()
|
||||||
gfc bi modes summary files =
|
gfc bi modes summary files =
|
||||||
parallel_ [gfcn bi mode summary files | mode<-modes]
|
parallel_ [gfcn bi mode summary files | mode<-modes]
|
||||||
|
|
||||||
|
gfcn :: Info -> Mode -> [Char] -> [[Char]] -> IO ()
|
||||||
gfcn bi mode summary files = do
|
gfcn bi mode summary files = do
|
||||||
let dir = getRGLBuildDir (lbi bi) mode
|
let dir = getRGLBuildDir (lbi bi) mode
|
||||||
preproc = case mode of
|
preproc = case mode of
|
||||||
@@ -276,6 +285,7 @@ gfcn bi mode summary files = do
|
|||||||
putStrLn $ "Compiling [" ++ show mode ++ "] " ++ summary
|
putStrLn $ "Compiling [" ++ show mode ++ "] " ++ summary
|
||||||
run_gfc bi (["-s", "-no-pmcfg", preproc, "--gfo-dir="++dir] ++ files)
|
run_gfc bi (["-s", "-no-pmcfg", preproc, "--gfo-dir="++dir] ++ files)
|
||||||
|
|
||||||
|
gf :: Info -> String -> [String] -> IO ()
|
||||||
gf bi comm files = do
|
gf bi comm files = do
|
||||||
putStrLn $ "Reading " ++ unwords files
|
putStrLn $ "Reading " ++ unwords files
|
||||||
let gf = default_gf (lbi bi)
|
let gf = default_gf (lbi bi)
|
||||||
@@ -284,8 +294,8 @@ gf bi comm files = do
|
|||||||
out <- readProcess gf ("-s":files) comm
|
out <- readProcess gf ("-s":files) comm
|
||||||
putStrLn out
|
putStrLn out
|
||||||
|
|
||||||
demos abstr ls = "gr -number=100 | l -treebank " ++ unlexer abstr ls ++
|
demos :: String -> [(String, String)] -> String
|
||||||
" | ps -to_html | wf -file=resdemo.html"
|
demos abstr ls = "gr -number=100 | l -treebank " ++ unlexer abstr ls ++ " | ps -to_html | wf -file=resdemo.html"
|
||||||
|
|
||||||
lang (lla,la) = rgl_src_dir </> lla </> ("All" ++ la ++ ".gf")
|
lang (lla,la) = rgl_src_dir </> lla </> ("All" ++ la ++ ".gf")
|
||||||
compat (lla,la) = rgl_src_dir </> lla </> ("Compatibility" ++ la ++ ".gf")
|
compat (lla,la) = rgl_src_dir </> lla </> ("Compatibility" ++ la ++ ".gf")
|
||||||
@@ -297,9 +307,13 @@ syntax (lla,la) = rgl_src_dir </> "api" </> ("Syntax" ++ la ++ ".gf")
|
|||||||
symbolic (lla,la) = rgl_src_dir </> "api" </> ("Symbolic" ++ la ++ ".gf")
|
symbolic (lla,la) = rgl_src_dir </> "api" </> ("Symbolic" ++ la ++ ".gf")
|
||||||
parse (lla,la) = rgl_src_dir </> "parse" </> ("Parse" ++ la ++ ".gf")
|
parse (lla,la) = rgl_src_dir </> "parse" </> ("Parse" ++ la ++ ".gf")
|
||||||
|
|
||||||
|
except :: (Eq b) => [(a, b)] -> [b] -> [(a, b)]
|
||||||
except ls es = filter (flip notElem es . snd) ls
|
except ls es = filter (flip notElem es . snd) ls
|
||||||
only ls es = filter (flip elem es . snd) ls
|
|
||||||
|
|
||||||
|
only :: (Eq b) => [(a, b)] -> [b] -> [(a, b)]
|
||||||
|
only ls es = filter (flip elem es . snd) ls
|
||||||
|
|
||||||
|
getOptMode :: [String] -> [Mode]
|
||||||
getOptMode args =
|
getOptMode args =
|
||||||
if null explicit_modes
|
if null explicit_modes
|
||||||
then default_modes
|
then default_modes
|
||||||
@@ -312,6 +326,7 @@ getOptMode args =
|
|||||||
have mode = mode `elem` args
|
have mode = mode `elem` args
|
||||||
|
|
||||||
-- list of languages overriding the definitions above
|
-- list of languages overriding the definitions above
|
||||||
|
getOptLangs :: [(String, String)] -> [String] -> [(String, String)]
|
||||||
getOptLangs defaultLangs args =
|
getOptLangs defaultLangs args =
|
||||||
case [ls | arg <- args,
|
case [ls | arg <- args,
|
||||||
let (f,ls) = splitAt (length langs_prefix) arg,
|
let (f,ls) = splitAt (length langs_prefix) arg,
|
||||||
@@ -328,6 +343,7 @@ getOptLangs defaultLangs args =
|
|||||||
then findLangs langs [l]++ls
|
then findLangs langs [l]++ls
|
||||||
else ls
|
else ls
|
||||||
|
|
||||||
|
getRGLBuildSubDir :: Mode -> String
|
||||||
getRGLBuildSubDir mode =
|
getRGLBuildSubDir mode =
|
||||||
case mode of
|
case mode of
|
||||||
AllTenses -> "alltenses"
|
AllTenses -> "alltenses"
|
||||||
@@ -337,6 +353,7 @@ getRGLBuildSubDir mode =
|
|||||||
getRGLBuildDir :: LocalBuildInfo -> Mode -> FilePath
|
getRGLBuildDir :: LocalBuildInfo -> Mode -> FilePath
|
||||||
getRGLBuildDir lbi mode = rgl_dst_dir lbi </> getRGLBuildSubDir mode
|
getRGLBuildDir lbi mode = rgl_dst_dir lbi </> getRGLBuildSubDir mode
|
||||||
|
|
||||||
|
getRGLCommands :: [String] -> [RGLCommand]
|
||||||
getRGLCommands args =
|
getRGLCommands args =
|
||||||
let cmds0 = [cmd | arg <- args,
|
let cmds0 = [cmd | arg <- args,
|
||||||
let (prefix,name) = splitAt (length rgl_prefix) arg,
|
let (prefix,name) = splitAt (length rgl_prefix) arg,
|
||||||
@@ -350,6 +367,7 @@ getRGLCommands args =
|
|||||||
langs_prefix = "langs="
|
langs_prefix = "langs="
|
||||||
rgl_prefix = "rgl-"
|
rgl_prefix = "rgl-"
|
||||||
|
|
||||||
|
unlexer :: String -> [(String, String)] -> String
|
||||||
unlexer abstr ls =
|
unlexer abstr ls =
|
||||||
"-unlexer=\\\"" ++ unwords
|
"-unlexer=\\\"" ++ unwords
|
||||||
[abstr ++ la ++ "=" ++ unl |
|
[abstr ++ la ++ "=" ++ unl |
|
||||||
@@ -366,28 +384,16 @@ run_gfc bi args =
|
|||||||
gf = default_gf (lbi bi)
|
gf = default_gf (lbi bi)
|
||||||
execute gf args'
|
execute gf args'
|
||||||
|
|
||||||
|
-- | Get path to locally-built gf
|
||||||
default_gf :: LocalBuildInfo -> FilePath
|
default_gf :: LocalBuildInfo -> FilePath
|
||||||
default_gf lbi = buildDir lbi </> exeName' </> exeNameReal
|
default_gf lbi = buildDir lbi </> exeName' </> exeNameReal
|
||||||
where
|
where
|
||||||
exeName' = "gf"
|
exeName' = "gf"
|
||||||
exeNameReal = exeName' <.> exeExtension
|
exeNameReal = exeName' <.> exeExtension
|
||||||
{- --old solution, could pick the wrong executable if there is more than one
|
|
||||||
exeName' = (exeName . head . executables) pkg
|
|
||||||
exeNameReal = exeName' <.> (if null $ takeExtension exeName' then exeExtension else "")
|
|
||||||
-}
|
|
||||||
|
|
||||||
-- | Only update the file if contents has changed
|
|
||||||
updateFile path new =
|
|
||||||
do old <- tryIOE $ readFile path
|
|
||||||
when (Right new/=old) $ seq (either (const 0) length old) $
|
|
||||||
writeFile path new
|
|
||||||
|
|
||||||
-- | List files, excluding "." and ".."
|
|
||||||
list_files path = filter ((/=".").take 1) `fmap` getDirectoryContents path
|
|
||||||
|
|
||||||
|
|
||||||
-- | For parallel RGL module compilation
|
-- | For parallel RGL module compilation
|
||||||
-- Unfortunately, this has no effect unless Setup.hs is compiled with -threaded
|
-- Unfortunately, this has no effect unless Setup.hs is compiled with -threaded
|
||||||
|
parallel_ :: (Foldable t, Monad m) => t (m a) -> m ()
|
||||||
parallel_ ms = sequence_ ms {-
|
parallel_ ms = sequence_ ms {-
|
||||||
do c <- newChan
|
do c <- newChan
|
||||||
ts <- sequence [ forkIO (m >> writeChan c ()) | m <- ms]
|
ts <- sequence [ forkIO (m >> writeChan c ()) | m <- ms]
|
||||||
|
|||||||
10
gf.cabal
10
gf.cabal
@@ -1,7 +1,7 @@
|
|||||||
name: gf
|
name: gf
|
||||||
version: 3.9-git
|
version: 3.9-git
|
||||||
|
|
||||||
cabal-version: >= 1.20
|
cabal-version: >= 1.24
|
||||||
build-type: Custom
|
build-type: Custom
|
||||||
license: OtherLicense
|
license: OtherLicense
|
||||||
license-file: LICENSE
|
license-file: LICENSE
|
||||||
@@ -39,6 +39,14 @@ data-files:
|
|||||||
www/translator/*.css
|
www/translator/*.css
|
||||||
www/translator/*.js
|
www/translator/*.js
|
||||||
|
|
||||||
|
custom-setup
|
||||||
|
setup-depends:
|
||||||
|
base,
|
||||||
|
Cabal >=1.4.0.0,
|
||||||
|
directory >=1.2.5.0,
|
||||||
|
filepath,
|
||||||
|
process >=1.0.1.1
|
||||||
|
|
||||||
source-repository head
|
source-repository head
|
||||||
type: git
|
type: git
|
||||||
location: https://github.com/GrammaticalFramework/GF.git
|
location: https://github.com/GrammaticalFramework/GF.git
|
||||||
|
|||||||
Reference in New Issue
Block a user