-- |
-- Module      :  Distribution.Package.Debian.Bundled
-- Copyright   :  David Fox 2008
--
-- Maintainer  :  David Fox <dsf@seereason.com>
-- Stability   :  alpha
-- Portability :  portable
--
-- Determine whether a specific version of a Haskell package is
-- bundled with into this particular version of the given compiler.

-- This software may be used and distributed according to the terms of
-- the GNU General Public License, incorporated herein by reference.

module Distribution.Package.Debian.Bundled
    (
      Bundled 
    , bundledWith
    , isBundled
    , isLibrary
    , docPrefix
    , builtIns
    ) where

import qualified Data.ByteString.Char8 as B
import Data.Function (on)
import Data.List (find,isPrefixOf,sortBy)
import Data.Maybe (maybeToList)
import Data.Version (Version(..))
import Debian.Control(Control'(Control), fieldValue, parseControlFromFile)
import Debian.Relation.ByteString()
import Debian.Relation(Relation(Rel),parseRelations)
import Distribution.InstalledPackageInfo(InstalledPackageInfo, libraryDirs, package)
import Distribution.Simple.Compiler (Compiler(..), CompilerId(..), CompilerFlavor(..), PackageDB(GlobalPackageDB), compilerFlavor)
import Distribution.Simple.Configure (getInstalledPackages)
-- import Distribution.Simple.GHC  (getInstalledPackages)
import Distribution.Simple.PackageIndex (PackageIndex, SearchResult(None, Unambiguous, Ambiguous), allPackages, searchByName)
import Distribution.Simple.Program (configureAllKnownPrograms, defaultProgramConfiguration)
import Distribution.Package (PackageIdentifier(..), PackageName(..), Dependency(..))
import Distribution.Verbosity(normal)
import Distribution.Version (withinRange)
import Text.ParserCombinators.Parsec(ParseError)
import Text.Regex.Posix ((=~))

-- | List the packages bundled with this version of the given
-- compiler.  If the answer is not known, return the empty list.
bundledWith :: [(CompilerFlavor, Version, [PackageIdentifier])] -> Compiler -> Maybe [PackageIdentifier]
bundledWith builtIns c =
    let cv = (compilerFlavor c, (\ (CompilerId _ v) -> v) $ compilerId c)
    in thd `fmap` find (\(n,v,_) -> (n,v) == cv) builtIns
  where thd (_,_,x) = x

-- | Determine whether a specific version of a Haskell package is
-- bundled with into this particular version of the given compiler.
isBundled :: [(CompilerFlavor, Version, [PackageIdentifier])] -> Compiler -> Dependency -> Bool
isBundled builtIns c (Dependency pkg version) =
    let cv = (compilerFlavor c, (\ (CompilerId _ v) -> v) (compilerId c))
    in
      case find (\(n, k, _) -> (n,k) == cv) builtIns of
        Nothing -> False
        (Just (_, _, cb)) ->
          any checkVersion $ pkgVersion `fmap` filter ((== pkg) . pkgName) cb
  where checkVersion = flip withinRange version

type Bundled = (CompilerFlavor, Version, [PackageIdentifier])

builtIns :: Compiler -> IO [Bundled]
builtIns compiler = 
    do ghc6 <- fmap maybeToList $ ghc6BuiltIns compiler
       return $ ghc6 ++ [ (GHC, Version [6,8,3] [], ghc683BuiltIns)
                        , (GHC, Version [6,8,2] [], ghc682BuiltIns)
                        , (GHC, Version [6,8,1] [], ghc681BuiltIns)
                        , (GHC, Version [6,6,1] [], ghc661BuiltIns)
                        , (GHC, Version [6,6] [], ghc66BuiltIns)
                        ]
ghc6BuiltIns :: Compiler -> IO (Maybe (CompilerFlavor, Version, [PackageIdentifier]))
ghc6BuiltIns compiler@(Compiler (CompilerId GHC compilerVersion) _) =
    do mInstalledPackages <- getInstalledPackageIndex compiler
       case mInstalledPackages of
         Nothing -> error "Could not find the installed package database."
         (Just installedPackages) ->
             do ghc6Files <- fmap lines $ readFile "/var/lib/dpkg/info/ghc6.list"
                let ghcProvides = filter (\package -> any (\dir -> elem dir ghc6Files) (libraryDirs package)) (allPackages installedPackages)
                return (Just (GHC, compilerVersion, map package ghcProvides))
ghc6BuiltIns _ = return Nothing

ghc6BuiltIns' :: Compiler -> IO (Maybe (CompilerFlavor, Version, [PackageIdentifier]))
ghc6BuiltIns' compiler@(Compiler (CompilerId GHC compilerVersion) _) =
    do eDebs <- ghc6Provides
       case eDebs of
         Left e -> error e
         Right debNames ->
             do mInstalledPackages <- getInstalledPackageIndex compiler
                case mInstalledPackages of
                  Nothing -> error "Could not find the installed package database."
                  (Just installedPackages) ->
                      let packages = concatMap (\n -> fromRight $ installedVersions (fromRight $ extractBaseName n) installedPackages) debNames
                      in
                        return $ Just (GHC, compilerVersion, packages)
    where
      fromRight (Right r) = r
      fromRight (Left e) = error e
ghc6BuiltIns' compiler@(Compiler _ _) = return Nothing

ghc6Provides :: IO (Either String [String])
ghc6Provides = 
    do eC <- parseControlFromFile "/var/lib/dpkg/status" :: IO (Either ParseError (Control' B.ByteString))
       case eC of
         Left e  -> return $ Left (show e)
         Right (Control c) ->
             case find (\p -> fieldValue "Package" p == Just (B.pack "ghc6")) c of
               Nothing -> return $ Left "You do not seem to have ghc6 installed."
               (Just p) ->
                   case fieldValue "Provides" p of
                     Nothing -> return $ Left "Your ghc6 package does not seem to Provide anything."
                     (Just p) -> 
                         case parseRelations p of
                           (Left e) -> return (Left (show e))
                           (Right relations) ->
                               return $ Right $ filter (isPrefixOf "libghc6-") $ map (\ (Rel pkgName _ _) -> pkgName) (concat relations)


extractBaseName :: String -> Either String String
extractBaseName name =
    let (_,_,_,subs) = (name =~ "^libghc6-(.*)-.*$") :: (String, String, String, [String])
    in case subs of
         [base] -> Right base
         _ -> Left ("When attempt to extract the base name of " ++ name ++ " I found the following matches: " ++ show subs)
                 
getInstalledPackageIndex :: Compiler -> IO (Maybe (PackageIndex InstalledPackageInfo))
getInstalledPackageIndex compiler =
    do pc  <- configureAllKnownPrograms normal  defaultProgramConfiguration
       getInstalledPackages normal compiler GlobalPackageDB pc

installedVersions :: String -> PackageIndex InstalledPackageInfo -> Either String [PackageIdentifier]
installedVersions name packageIndex = 
    case searchByName packageIndex name of
      None -> Left $ "The package " ++ name ++ " does not seem to be installed."
      Unambiguous pkgs -> 
          case sortBy (compare `on` (pkgVersion . package)) pkgs of
            [] -> Left $ "Odd. searchByName returned an empty Unambiguous match for " ++ name
            ps -> Right (map package ps)
                                   
v :: String -> [Int] -> PackageIdentifier
v n x = PackageIdentifier (PackageName n) (Version x [])

ghc683BuiltIns :: [PackageIdentifier]
ghc683BuiltIns = ghc682BuiltIns

ghc682BuiltIns :: [PackageIdentifier]
ghc682BuiltIns = [
    v "Cabal" [1,2,3,0],
    v "array" [0,1,0,0],
    v "base" [3,0,1,0],
    v "bytestring" [0,9,0,1],
    v "containers" [0,1,0,1],
    v "directory" [1,0,0,0],
    v "filepath" [1,1,0,0],
    v "ghc" [6,8,2,0],
    v "haskell98" [1,0,1,0],
    v "hpc" [0,5,0,0],
    v "old-locale" [1,0,0,0],
    v "old-time" [1,0,0,0],
    v "packedstring" [0,1,0,0],
    v "pretty" [1,0,0,0],
    v "process" [1,0,0,0],
    v "random" [1,0,0,0],
    v "readline" [1,0,1,0],
    v "template-haskell" [2,2,0,0],
    v "unix" [2,3,0,0]
    ]

ghc681BuiltIns :: [PackageIdentifier]
ghc681BuiltIns = [
    v "base" [3,0,0,0],
    v "Cabal" [1,2,2,0],
    v "GLUT" [2,1,1,1],
    v "HGL" [3,2,0,0],
    v "HUnit" [1,2,0,0],
    v "OpenAL" [1,3,1,1],
    v "OpenGL" [2,2,1,1],
    v "QuickCheck" [1,1,0,0],
    v "X11" [1,2,3,1],
    v "array" [0,1,0,0],
    v "bytestring" [0,9,0,1],
    v "cgi" [3001,1,5,1],
    v "containers" [0,1,0,0],
    v "directory" [1,0,0,0],
    v "fgl" [5,4,1,1],
    v "filepatch" [1,1,0,0],
    v "ghc" [6,8,1,0],
    v "haskell-src" [1,0,1,1],
    v "haskell98" [1,0,1,0],
    v "hpc" [0,5,0,0],
    v "html" [1,0,1,1],
    v "mtl" [1,1,0,0],
    v "network" [2,1,0,0],
    v "old-locale" [1,0,0,0],
    v "old-time" [1,0,0,0],
    v "packedstring" [0,1,0,0],
    v "parallel" [1,0,0,0],
    v "parsec" [2,1,0,0],
    v "pretty" [1,0,0,0],
    v "process" [1,0,0,0],
    v "random" [1,0,0,0],
    v "readline" [1,0,1,0],
    v "regex-base" [0,72,0,1],
    v "regex-compat" [0,71,0,1],
    v "regex-posix" [0,72,0,1],
    v "stm" [2,1,1,0],
    v "template-haskell" [2,2,0,0],
    v "time" [1,1,2,0],
    v "unix" [2,2,0,0],
    v "xhtml" [3000,0,2,1]
    ]

ghc661BuiltIns :: [PackageIdentifier]
ghc661BuiltIns = [
    v "base" [2,1,1],
    v "Cabal" [1,1,6,2],
    v "cgi" [3001,1,1],
    v "fgl" [5,4,1],
    v "filepath" [1,0],
    v "ghc" [6,6,1],
    v "GLUT" [2,1,1],
    v "haskell98" [1,0],
    v "haskell-src" [1,0,1],
    v "HGL" [3,1,1],
    v "html" [1,0,1],
    v "HUnit" [1,1,1],
    v "mtl" [1,0,1],
    v "network" [2,0,1],
    v "OpenAL" [1,3,1],
    v "OpenGL" [2,2,1],
    v "parsec" [2,0],
    v "QuickCheck" [1,0,1],
    v "readline" [1,0],
    v "regex-base" [0,72],
    v "regex-compat" [0,71],
    v "regex-posix" [0,71],
    v "rts" [1,0],
    v "stm" [2,0],
    v "template-haskell" [2,1],
    v "time" [1,1,1],
    v "unix" [2,1],
    v "X11" [1,2,1],
    v "xhtml" [3000,0,2]
    ]

ghc66BuiltIns :: [PackageIdentifier]
ghc66BuiltIns = [
    v "base" [2,0],
    v "Cabal" [1,1,6],
    v "cgi" [2006,9,6],
    v "fgl" [5,2],
    v "ghc" [6,6],
    v "GLUT" [2,0],
    v "haskell98" [1,0],
    v "haskell-src" [1,0],
    v "HGL" [3,1],
    v "html" [1,0],
    v "HTTP" [2006,7,7],
    v "HUnit" [1,1],
    v "mtl" [1,0],
    v "network" [2,0],
    v "OpenAL" [1,3],
    v "OpenGL" [2,1],
    v "parsec" [2,0],
    v "QuickCheck" [1,0],
    v "readline" [1,0],
    v "regex-base" [0,71],
    v "regex-compat" [0,71],
    v "regex-posix" [0,71],
    v "rts" [1,0],
    v "stm" [2,0],
    v "template-haskell" [2,0],
    v "time" [1,0],
    v "unix" [1,0],
    v "X11" [1,1],
    v "xhtml" [2006,9,13]
    ]

-- |Some dependencies are libraries, some are executables.
isLibrary :: Compiler -> Dependency -> Bool
isLibrary _ (Dependency (PackageName "happy") _ ) = False
isLibrary _ _ = True

docPrefix :: String -> String
{-
docPrefix "alut" = "libghc6-"
docPrefix "arrows" = "libghc6-"
docPrefix "binary" = "libghc6-"
docPrefix "cgi" = "libghc6-"
docPrefix "fgl" = "libghc6-"
docPrefix "glut" = "libghc6-"
docPrefix "haskell-src" = "libghc6-"
docPrefix "hgl" = "libghc6-"
docPrefix "html" = "libghc6-"
docPrefix "hunit" = "libghc6-"
docPrefix "mtl" = "libghc6-"
docPrefix "network" = "libghc6-"
docPrefix "openal" = "libghc6-"
docPrefix "opengl" = "libghc6-"
docPrefix "parallel" = "libghc6-"
docPrefix "parsec" = "libghc6-"
docPrefix "quickcheck" = "libghc6-"
docPrefix "stm" = "libghc6-"
docPrefix "stream" = "libghc6-"
docPrefix "time" = "libghc6-"
docPrefix "x11" = "libghc6-"
docPrefix "xhtml" = "libghc6-"
docPrefix "xmonad" = "libghc6-"
-}
docPrefix _ = "haskell-"