1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383
|
{-# 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 = 124
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
|