content: {-# 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,6]
  shortversion = show (numversion `div` 100) ++ "." ++ show (numversion `mod` 100)
  version = shortversion ++ if ispre then "pre" ++ show pre else ""
  numversion = 125
  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
  