lhs2tex-1.23: Setup.hs
{-# LANGUAGE CPP #-}
{-# LANGUAGE PackageImports #-}
#if !defined(MIN_VERSION_Cabal)
# define MIN_VERSION_Cabal(x,y,z) 0
#endif
import Distribution.Simple.Setup (CopyDest(..),ConfigFlags(..),BuildFlags(..),
CopyFlags(..),RegisterFlags(..),InstallFlags(..),
defaultRegisterFlags,fromFlagOrDefault,Flag(..),
defaultCopyFlags)
import Distribution.Simple (UserHooks(..), simpleUserHooks, defaultMainWithHooks)
import Distribution.Simple.LocalBuildInfo
(LocalBuildInfo(..),absoluteInstallDirs)
import Distribution.PackageDescription (PackageDescription(..))
import Distribution.Simple.InstallDirs
(InstallDirs(..))
import Distribution.Simple.Program
(Program(..),ConfiguredProgram(..),
ProgramLocation(..),simpleProgram,lookupProgram,
runDbProgram)
import Distribution.Simple.Program.Db (ProgramDb)
import Distribution.Simple.Utils
import Distribution.Verbosity
import Data.Char (isSpace, showLitChar)
import Data.List (isSuffixOf,isPrefixOf)
import Data.Maybe (listToMaybe,isJust)
import Data.Version
import Control.Exception (try)
import Control.Monad (when,unless)
import "regex-compat" Text.Regex (matchRegex,matchRegexAll,mkRegex,mkRegexWithOpts,subRegex)
import Text.ParserCombinators.ReadP (readP_to_S)
import System.Exit (ExitCode)
import System.IO (hGetContents,hClose,hPutStr,stderr)
import System.Process (runInteractiveProcess,waitForProcess)
import System.Directory
import System.Info (os)
lhs2tex = "lhs2TeX"
minPolytableVersion = [0,8,2]
shortversion = show (numversion `div` 100) ++ "." ++ show (numversion `mod` 100)
version = shortversion ++ if ispre then "pre" ++ show pre else ""
numversion = 122
ispre = False
pre = 1
main = defaultMainWithHooks lhs2texHooks
sep = if isWindows then ";" else ":"
lhs2texBuildInfoFile :: FilePath
lhs2texBuildInfoFile = "." `joinFileName` ".setup-lhs2tex-config"
generatedFiles = ["src" `joinFileName` "Version.lhs",
"lhs2TeX.1",
"doc" `joinFileName` "InteractiveHugs.lhs",
"doc" `joinFileName` "InteractivePre.lhs"]
data Lhs2texBuildInfo =
Lhs2texBuildInfo { installPolyTable :: Maybe String,
rebuildDocumentation :: Bool }
deriving (Show, Read)
lhs2texHooks = simpleUserHooks
{ hookedPrograms = [simpleProgram "hugs",
simpleProgram "kpsewhich",
simpleProgram "pdflatex",
simpleProgram "mktexlsr"],
postConf = lhs2texPostConf,
postBuild = lhs2texPostBuild,
postCopy = lhs2texPostCopy,
postInst = lhs2texPostInst,
regHook = lhs2texRegHook,
cleanHook = lhs2texCleanHook
}
lhs2texPostConf a cf pd lbi =
do let v = fromFlagOrDefault normal (configVerbosity cf)
-- check polytable
tmft <- do let kpseExists = lookupProgram (simpleProgram "kpsewhich") (withPrograms lbi)
case kpseExists of
Nothing -> return Nothing
Just _ -> do (_,b,_) <- runKpseWhichVar "TEXMFLOCAL"
b <- return . stripQuotes . stripNewlines $ b
ex <- return (not . all isSpace $ b) -- or check if directory exists?
b <- if ex then return b
else do (_,b,_) <- (runKpseWhichVar "TEXMFMAIN")
return . stripQuotes . stripNewlines $ b
if not . all isSpace $ b -- or check if directory exists?
then return (Just b)
else return Nothing
i <- case tmft of
Just b -> do (_,p,_) <- runKpseWhich "polytable.sty"
p <- return . stripNewlines $ p
ex <- doesFileExist p
nec <- if ex then do info v $ "Found polytable package at: " ++ p
x <- readFile p
let vp = do vs <- matchRegex (mkRegexWithOpts " v(.*) .polytable. package" True True) x
listToMaybe [ r | v <- vs, (r,"") <- readP_to_S parseVersion v ]
let (sv,nec) = case vp of
Just n -> (showVersion n,versionBranch n < minPolytableVersion)
Nothing -> ("unknown",True)
info v $ "Package polytable version: " ++ sv
return nec
else return True
info v $ "Package polytable installation necessary: " ++ showYesNo nec
when nec $ info v $ "Using texmf tree at: " ++ b
return (if nec then Just b else Nothing)
Nothing -> do warn v "No texmf tree found, polytable package cannot be installed"
return Nothing
-- check documentation
ex <- doesFileExist $ "doc" `joinFileName` "Guide2.dontbuild"
r <- if ex then do info v "Documentation will not be rebuilt unless you remove the file \"doc/Guide2.dontbuild\""
return False
else do let mProg = lookupProgram (simpleProgram "pdflatex") (withPrograms lbi)
case mProg of
Nothing -> info v "Documentation cannot be rebuilt without pdflatex" >> return False
Just _ -> return True
unless r $ info v $ "Using pre-built documentation"
writePersistLhs2texBuildConfig (Lhs2texBuildInfo { installPolyTable = i, rebuildDocumentation = r })
mapM_ (\f -> do info v $ "Creating " ++ f
let hugsExists = lookupProgram (simpleProgram "hugs") (withPrograms lbi)
hugs <- case hugsExists of
Nothing -> return ""
Just _ -> fmap fst (getProgram "hugs" (withPrograms lbi))
let lhs2texDir = buildDir lbi `joinFileName` lhs2tex
let lhs2texBin = lhs2texDir `joinFileName` lhs2tex
readFile (f ++ ".in") >>= return .
-- these paths could contain backslashes, so we
-- need to escape them.
replace "@prefix@" (escapeChars $ prefix (absoluteInstallDirs pd lbi NoCopyDest)) .
replace "@stydir@" (escapeChars $ datadir (absoluteInstallDirs pd lbi NoCopyDest)) .
replace "@LHS2TEX@" lhs2texBin .
replace "@HUGS@" hugs .
replace "@VERSION@" version .
replace "@SHORTVERSION@" shortversion .
replace "@NUMVERSION@" (show numversion) .
replace "@SEP@" sep .
replace "@PRE@" (show pre) >>= writeFile f)
generatedFiles
where runKpseWhich v = runCommandProgramConf silent "kpsewhich" (withPrograms lbi) [v]
runKpseWhichVar v = runKpseWhich $ "-expand-var='$" ++ v ++ "'"
lhs2texPostBuild a bf@(BuildFlags { buildVerbosity = vf }) pd lbi =
do let v = fromFlagOrDefault normal vf
ebi <- getPersistLhs2texBuildConfig
let lhs2texDir = buildDir lbi `joinFileName` lhs2tex
let lhs2texBin = lhs2texDir `joinFileName` lhs2tex
let lhs2texDocDir = lhs2texDir `joinFileName` "doc"
callLhs2tex v lbi ["--code", "lhs2TeX.sty.lit"] (lhs2texDir `joinFileName` "lhs2TeX.sty")
callLhs2tex v lbi ["--code", "lhs2TeX.fmt.lit"] (lhs2texDir `joinFileName` "lhs2TeX.fmt")
createDirectoryIfMissing True lhs2texDocDir
if rebuildDocumentation ebi then lhs2texBuildDocumentation a bf pd lbi
else copyFileVerbose v ("doc" `joinFileName` "Guide2.pdf") (lhs2texDocDir `joinFileName` "Guide2.pdf")
lhs2texBuildDocumentation a (BuildFlags { buildVerbosity = vf }) pd lbi =
do let v = fromFlagOrDefault normal vf
let lhs2texDir = buildDir lbi `joinFileName` lhs2tex
let lhs2texBin = lhs2texDir `joinFileName` lhs2tex
let lhs2texDocDir = lhs2texDir `joinFileName` "doc"
snippets <- do guide <- readFile $ "doc" `joinFileName` "Guide2.lhs"
let s = matchRegexRepeatedly (mkRegexWithOpts "^.*input\\{(.*)\\}.*$" True True) guide
return s
mapM_ (\s -> do let snippet = "doc" `joinFileName` (s ++ ".lhs")
c <- readFile $ snippet
let inc = maybe ["poly"] id (matchRegex (mkRegexWithOpts "^%include (.*)\\.fmt" True True) c)
-- rewrite the path to ghc/hugs, and to the preprocessor
writeFile (lhs2texDir `joinFileName` snippet)
( -- replace "^%options ghc" "%options ghc" .
-- replace "^%options hugs" "%options hugs" .
-- TODO: replace or replaceEscaped
replace "-pgmF \\.\\./lhs2TeX" ("-pgmF " ++ lhs2texBin ++ " -optF-Pdoc" ++ sep) $ c )
let incToStyle ["verbatim"] = "verb"
incToStyle ["stupid"] = "math"
incToStyle ["tex"] = "poly"
incToStyle ["polytt"] = "poly"
incToStyle ["typewriter"] = "tt"
incToStyle [x] = x
incToStyle [] = "poly"
callLhs2tex v lbi ["--" ++ incToStyle inc , "-Pdoc" ++ sep, lhs2texDir `joinFileName` snippet]
(lhs2texDocDir `joinFileName` s ++ ".tex")
) snippets
callLhs2tex v lbi ["--poly" , "-Pdoc" ++ sep, "-Psrc" ++ sep, "doc" `joinFileName` "Guide2.lhs"]
(lhs2texDocDir `joinFileName` "Guide2.tex")
copyFileVerbose v ("polytable" `joinFileName` "polytable.sty") (lhs2texDocDir `joinFileName` "polytable.sty")
copyFileVerbose v ("polytable" `joinFileName` "lazylist.sty") (lhs2texDocDir `joinFileName` "lazylist.sty")
d <- getCurrentDirectory
setCurrentDirectory lhs2texDocDir
-- call pdflatex as long as necessary
let loop = do runDbProgram v (simpleProgram "pdflatex") (withPrograms lbi) ["Guide2.tex"]
x <- readFile "Guide2.log"
case matchRegex (mkRegexWithOpts "Warning.*Rerun" True True) x of
Just _ -> loop
Nothing -> return ()
loop
setCurrentDirectory d
lhs2texPostCopy a (CopyFlags { copyDest = cdf, copyVerbosity = vf }) pd lbi =
do let v = fromFlagOrDefault normal vf
let cd = fromFlagOrDefault NoCopyDest cdf
ebi <- getPersistLhs2texBuildConfig
let dataPref = datadir (absoluteInstallDirs pd lbi cd)
createDirectoryIfMissing True dataPref
let lhs2texDir = buildDir lbi `joinFileName` lhs2tex
-- lhs2TeX.{fmt,sty}
mapM_ (\f -> installOrdinaryFile v (lhs2texDir `joinFileName` f) (dataPref `joinFileName` f))
["lhs2TeX.fmt","lhs2TeX.sty"]
-- lhs2TeX library
fmts <- fmap (filter (".fmt" `isSuffixOf`)) (getDirectoryContents "Library")
mapM_ (\f -> installOrdinaryFile v ("Library" `joinFileName` f) (dataPref `joinFileName` f))
fmts
-- documentation difficult due to lack of docdir
let lhs2texDocDir = lhs2texDir `joinFileName` "doc"
let docDir = if isWindows
then dataPref `joinFileName` "Documentation"
else docdir (absoluteInstallDirs pd lbi cd) `joinFileName` "doc"
let manDir = if isWindows
then dataPref `joinFileName` "Documentation"
else datadir (absoluteInstallDirs pd lbi cd) `joinFileName` ".." `joinFileName` "man" `joinFileName` "man1"
createDirectoryIfMissing True docDir
installOrdinaryFile v (lhs2texDocDir `joinFileName` "Guide2.pdf") (docDir `joinFileName` "Guide2.pdf")
when (not isWindows) $
do createDirectoryIfMissing True manDir
installOrdinaryFile v ("lhs2TeX.1") (manDir `joinFileName` "lhs2TeX.1")
-- polytable
case (installPolyTable ebi) of
Just texmf -> do let texmfDir = texmf
ptDir = texmfDir `joinFileName` "tex" `joinFileName` "latex"
`joinFileName` "polytable"
createDirectoryIfMissing True ptDir
stys <- fmap (filter (".sty" `isSuffixOf`))
(getDirectoryContents "polytable")
mapM_ (\f -> installOrdinaryFile v ("polytable" `joinFileName` f)
(ptDir `joinFileName` f))
stys
Nothing -> return ()
lhs2texPostInst a (InstallFlags { installPackageDB = db, installVerbosity = v }) pd lbi =
do lhs2texPostCopy a (defaultCopyFlags { copyDest = Flag NoCopyDest, copyVerbosity = v }) pd lbi
lhs2texRegHook pd lbi Nothing (defaultRegisterFlags { regPackageDB = db, regVerbosity = v })
lhs2texRegHook pd lbi _ (RegisterFlags { regVerbosity = vf }) =
do let v = fromFlagOrDefault normal vf
ebi <- getPersistLhs2texBuildConfig
when (isJust . installPolyTable $ ebi) $
do runDbProgram v (simpleProgram "mktexlsr") (withPrograms lbi) []
return ()
lhs2texCleanHook pd lbi v pshs =
do cleanHook simpleUserHooks pd lbi v pshs
tryIO $ removeFile lhs2texBuildInfoFile
mapM_ (tryIO . removeFile) generatedFiles
matchRegexRepeatedly re str =
case matchRegexAll re str of
Just (_,_,r,[s]) -> s : matchRegexRepeatedly re r
Nothing -> []
replace re t x = subRegex (mkRegexWithOpts re True True) x (escapeRegex t)
where
-- subRegex requires us to escape backslashes
escapeRegex [] = []
escapeRegex ('\\':xs) = '\\':'\\': escapeRegex xs
escapeRegex (x:xs) = x : escapeRegex xs
escapeChars :: String -> String
escapeChars t = foldr showLitChar [] t
showYesNo :: Bool -> String
showYesNo p | p = "yes"
| otherwise = "no"
stripNewlines :: String -> String
stripNewlines = filter (/='\n')
stripQuotes :: String -> String
stripQuotes ('\'':s@(_:_)) = init s
stripQuotes x = x
callLhs2tex v lbi params outf =
do let lhs2texDir = buildDir lbi `joinFileName` lhs2tex
let lhs2texBin = lhs2texDir `joinFileName` lhs2tex
let args = [ "-P" ++ lhs2texDir ++ sep ]
++ [ "-o" ++ outf ]
++ (if v == deafening then ["-v"] else [])
++ params
(ex,_,err) <- runCommand v lhs2texBin args
hPutStr stderr (unlines . lines $ err)
maybeExit (return ex)
runCommandProgramConf :: Verbosity -- ^ verbosity
-> String -- ^ program name
-> ProgramDb -- ^ lookup up the program here
-> [String] -- ^ args
-> IO (ExitCode,String,String)
runCommandProgramConf v progName programConf extraArgs =
do (prog,args) <- getProgram progName programConf
runCommand v prog (args ++ extraArgs)
getProgram :: String -> ProgramDb -> IO (String, [String])
getProgram progName programConf =
do let mProg = lookupProgram (simpleProgram progName) programConf
case mProg of
Just (ConfiguredProgram { programLocation = UserSpecified p,
programDefaultArgs = args }) -> return (p,args)
Just (ConfiguredProgram { programLocation = FoundOnSystem p,
programDefaultArgs = args }) -> return (p,args)
_ -> (die' silent (progName ++ " command not found"))
-- | Run a command in a specific environment and return the output and errors.
runCommandInEnv :: Verbosity -- ^ verbosity
-> String -- ^ the command
-> [String] -- ^ args
-> [(String,String)] -- ^ the environment
-> IO (ExitCode,String,String)
runCommandInEnv v cmd args env =
do when (v >= verbose) $ putStrLn (cmd ++ concatMap (' ':) args)
let env' = if null env then Nothing else Just env
(cin,cout,cerr,pid) <- runInteractiveProcess cmd args Nothing env'
hClose cin
out <- hGetContents cout
err <- hGetContents cerr
stringSeq out (hClose cout)
stringSeq err (hClose cerr)
exit <- waitForProcess pid
return (exit,out,err)
-- | Run a command and return the output and errors.
runCommand :: Verbosity -- ^ verbosity
-> String -- ^ the command
-> [String] -- ^ args
-> IO (ExitCode,String,String)
runCommand v cmd args = runCommandInEnv v cmd args []
-- | Completely evaluates a string.
stringSeq :: String -> b -> b
stringSeq [] c = c
stringSeq (x:xs) c = stringSeq xs c
getPersistLhs2texBuildConfig :: IO Lhs2texBuildInfo
getPersistLhs2texBuildConfig = do
e <- doesFileExist lhs2texBuildInfoFile
let dieMsg = "error reading " ++ lhs2texBuildInfoFile ++ "; run \"setup configure\" command?\n"
when (not e) (die' silent dieMsg)
str <- readFile lhs2texBuildInfoFile
case reads str of
[(bi,_)] -> return bi
_ -> die' silent dieMsg
writePersistLhs2texBuildConfig :: Lhs2texBuildInfo -> IO ()
writePersistLhs2texBuildConfig lbi = do
writeFile lhs2texBuildInfoFile (show lbi)
tryIO :: IO a -> IO (Either IOError a)
tryIO = try
-- HACKS because the Cabal API isn't sufficient:
-- Distribution.Compat.FilePath is supposed to be hidden in future
-- versions, so we need our own version of it:
joinFileName :: String -> String -> FilePath
joinFileName "" fname = fname
joinFileName "." fname = fname
joinFileName dir "" = dir
joinFileName dir fname
| isPathSeparator (last dir) = dir++fname
| otherwise = dir++pathSeparator:fname
where
isPathSeparator :: Char -> Bool
isPathSeparator | isWindows = ( `elem` "/\\" )
| otherwise = ( == '/' )
pathSeparator | isWindows = '\\'
| otherwise = '/'
-- It would be nice if there'd be a predefined way to detect this
isWindows = "mingw" `isPrefixOf` os || "win" `isPrefixOf` os
#if !(MIN_VERSION_Cabal(2,0,0))
die' :: Verbosity -> String -> IO a
die' _ = die
#endif