hg-buildpackage-1.0.1: hg-importdsc.hs

{- Copyright (c) 2007 John Goerzen <jgoerzen@complete.org>
   Please see the COPYRIGHT file -}

import System.Console.GetOpt
import System.Console.GetOpt.Utils
import Utils
import HSH
import Text.Printf
import Control.Monad
import System.Path
import Types
import System.Posix.Env

args = [Option ['v'] ["verbose"] (NoArg "v") "Enable verbose mode"]
helpinfo = "Usage:\n\
\hg-importdsc [-v] dscname\n\
\\n\
\The source package will be imported into ../${package}.upstream (if it has\n\
\an upstream component) and the current working directory\n\
\\n\
\Where:\n\
\\n\
\  dscname is the name of a dsc file to import\n"

crashusage = die 5 $ usageInfo helpinfo args

main = 
  do (args, files) <- parseCmdLine RequireOrder args helpinfo
     let isverbose = ("v" `elem` args)
     when isverbose setverbose
     let verbargs = if isverbose then ["-v"] else []
     (dscname) <- case files of
                    [x] -> return x
                    _ -> crashusage

     package <- runSL $ catFrom [dscname] -|- dsc2control -|- getcontrolsource
     version <- runSL $ catFrom [dscname] -|- dsc2control -|- 
                getcontrolversion

     let tag = Tag "DEBIAN" package version
               
     assertvalidhg "."
     hastag tag >>= (flip when) (die 0 $
            printf "Version %s already exists; skipping all imports." version)

     istagok tag >>= (flip unless) (die 1 $
            printf "Verion %s is not newer than all Debian versions; aborting."
                   version)

     hasupstream <- dschasupstream dscname
     when hasupstream (procupstream verbargs dscname tag)

     putStrLn $ " *** Processing Debian source tree for " ++ dscname

     lines <- runSL $ "hg status" -|- wcL
     when (lines /= "0") $ die 1 $
          "Error: Working directory has uncommitted changes.  Aborting\n\
          \before merge for safety."

     when hasupstream (pullupstream dscname tag)

     brackettmpdir "../,,hg-importdsc-XXXXXX" (procdsc verbargs dscname tag)

procupstream verbargs dscname tag =
    do upstreamrepo <- readlinkabs (printf "../%s.upstream" (tag2pkg tag))
       assertvalidhg upstreamrepo
       v $ "Upstream detected at " ++ upstreamrepo

       upstreamname <- runSL (dscgetfile dscname "\\.orig\\.tar\\.gz$")
       let upstreamfn = dirname dscname ++ "/" ++ upstreamname

       putStrLn $ " *** Processing upstream file " ++ upstreamfn
       runIO ("hg-importorig", verbargs ++ [upstreamfn, tag2pkg tag,
              tag2upsver tag])
       putStrLn $ " *** Done processing upstream file " ++ upstreamfn

pullupstream dscname tag =
    do upstreamrepo <- readlinkabs (printf "../%s.upstream" (tag2pkg tag))
       patchcount <- runSL $ ("hg", ["-q", "incoming", upstreamrepo]) -|- wcL
       if patchcount == "0"
          then putStrLn "No patches to pull from upstream; skipping this step."
          else do runIO $ ("hg", ["pull", upstreamrepo])
                  procpull upstreamrepo tag

procpull upstreamrepo tag =
    do heads <- runSL $ "hg -q heads" -|- wcL
       if heads == "2"
          then do putEnv $ "HGMERGE=" ++ hglibdir ++ "/hgmerge-debupstream"
                  runIO ("hg", ["merge", tag2upsstr tag ++ "_TAG"])
                  runIO ("hg", ["commit", "-m", "Merged upstream " ++
                                tag2upsver tag ++ " into Debian branch"])
          else runIO "hg update"
                              
procdsc verbargs dscname tag tmpdir =
    do absname <- readlinkabs dscname
       v $ "Unpacking " ++ absname ++ " into " ++ tmpdir
       bracketCWD tmpdir $ runIO $ ("dpkg-source", ["-x", absname])
       
       let srcdir = printf "%s/%s-%s" tmpdir (tag2pkg tag) (tag2upsver tag)
       v $ "Importing directory " ++ srcdir
       
       runIO $ ("hg_load_dirs", verbargs ++
                ["--summary=Import Debian " ++ (tag2pkg tag) ++ " " ++
                (tag2ver tag), srcdir])
       runIO $ ("hg", ["tag", show tag])