{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable, RecordWildCards #-}
import qualified Data.Map as M
import qualified Data.Set as S
import Control.Applicative hiding (many)
import qualified Data.Text as T
import Data.List
import Data.List.Split
import Data.Maybe
import Control.Monad
import Text.Read
import System.Directory (createDirectory, copyFile)
import qualified System.Directory
import System.Directory.Extra (listFiles)
import System.Exit
import System.Environment

import Options.Applicative hiding (many)
import qualified Options.Applicative as O
import Options.Applicative.Types (readerAsk)

import Development.Shake
import Development.Shake.Classes
import Development.Shake.FilePath

import Debian.Relation.Common
import Debian.Control.String
import Debian.Control.Policy

import Text.Parsec hiding (option, oneOf)
import Text.Parsec.String

-- Option parsing
data Conf = Conf
    { distribution :: String
    , excludedPackages :: [String]
    , targetDir :: FilePath
    , jobs :: Int
    , schrootName :: String
    , shakeVerbosity' :: Verbosity
    , keepGoing :: Bool
    , targets :: [String]
    }

confSpec :: O.Parser Conf
confSpec = Conf
 <$> strOption (
    long "distribution" <>
    short 'd' <>
    metavar "DIST" <>
    help "Distribution to build for (passed to sbuild)" <>
    showDefault <>
    value "unstable"
    )
 <*> option parseCommaOrSpace (
    long "excluded-packages" <>
    metavar "PKG,PKG,..." <>
    help "comma or space separated list of source package names to ignore" <>
    value defaultExcludedPackages <>
    showDefaultWith (intercalate ", ")
    )
 <*> strOption (
    long "output" <>
    short 'o' <>
    metavar "DIR" <>
    help "output directory" <>
    showDefault <>
    value "lab"
    )
 <*> option parseNat (
    long "jobs" <>
    short 'j' <>
    metavar "INT" <>
    help "number of parallel jobs" <>
    showDefault <>
    value 1
    )
 <*> strOption  (
    long "chroot" <>
    short 'c' <>
    metavar "SCHROOT" <>
    help "name of the schroot to use" <>
    showDefault <>
    value "haskell"
    )
 <*> option readOption  (
    long "shake-verbosity" <>
    metavar "VERBOSITY" <>
    help "verbosity for shake (Silent, Quiet, Normal, Loud, Chatty or Diagnostic)" <>
    showDefault <>
    value Normal
    )
 <*> switch  (
    long "keep-going" <>
    help "keep going even if there are errors" <>
    showDefault
    )
  <*> O.many (argument str (metavar "TARGET..."))

parseCommaOrSpace:: ReadM [String]
parseCommaOrSpace = do
    s <- readerAsk
    return $ split (dropBlanks $ dropDelims $ oneOf ";, ") s

readOption :: Read a => ReadM a
readOption  = do
    s <- readerAsk
    case readMaybe s of
        Nothing -> fail $ "Cannot parse " ++ s
        Just n -> return n

parseNat :: ReadM Int
parseNat  = do
    s <- readerAsk
    case readMaybe s of
        Nothing -> fail "Not a number"
        Just n | n < 0 -> fail "I cannot do a negative number of jobs"
               | otherwise -> return n

-- dpkg-parsechangelog is slow, so here is a quick hack
-- TODO: Ensure this is not run unnecessarily often
versionOfSource :: String -> Action String
versionOfSource s = do
    let f = "p" </> s </> "debian" </> "changelog"
    need [f]
    ret <- liftIO $ parseFromFile p f
    case ret of
        Left e -> fail (show e)
        Right s -> return s
  where
    p = do
        many $ noneOf "("
        char '('
        v <- many1 $ noneOf ")"
        char ')'
        return (removeEpoch v)

ensureVersion :: String -> String -> Action ()
ensureVersion s v = do
    ex <- doesFileExist $ "p" </> s </> "debian" </> "changelog"
    unless ex $ do
        fail $ "I do not know about package " ++ s
    v' <- versionOfSource s
    when (v /= v') $ do
        fail $ "Cannot build " ++ s ++ " version " ++ v ++ ", as we have " ++ v' ++ "."

removeEpoch :: String -> String
removeEpoch s | ':' `elem` s = tail $ dropWhile (/= ':') s
              | otherwise    = s


changesFileName s v = s ++ "_" ++ v ++ "_amd64.changes"
logFileName s v = s ++ "_" ++ v ++ "_amd64.build"
sourceFileName s v = s ++ "_" ++ v ++ ".dsc"

binaryPackagesOfSource :: String -> Action [(String, String)]
binaryPackagesOfSource s = do
    let controlFile = "p" </> s </> "debian" </> "control"
    need [controlFile]
    ret <- liftIO $ parseDebianControlFromFile controlFile
    case ret of
        Left e -> fail (show e)
        Right dc -> forM (debianBinaryParagraphs dc) $  \bp -> do
            p <- maybe (fail "No Package field") (return . T.unpack) $ fieldValue "Package" bp
            a <- maybe (fail "No Arch field") (return . T.unpack) $ fieldValue "Architecture" bp
            return (p, if a == "all" then a else "amd64")

dependsOfDsc :: FilePath -> IO [String]
dependsOfDsc f = do
    ret <- parseControlFromFile f
    case ret of
        Left e -> fail (show e)
        Right (Control (p:_)) -> do
            deps <- case fieldValue "Build-Depends" (p:: Paragraph) of
                Nothing -> fail "no Build-Depends"
                Just depV -> return $ nub $ parseFlatRel depV
            ideps <- case fieldValue "Build-Depends-Indep" (p:: Paragraph) of
                Nothing -> return []
                Just depV -> return $ nub $ parseFlatRel depV
            return $ deps ++ ideps


-- Parsing package relations with flattening
-- (this could be faster than flatRels . parseRels)
parseFlatRel :: String -> [String]
parseFlatRel = flatRels . parseRels
  where
    flatRels :: Relations -> [String]
    flatRels = map (\(Rel (BinPkgName n) _ _) -> n) . join

    parseRels :: String -> Relations
    parseRels s = case parseRelations s of
      Left pe ->  error $ "Failed to parse relations " ++ (show pe)
      Right rel -> rel

fixupScript :: [String] -> String
fixupScript pkgs = unlines $
    [ "#!/bin/bash"
    -- I disable locking in the schroot. I have /var/cache/apt/archives bind-mounted
    -- via /etc/schroot/default/fstab, so with locking, I could not run
    -- multiple sbuilds at the same time
    , "echo 'Debug::NoLocking \"true\";' > /etc/apt/apt.conf.d/no-locking"
    ] ++ ignoreArchiveDepends pkgs

ignoreArchiveDepends :: [String] -> [String]
ignoreArchiveDepends [] = []
ignoreArchiveDepends pkgs =
    [ "#!/bin/bash"
    , "apt-get install dctrl-tools" -- Just in case it is not installed in the base schroot
    , "for f in /var/lib/apt/lists/*_Packages"
    , "do"
    , "grep-dctrl -v -F Package -X \\( " ++ disj ++ " \\) < \"$f\" > \"$f\".tmp"
    , "mv \"$f\".tmp \"$f\""
    , "done"
    ]
  where disj = intercalate " -o " pkgs


debFileNameToPackage filename =
    let [pkgname,_version,_] = splitOn "_" filename
    in pkgname

defaultExcludedPackages = words "ghc ghc-testsuite haskell-devscripts haskell98-report haskell-platform"
newtype GetExcludedSources = GetExcludedSources () deriving (Show,Typeable,Eq,Hashable,Binary,NFData)

newtype GetDebBuiltBy = GetDebBuiltBy String  deriving (Show,Typeable,Eq,Hashable,Binary,NFData)
newtype GetBinToDeb = GetBinToDeb String  deriving (Show,Typeable,Eq,Hashable,Binary,NFData)

manpage :: String
manpage = unlines [ "TODO" ]

main = do
    args <- getArgs
    case args of ["--manpage"] -> putStr manpage
                 _ -> do execParser opts >>= run
  where
    opts = info (helper <*> confSpec)
        ( fullDesc
       <> progDesc "Rebuilds a set of packages"
       <> header "make-all - Rebuilds a set of packages" )

    run conf = shake (makeShakeOptions conf) (shakeMain conf)

makeShakeOptions :: Conf -> ShakeOptions
makeShakeOptions Conf{..} = shakeOptions
    { shakeFiles = targetDir </> ".shake"
    , shakeThreads = jobs
    , shakeVerbosity = shakeVerbosity'
    , shakeChange = ChangeModtimeAndDigestInput
    , shakeStaunch = keepGoing
    , shakeProgress = progressSimple
    }

shakeMain conf@(Conf {..}) = do
    if null targets then want ["all"] else want targets

    getExcludedSources <- addOracle $ \GetExcludedSources{} ->
        return $ excludedPackages

    targetDir </> "cache/sources.txt" %> \out -> do
        sources <- getDirectoryDirs "p"
        excluded <- getExcludedSources (GetExcludedSources ())
        let sources' = filter (`notElem` excluded) sources
        putNormal "# enumerating sources..."
        writeFileChanged out (unlines sources')

    targetDir </> "cache/all-binaries.txt" %> \out -> do
        sources <- readFileLines $ targetDir </> "cache/sources.txt"
        binaries <- concat <$> mapM readFileLines
            [ targetDir </> "cache" </> "binaries" </> s <.> "txt" | s <- sources ]
        putNormal "# enumerating all binaries..."
        writeFileChanged out $ unlines binaries

    targetDir </> "cache/built-by.txt" %> \out -> do
        sources <- readFileLines $ targetDir </> "cache/sources.txt"
        builtBy <- liftM (sort . concat) $ forM sources $ \s -> do
            pkgs <- readFileLines $ targetDir </> "cache/binaries/" ++ s ++ ".txt"
            return [(pkg,s) | pkg <- pkgs]
        putNormal "# building built-by cache..."
        writeFileChanged out $ unlines [ unwords [pkg,s] | (pkg,s) <- builtBy ]

    -- This maps binary package _file_ names built by us to source package names
    debBuiltByMap <- newCache $ \() -> do
        builtBy <- readFileLines $ targetDir </> "cache/built-by.txt"
        return $ M.fromList [ (deb, source)
            | [deb,source] <- words <$> builtBy
            ]

    getDebBuiltBy <- addOracle $ \(GetDebBuiltBy bin) -> do
        map <- debBuiltByMap ()
        return $ M.lookup bin map

    let debBuiltBy :: String -> Action (Maybe String)
        debBuiltBy = getDebBuiltBy . GetDebBuiltBy

    -- This maps binary _package_ names built by us to binary packages _filenames_
    binToDebMap <- newCache $ \() -> do
        builtBy <- readFileLines $ targetDir </> "cache/built-by.txt"
        return $ M.fromList [ (pkgname, deb)
            | [deb,_source] <- words <$> builtBy
            , let [pkgname,_version,_] = splitOn "_" deb
            ]

    getBinToDeb <- addOracle $ \(GetBinToDeb bin) -> M.lookup bin <$> binToDebMap ()

    let binToDeb :: String -> Action (Maybe String)
        binToDeb = getBinToDeb . GetBinToDeb

    targetDir </> "cache/all-changes-files.txt" %> \out -> do
        putNormal "# enumerating all changes files..."
        sources <- readFileLines $ targetDir </> "cache/sources.txt"
        versioned <- forM sources $ \s -> do
            v <- versionOfSource s
            return (s,v)
        writeFileChanged out $ unlines $ map (uncurry changesFileName) versioned

    targetDir </> "cache/binaries/*.txt" %> \out -> do
        let s = dropExtension $ takeFileName $ out
        putNormal $ "# enumerating binaries of " ++ show s
        pkgs <- binaryPackagesOfSource s
        v <- versionOfSource s

        writeFileChanged out $ unlines [ p ++ "_" ++ v ++ "_" ++ a ++ ".deb" | (p,a) <- pkgs]

    "all" ~> do
        changesFiles <- readFileLines $ targetDir </> "cache/all-changes-files.txt"
        need [ targetDir </>  l | l <- changesFiles]

    -- Binary packages depend on the corresponding changes file log
    targetDir </> "*.deb" %> \out -> do
        let filename = takeFileName out
        let [_pkgname,version,_] = splitOn "_" filename
        sourceMB <- debBuiltBy filename
        case sourceMB of
            Nothing -> fail $ "File " ++ filename ++ " not built by us."
            Just source -> need [targetDir </> changesFileName source version]

    -- Changes files depend on the corresponding log file
    targetDir </> "*.changes" %> \out -> do
        let filename = takeFileName out
        let [source,version,_] = splitOn "_" filename
        let logfile = targetDir </> logFileName source version
        need [logfile]
        ok <- doesFileExist out
        unless ok $ fail $ "Building " ++ source ++ " failed, remove " ++ logfile ++ " to retry."


    -- Build log depends on the corresponding source, and the dependencies
    targetDir </> "*.build" %> \out -> do
        let filename = takeFileName out
        let [source,version,_] = splitOn "_" filename
        let changes = changesFileName source version

        ensureVersion source version

        -- To build something, we need the source
        let dsc = sourceFileName source version
        need [targetDir </> dsc]

        -- This ensures all dependencies are up-to-date
        deps <- liftIO $ dependsOfDsc $ targetDir </> dsc
        putLoud $ "# " ++ source ++ " depends on:"
        putLoud $ "# packages: " ++ intercalate "," deps
        depFileNames <- catMaybes <$> mapM binToDeb deps
        putLoud $ "# dependencies: " ++ intercalate "," depFileNames

        ourBins <- readFileLines $ targetDir </> "cache" </> "binaries" </> source <.> "txt"

        -- For the sake of packages like alex, uuagc etc, we exclude ourselves
        -- from this, thus allowing the use of the binary from the archive to
        -- bootstrap.
        need $ map (targetDir </>) $ filter (`notElem` ourBins) depFileNames

        -- What files do we have built locally?
        -- Make sure the build uses only them
        -- Do not use readFileLines or readFile', lest we rebuild everything
        -- if the set of packages changes.
        orderOnly [targetDir </> "cache" </> "all-binaries.txt"]
        expectedDeps <- S.fromList . lines <$> liftIO (readFile (targetDir </> "cache" </> "all-binaries.txt"))
        localDebs <-
            filter (`S.member` expectedDeps) .
            map (makeRelative targetDir) <$>
            liftIO (listFiles targetDir)
        let localDepPkgs = map debFileNameToPackage localDebs

        withTempDir $ \tmpdir -> do
            -- Now monkey-patch dependencies out of the package lists
            let fixup = tmpdir </> "fixup.sh"
            liftIO $ writeFile fixup  $ fixupScript localDepPkgs

            -- Create a dummy repository
            let repoDir = tmpdir </> "repo"
            liftIO $ createDirectory repoDir
            forM_ localDebs $ \p -> liftIO $ copyFile ("lab" </> p) (repoDir </> p)
            unit $ cmd (Cwd repoDir)  (EchoStderr False) (FileStdout (repoDir </> "Packages"))
                ["dpkg-scanpackages", "."]

            -- Run sbuild
            Exit c <- cmd (Cwd targetDir) (EchoStdout False)
                ["sbuild"
                , "-c", schrootName
                , "-A"
                , "--no-apt-update"
                , "--dist", distribution
                , "--chroot-setup-commands=bash " ++ fixup
                , "--extra-repository=deb [trusted=yes] file://" ++ repoDir ++ " ./"
                , dsc
                ]
            if (c == ExitSuccess)
            then do
                -- Add the sources to the changes file. We do not simply pass
                -- "-s" to sbuild, as it would make sbuild re-create and override the .dsc file
                -- which confuses the build system.
                unit $ cmd ["changestool", targetDir </> changes, "adddsc", targetDir </> dsc]
            else do
                putNormal $ "Failed to build " ++ source ++ "_" ++ version
                ex <- liftIO $ System.Directory.doesFileExist out
                putNormal $ "See " ++ out ++ " for details."


    -- Build log depends on the corresponding source, and the dependencies
    targetDir </> "*.dsc" %> \out -> do
        let filename = dropExtension $ takeFileName out
        let [source,version] = splitOn "_" filename
        ensureVersion source version
        sourceFiles <- getDirectoryFiles ("p" </> source) ["debian//*"]
        need [ "p" </> source </> f | f <- sourceFiles]
        unit $ cmd  (EchoStdout False) (Traced "debian2dsc") "dht" "debian2dsc" "-o" targetDir ("p" </> source </> "debian")


