import Control.Applicative ((<$>))
import Control.Monad (void, unless)
import Data.Maybe (mapMaybe)
import Data.List (intercalate)
import Data.List.Split (splitOn)
import Data.Char (isAlpha)
import qualified Data.Foldable as F
import qualified Data.Traversable as T
import qualified Data.Set as S
import qualified Data.Map as M
import System.Environment (getArgs)
import System.Exit (exitFailure)
import Distribution.Package ( PackageId
                            , PackageName
                            , PackageIdentifier(PackageIdentifier)
                            , mkPackageName
                            , pkgName
                            , pkgVersion
                            , unPackageName
                            )
import Distribution.Version ( Version
                            , mkVersion
                            )
import Distribution.Text (display)
import Safe (readMay)

main :: IO ()
main = do
  (pmiss, pdiff, pmore) <- parseArgs
  debian <- getDebianPackages
  lts <- getLtsPackages
  let (missing, different, more) = packageDiff debian lts
  unless pmiss $ printMissings missing
  unless pdiff $ printDifferences different
  unless pmore $ printMore more

parseArgs :: IO (Bool, Bool, Bool)
parseArgs = do
  r <- T.sequence <$> map isValid <$> getArgs
  case r of
    Left arg -> do
              putStrLn $ "Invalid command line argument " ++ arg
              exitFailure
    Right args -> let pmiss = "--no-missing-packages" `elem` args
                      pdiff = "--no-differing-packages" `elem` args
                      pmore = "--no-more-packages" `elem` args
                  in return (pmiss, pdiff, pmore)

isValid :: String -> Either String String
isValid arg = if arg `elem` [ "--no-missing-packages"
                           , "--no-differing-packages"
                           , "--no-more-packages"
                           ]
              then Right arg
              else Left arg

getDebianPackages :: IO (S.Set PackageId)
getDebianPackages = S.fromList . mapMaybe parseDebianPackage
                    <$> getLines debianPackagesFile

getLines :: FilePath -> IO [String]
getLines = fmap lines .  readFile

debianPackagesFile :: FilePath
debianPackagesFile = "packages.txt"

parseDebianPackage :: String -> Maybe PackageId
parseDebianPackage line = do
  (rawName:rawVersion:_) <- return $ words line
  let name = mkPackageName rawName
  version <- parseVersion rawVersion
  return PackageIdentifier { pkgName = name
                           , pkgVersion = version
                           }

getLtsPackages :: IO (S.Set PackageId)
getLtsPackages = S.fromList . mapMaybe parseLtsPackage
                 <$> getLines ltsFile

ltsFile :: FilePath
ltsFile = "lts.config"

parseLtsPackage :: String -> Maybe PackageId
parseLtsPackage line = case line of
                         ('-':'-':_) -> Nothing
                         ('c':'o':'n':'s':'t':'r':'a':'i':'n':'t':'s':':':rest)
                             -> parseLtsPackage rest
                         packageLine -> do
                                   [rawName, rawVersion] <- return
                                        $ splitOn "==" packageLine
                                       -- Throws eventual whitespaces
                                       -- from the end and the
                                       -- beginning of the name
                                   let name = mkPackageName
                                              $ filter isAlpha
                                                       rawName
                                       -- Throw the trailing comma away.
                                   version <- parseVersion $
                                              stripComma rawVersion
                                   return PackageIdentifier
                                              { pkgName = name
                                              , pkgVersion = version
                                              }

packageDiff :: S.Set PackageId
            -> S.Set PackageId
            -> ( S.Set PackageName
               , M.Map PackageName (Version, Version)
               , S.Set PackageName
               )
packageDiff debian lts = (missing, different, more)
    where missing = S.difference ltsPkgs debianPkgs
          different = mergeCommonPackages debianMap ltsMap
          more = S.difference debianPkgs ltsPkgs
          ltsMap = packages2packageMap lts
          debianMap = packages2packageMap debian
          ltsPkgs = S.map pkgName lts
          debianPkgs = S.map pkgName debian

mergeCommonPackages :: M.Map PackageName Version
                    -> M.Map PackageName Version
                    -> M.Map PackageName (Version, Version)
mergeCommonPackages = M.mergeWithKey
                      (\_ debianV ltsV -> if debianV /= ltsV
                                          then Just (debianV, ltsV)
                                          else Nothing
                      )
                      (const M.empty)
                      (const M.empty)

packages2packageMap :: S.Set PackageId -> M.Map PackageName Version
packages2packageMap = indexSet pkgName pkgVersion

indexSet :: (Ord k) => (a -> k) -> (a -> v) -> S.Set a -> M.Map k v
indexSet key value = F.foldr (\x -> M.insert (key x) (value x)) M.empty

printMissings :: S.Set PackageName -> IO ()
printMissings missing = do
  putStrLn "\nPackages in LTS but not in Debian:\n"
  F.traverse_ printPackage missing

printDifferences :: M.Map PackageName (Version, Version) -> IO ()
printDifferences different = do
  putStrLn "\nPackages that have different versions in LTS and Debian:\n"
  void $ M.traverseWithKey printDifference different

printDifference :: PackageName -> (Version, Version) -> IO ()
printDifference name (debianV, ltsV) =
    putStrLn $ unPackageName name ++ " has version " ++
             display debianV ++ " in Debian but " ++
             display ltsV ++ " in LTS."

printMore :: S.Set PackageName -> IO ()
printMore more = do
  putStrLn "\nPackages in Debian but not in LTS:\n"
  F.traverse_ printPackage more

printPackage :: PackageName -> IO ()
printPackage = putStrLn . unPackageName

parseVersion :: String -> Maybe Version
parseVersion raw = do
  let parts = splitOn "." raw
  numericParts <- mapM readMay parts
  return $ mkVersion numericParts

stripComma :: String -> String
stripComma s
    | last s == ',' = init s
    | otherwise = s