{-# OPTIONS_GHC -fglasgow-exts #-}
module Main where

import Control.Arrow (second)
import Control.Monad
import qualified Codec.Compression.GZip as GZip
import qualified Codec.Compression.BZip as BZip
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as L
import Data.List
import qualified Data.Map as M
import Data.Maybe
import Data.Time
import Debian.Apt.Methods
import Debian.Apt.Index
import Debian.Cache
import Debian.Control.ByteString
import Debian.Version
import Data.Generics
import Debian.Report
import Debian.SourcesList
import Debian.Types.DebSource
import Debian.Types.ReleaseInfo
import Extra.Terminal
import Extra.Exit
import Extra.HughesPJ
import Extra.HaXml
import Linspire.Unix.FilePath
import Network.URI
import System.Environment
import System.Exit
import Text.ParserCombinators.Parsec.Error
import Text.PrettyPrint.HughesPJ
import Text.XML.HaXml
import Text.XML.HaXml.Pretty
import System.IO

-- * command-line helper functions
helpText :: String -> Doc
helpText progName =
    (text "Usage:" <+> text progName <+> text "<old sources.list>" <+> text "<new sources.list>"$+$ 
     text [] $+$ 
     (fsep $ map text $ words $ "Find all the packages referenced by the second sources.list which trump packages find in the first sources.list.")
    )
    
parseArgs :: IO (String, String)
parseArgs =
    do args <- getArgs
       case args of
         [dista, distb] -> return (dista, distb)
         _ -> exitWithHelp helpText

-- * main
main =
    do (sourcesAFP, sourcesBFP) <- parseArgs
       let arch     = "i386" -- not actually used for anything right now, could be when binary package list is enabled
           cacheDir = "."    -- FIXME: replace with tempdir later
       sourcesA <- liftM parseSourcesList $ readFile sourcesAFP
       sourcesB <- liftM parseSourcesList $ readFile sourcesBFP
       trumpMap <- trumped (fetch emptyFetchCallbacks []) cacheDir arch sourcesA sourcesB
       print (showXML "trump.xsl" (trumpedXML trumpMap))


-- * MOVE all these functions elsewhere

-- * XML 



-- * Junk Yard


-- * Fix archFiles to work this way, then use that instead of toLocal    


{-
toLocal :: String -> DebSource -> [FilePath]
toLocal arch deb@(DebSource typ uri _) =
    map (addPrefix . escapePath) (toPaths typ arch deb)
    where
      addPrefix s = prefix scheme user' pass' reg port ++ {- "_" ++ -} s
      prefix "http:" (Just user) Nothing (Just host) port = user ++ host ++ port
      prefix "http:" _ _ (Just host) port = host ++ port
      prefix "ftp:" _ _ (Just host) _ = host
      prefix "file:" Nothing Nothing Nothing "" = ""
      prefix "ssh:" (Just user) Nothing (Just host) port = user ++ host ++ port
      prefix "ssh:" _ _ (Just host) port = host ++ port
      prefix _ _ _ _ _ = error ("invalid DebSource: " ++ show deb)
      user' = maybeOfString user
      pass' = maybeOfString pass
      (user, pass) = break (== ':') userpass
      userpass = maybe "" uriUserInfo auth
      reg = maybeOfString $ maybe "" uriRegName auth
      port = maybe "" uriPort auth
      scheme = uriScheme uri
      auth = uriAuthority uri
      path = uriPath uri

toPaths :: SourceType -> String -> DebSource -> [FilePath]
toPaths Deb arch deb@(DebSource Deb uri distro) = map (++ "/binary-" ++ arch ++ "/Packages") (toPaths' deb)
toPaths DebSrc _ deb@(DebSource DebSrc uri distro) = map (++ "/source/Sources") (toPaths' deb)

toPaths' :: DebSource -> [FilePath]
toPaths' deb@(DebSource typ uri (Left exact)) =
    [uriPath uri +/+ exact]
toPaths' deb@(DebSource typ uri (Right (dist, sections))) =
    map ((uriPath uri +/+ "dists" +/+ (relName dist)) +/+) sections
-}

        -- basePath = uriPath baseURI
        {-
        indexPath = case sourceType debSource of
                      DebSrc -> "source/Sources"
                      Deb -> "binary-" ++ arch +/+ "Packages"
         -}


       {-
       indexesA <- update (simpleFetch []) cacheDir arch sourcesA
       pmA <- makePackageMap (map fromJust indexesA)
       indexesB <- update (simpleFetch []) cacheDir arch sourcesB
       pmB <- makePackageMap (map fromJust indexesB)
       -}

       -- let -- indexURIsA = concatMap (indexURIs arch) sourcesA
           -- indexURIsB = concatMap (indexURIs arch) sourcesB
       -- print (M.toAscList pmA)
       -- print (M.toAscList pmB)
       -- packageMap (map fromJust indexesA) -- mapM_ (\i -> controlFromIndex (fromJust i) >>= either (error . show) (\(Control p) -> mapM (print . fieldValue "Package") p)) indexesA
       -- mapM_ print (sourcesA ++ sourcesB)
       -- mapM_ print (indexURIsA ++ indexURIsB)
       -- indexesA <- mapM (uncurry $ fetchIndex (simpleFetch [])) indexURIsA
       -- indexesB <- mapM (uncurry $ fetchIndex (simpleFetch [])) indexURIsB