cabal2nix-1.12: src/Hackage4Nix.hs
module Main ( main ) where
import System.IO
import System.FilePath
import System.Directory
import System.Environment
import System.Exit
import Data.List
import qualified Data.Set as Set
import Control.Monad.State
import Control.Exception ( bracket )
import Text.Regex.Posix
import Data.Version
import Distribution.PackageDescription.Parse ( parsePackageDescription, ParseResult(..) )
import Distribution.Package
import Distribution.PackageDescription ( GenericPackageDescription() )
import Distribution.Text
import System.Console.GetOpt ( OptDescr(..), ArgDescr(..), ArgOrder(..), usageInfo, getOpt )
import Cabal2Nix.Package
import Cabal2Nix.Normalize
import Distribution.NixOS.Derivation.Cabal
import Distribution.NixOS.Derivation.Meta
data Pkg = Pkg Derivation FilePath Bool
deriving (Show, Eq, Ord)
type PkgSet = Set.Set Pkg
data Configuration = Configuration
{ _msgDebug :: String -> IO ()
, _msgInfo :: String -> IO ()
, _hackageDb :: FilePath
, _pkgset :: PkgSet
}
defaultConfiguration :: Configuration
defaultConfiguration = Configuration
{ _msgDebug = hPutStrLn stderr
, _msgInfo = hPutStrLn stderr
, _hackageDb = "/dev/shm/hackage"
, _pkgset = Set.empty
}
type Hackage4Nix a = StateT Configuration IO a
io :: (MonadIO m) => IO a -> m a
io = liftIO
readDirectory :: FilePath -> IO [FilePath]
readDirectory dirpath = do
entries <- getDirectoryContents dirpath
return [ x | x <- entries, x /= ".", x /= ".." ]
msgDebug, msgInfo :: String -> Hackage4Nix ()
msgDebug msg = get >>= \s -> io (_msgDebug s msg)
msgInfo msg = get >>= \s -> io (_msgInfo s msg)
readCabalFile :: String -> String -> Hackage4Nix GenericPackageDescription
readCabalFile name vers = do
hackageDir <- gets _hackageDb
let cabal = hackageDir </> name </> vers </> name <.> "cabal"
pkg' <- fmap parsePackageDescription (io (readFile cabal))
pkg <- case pkg' of
ParseOk _ a -> return a
ParseFailed err -> fail ("cannot parse cabal file " ++ cabal ++ ": " ++ show err)
return pkg
discoverNixFiles :: (FilePath -> Hackage4Nix ()) -> FilePath -> Hackage4Nix ()
discoverNixFiles yield dirOrFile = do
isFile <- io (doesFileExist dirOrFile)
case (isFile, takeExtension dirOrFile) of
(True,".nix") -> yield dirOrFile
(True,_) -> return ()
(False,_) -> io (readDirectory dirOrFile) >>= mapM_ (discoverNixFiles yield . (dirOrFile </>))
regenerateDerivation :: Derivation -> String -> Bool
regenerateDerivation deriv buf = not (pname deriv `elem` patchedPackages) &&
not (buf =~ "(pre|post)Configure|configureFlags|(pre|post)Install|patchPhase")
readVersion :: String -> Version
readVersion str = maybe (error $ "cannot parse version " ++ show str) id (simpleParse str)
parseNixFile :: FilePath -> String -> Hackage4Nix (Maybe Pkg)
parseNixFile path buf
| not (buf =~ "cabal.mkDerivation")
= msgDebug ("ignore non-cabal package " ++ path) >> return Nothing
| any (`isSuffixOf`path) badPackagePaths
= msgDebug ("ignore known bad package " ++ path) >> return Nothing
| buf =~ "src = (fetchurl|fetchgit|sourceFromHead)"
= msgDebug ("ignore non-hackage package " ++ path) >> return Nothing
| Just deriv <- parseDerivation buf
= return (Just (Pkg deriv path (regenerateDerivation deriv buf)))
| otherwise = msgInfo ("failed to parse file " ++ path) >> return Nothing
selectLatestVersions :: PkgSet -> PkgSet
selectLatestVersions = Set.fromList . nubBy f2 . sortBy f1 . Set.toList
where
f1 (Pkg deriv1 _ _) (Pkg deriv2 _ _)
| pname deriv1 == pname deriv2 = compare (version deriv2) (version deriv1)
| otherwise = compare (pname deriv1) (pname deriv2)
f2 (Pkg deriv1 _ _) (Pkg deriv2 _ _) = pname deriv1 == pname deriv2
discoverUpdates :: String -> String -> Hackage4Nix [String]
discoverUpdates name vers = do
hackage <- gets _hackageDb
versionStrings <- io $ readDirectory (hackage </> name)
let versions = map readVersion versionStrings
return [ showVersion v | v <- versions, v > readVersion vers ]
updateNixPkgs :: [FilePath] -> Hackage4Nix ()
updateNixPkgs paths = do
msgDebug $ "updating = " ++ show paths
flip mapM_ paths $ \fileOrDir ->
flip discoverNixFiles fileOrDir $ \file -> do
nix' <- io (readFile file) >>= parseNixFile file
flip (maybe (return ())) nix' $ \nix -> do
let Pkg deriv path regenerate = nix
maints = maintainers (metaSection deriv)
plats = platforms (metaSection deriv)
modify $ \cfg -> cfg { _pkgset = Set.insert nix (_pkgset cfg) }
when regenerate $ do
msgDebug ("re-generate " ++ path)
pkg <- readCabalFile (pname deriv) (display (version deriv))
let deriv' = (cabal2nix pkg) { sha256 = sha256 deriv, runHaddock = runHaddock deriv }
meta = metaSection deriv'
plats' = if null plats then platforms meta else plats
deriv'' = deriv' { metaSection = meta
{ maintainers = maints ++ ["simons","andres"]
, platforms = plats'
}
}
io $ writeFile path (show (disp (normalize (deriv''))))
pkgset <- gets (selectLatestVersions . _pkgset)
updates' <- flip mapM (Set.elems pkgset) $ \pkg -> do
let Pkg deriv _ _ = pkg
updates <- discoverUpdates (pname deriv) (display (version deriv))
return (pkg,updates)
let updates = [ u | u@(_,(_:_)) <- updates' ]
when (not (null updates)) $ do
msgInfo "The following updates are available:"
flip mapM_ updates $ \(pkg,versions) -> do
let Pkg deriv path regenerate = pkg
msgInfo ""
msgInfo $ (display (packageId deriv)) ++ ":"
flip mapM_ versions $ \newVersion -> do
let deriv' = deriv { version = readVersion newVersion }
msgInfo $ " " ++ genCabal2NixCmdline (Pkg deriv' path regenerate)
return ()
genCabal2NixCmdline :: Pkg -> String
genCabal2NixCmdline (Pkg deriv path _) = unwords $ ["cabal2nix"] ++ opts ++ [">"++path']
where
meta = metaSection deriv
opts = [cabal] ++ maints' ++ plats' ++ if runHaddock deriv then [] else ["--no-haddock"]
cabal = "cabal://" ++ display (packageId deriv)
maints' = [ "--maintainer=" ++ normalizeMaintainer m | m <- maintainers meta ]
plats'
| ["self.ghc.meta.platforms"] == platforms meta = []
| otherwise = [ "--platform=" ++ p | p <- platforms meta ]
path'
| path =~ "/[0-9\\.]+\\.nix$" = replaceFileName path (display (version deriv) <.> "nix")
| otherwise = path
normalizeMaintainer :: String -> String
normalizeMaintainer x
| "self.stdenv.lib.maintainers." `isPrefixOf` x = drop 28 x
| otherwise = x
data CliOption = PrintHelp | Verbose | HackageDB FilePath
deriving (Eq)
main :: IO ()
main = bracket (return ()) (\() -> hFlush stdout >> hFlush stderr) $ \() -> do
let options :: [OptDescr CliOption]
options =
[ Option ['h'] ["help"] (NoArg PrintHelp) "show this help text"
, Option ['v'] ["verbose"] (NoArg Verbose) "enable noisy debug output"
, Option [] ["hackage"] (ReqArg HackageDB "HACKAGE-DIR") "path to hackage database"
]
usage :: String
usage = usageInfo "Usage: hackage4nix [options] [dir-or-file ...]" options ++ unlines
[ ""
, "The purpose of 'hackage4nix' is to keep all Haskell packages in our"
, "repository packages up-to-date. It scans a checked-out copy of"
, "Nixpkgs for expressions that use 'cabal.mkDerivation', and"
, "re-generates them in-place with cabal2nix."
, ""
, "Because we don't want to generate a barrage of HTTP requests during"
, "that procedure, the tool expects a copy of the Hackage database"
, "available at some local path, i.e. \"/dev/shm/hackage\" by default."
, "That directory can be set up as follows:"
, ""
, " cabal update"
, " mkdir -p /dev/shm/hackage"
, " tar xf ~/.cabal/packages/hackage.haskell.org/00-index.tar -C /dev/shm/hackage\n"
]
cmdlineError :: String -> IO a
cmdlineError "" = hPutStrLn stderr usage >> exitFailure
cmdlineError errMsg = hPutStrLn stderr errMsg >> cmdlineError ""
args' <- getArgs
(opts,args) <- case getOpt Permute options args' of
(o,n,[] ) -> return (o,n)
(_,_,errs) -> cmdlineError (concatMap (\e -> '*':'*':'*':' ':e) errs)
when (PrintHelp `elem` opts) (cmdlineError "")
let cfg = defaultConfiguration
{ _msgDebug = if Verbose `elem` opts then _msgDebug defaultConfiguration else const (return ())
, _hackageDb = last $ _hackageDb defaultConfiguration : [ p | HackageDB p <- opts ]
}
flip evalStateT cfg (updateNixPkgs args)
-- Packages that we cannot parse.
badPackagePaths :: [FilePath]
badPackagePaths = ["haskell-platform/2011.2.0.1.nix"]
-- Packages that we cannot regenerate automatically yet. This list
-- should be empty.
patchedPackages :: [String]
patchedPackages =
[ "X11" -- expression uses function arguments to determine feature set
, "xmonad-extras" -- the generated expression doesn't build, don't know why
]