@@ -1,25 +1,26 @@
11module Main ( main ) where
22
3−import System.IO
4−import System.FilePath
5−import System.Directory
6−import System.Environment
7−import System.Exit
3+import Cabal2Nix.Normalize
4+import Cabal2Nix.Package
5+import Control.Exception ( bracket )
6+import Control.Monad.RWS
87import Data.List
8+import Data.Maybe
99import qualified Data.Set as Set
10−import Control.Monad.State
11−import Control.Exception ( bracket )
12−import Text.Regex.Posix
1310import Data.Version
14−import Distribution.PackageDescription.Parse ( parsePackageDescription, ParseResult(..) )
11+import qualified Distribution.Hackage.DB as DB
12+import Distribution.NixOS.Derivation.Cabal
13+import Distribution.NixOS.Derivation.Meta
1514import Distribution.Package
1615import Distribution.PackageDescription ( GenericPackageDescription() )
1716import Distribution.Text
1817import System.Console.GetOpt ( OptDescr(..), ArgDescr(..), ArgOrder(..), usageInfo, getOpt )
19−import Cabal2Nix.Package
20−import Cabal2Nix.Normalize
21−import Distribution.NixOS.Derivation.Cabal
22−import Distribution.NixOS.Derivation.Meta
18+import System.Directory
19+import System.Environment
20+import System.Exit
21+import System.FilePath
22+import System.IO
23+import Text.Regex.Posix
2324
2425data Pkg = Pkg Derivation FilePath Bool
2526 deriving (Show, Eq, Ord)
@@ -29,7 +30,7 @@ type PkgSet = Set.Set Pkg
2930data Configuration = Configuration
3031 { _msgDebug :: String -> IO ()
3132 , _msgInfo :: String -> IO ()
32− , _hackageDb :: FilePath
33+ , _hackageDb :: DB.Hackage
3334 , _pkgset :: PkgSet
3435 }
3536
@@ -37,11 +38,11 @@ defaultConfiguration :: Configuration
3738defaultConfiguration = Configuration
3839 { _msgDebug = hPutStrLn stderr
3940 , _msgInfo = hPutStrLn stderr
40− , _hackageDb = "/dev/shm/hackage"
41+ , _hackageDb = DB.empty
4142 , _pkgset = Set.empty
4243 }
4344
44−type Hackage4Nix a = StateT Configuration IO a
45+type Hackage4Nix a = RWST Configuration () PkgSet IO a
4546
4647io :: (MonadIO m) => IO a -> m a
4748io = liftIO
@@ -52,18 +53,17 @@ readDirectory dirpath = do
5253 return [ x | x <- entries, x /= ".", x /= ".." ]
5354
5455msgDebug, msgInfo :: String -> Hackage4Nix ()
55−msgDebug msg = get >>= \s -> io (_msgDebug s msg)
56−msgInfo msg = get >>= \s -> io (_msgInfo s msg)
57−
58−readCabalFile :: String -> String -> Hackage4Nix GenericPackageDescription
59−readCabalFile name vers = do
60− hackageDir <- gets _hackageDb
61− let cabal = hackageDir </> name </> vers </> name <.> "cabal"
62− pkg' <- fmap parsePackageDescription (io (readFile cabal))
63− pkg <- case pkg' of
64− ParseOk _ a -> return a
65− ParseFailed err -> fail ("cannot parse cabal file " ++ cabal ++ ": " ++ show err)
66− return pkg
56+msgDebug msg = ask >>= \s -> io (_msgDebug s msg)
57+msgInfo msg = ask >>= \s -> io (_msgInfo s msg)
58+
59+getCabalPackage :: String -> Version -> Hackage4Nix GenericPackageDescription
60+getCabalPackage name vers = do
61+ db <- asks _hackageDb
62+ case DB.lookup name db of
63+ Just db' -> case DB.lookup vers db' of
64+ Just pkg -> return pkg
65+ Nothing -> fail ("hackage doesn't know about " ++ name ++ " version " ++ display vers)
66+ Nothing -> fail ("hackage doesn't know about " ++ show name)
6767
6868discoverNixFiles :: (FilePath -> Hackage4Nix ()) -> FilePath -> Hackage4Nix ()
6969discoverNixFiles yield dirOrFile = do
@@ -77,9 +77,6 @@ regenerateDerivation :: Derivation -> String -> Bool
7777regenerateDerivation deriv buf = not (pname deriv `elem` patchedPackages) &&
7878 not (buf =~ "(pre|post)Configure|configureFlags|(pre|post)Install|patchPhase")
7979
80−readVersion :: String -> Version
81−readVersion str = maybe (error $ "cannot parse version " ++ show str) id (simpleParse str)
82−
8380parseNixFile :: FilePath -> String -> Hackage4Nix (Maybe Pkg)
8481parseNixFile path buf
8582 | not (buf =~ "cabal.mkDerivation")
@@ -100,12 +97,11 @@ selectLatestVersions = Set.fromList . nubBy f2 . sortBy f1 . Set.toList
10097 | otherwise = compare (pname deriv1) (pname deriv2)
10198 f2 (Pkg deriv1 _ _) (Pkg deriv2 _ _) = pname deriv1 == pname deriv2
10299
103−discoverUpdates :: String -> String -> Hackage4Nix [String]
100+discoverUpdates :: String -> Version -> Hackage4Nix [Version]
104101discoverUpdates name vers = do
105− hackage <- gets _hackageDb
106− versionStrings <- io $ readDirectory (hackage </> name)
107− let versions = map readVersion versionStrings
108− return [ showVersion v | v <- versions, v > readVersion vers ]
102+ db <- asks _hackageDb
103+ let versions = DB.keys (fromJust (DB.lookup name db))
104+ return (filter (>vers) versions)
109105
110106updateNixPkgs :: [FilePath] -> Hackage4Nix ()
111107updateNixPkgs paths = do
@@ -117,10 +113,10 @@ updateNixPkgs paths = do
117113 let Pkg deriv path regenerate = nix
118114 maints = maintainers (metaSection deriv)
119115 plats = platforms (metaSection deriv)
120− modify $ \cfg -> cfg { _pkgset = Set.insert nix (_pkgset cfg) }
116+ modify (Set.insert nix)
121117 when regenerate $ do
122118 msgDebug ("re-generate " ++ path)
123− pkg <- readCabalFile (pname deriv) (display (version deriv))
119+ pkg <- getCabalPackage (pname deriv) (version deriv)
124120 let deriv' = (cabal2nix pkg) { sha256 = sha256 deriv, runHaddock = runHaddock deriv }
125121 meta = metaSection deriv'
126122 plats' = if null plats then platforms meta else plats
@@ -130,10 +126,10 @@ updateNixPkgs paths = do
130126 }
131127 }
132128 io $ writeFile path (show (disp (normalize (deriv''))))
133− pkgset <- gets (selectLatestVersions . _pkgset)
129+ pkgset <- asks (selectLatestVersions . _pkgset)
134130 updates' <- flip mapM (Set.elems pkgset) $ \pkg -> do
135131 let Pkg deriv _ _ = pkg
136− updates <- discoverUpdates (pname deriv) (display (version deriv))
132+ updates <- discoverUpdates (pname deriv) (version deriv)
137133 return (pkg,updates)
138134 let updates = [ u | u@(_,(_:_)) <- updates' ]
139135 when (not (null updates)) $ do
@@ -143,7 +139,7 @@ updateNixPkgs paths = do
143139 msgInfo ""
144140 msgInfo $ (display (packageId deriv)) ++ ":"
145141 flip mapM_ versions $ \newVersion -> do
146− let deriv' = deriv { version = readVersion newVersion }
142+ let deriv' = deriv { version = newVersion }
147143 msgInfo $ " " ++ genCabal2NixCmdline (Pkg deriv' path regenerate)
148144 return ()
149145
@@ -185,15 +181,6 @@ main = bracket (return ()) (\() -> hFlush stdout >> hFlush stderr) $ \() -> do
185181 , "repository packages up-to-date. It scans a checked-out copy of"
186182 , "Nixpkgs for expressions that use 'cabal.mkDerivation', and"
187183 , "re-generates them in-place with cabal2nix."
188− , ""
189− , "Because we don't want to generate a barrage of HTTP requests during"
190− , "that procedure, the tool expects a copy of the Hackage database"
191− , "available at some local path, i.e. \"/dev/shm/hackage\" by default."
192− , "That directory can be set up as follows:"
193− , ""
194− , " cabal update"
195− , " mkdir -p /dev/shm/hackage"
196− , " tar xf ~/.cabal/packages/hackage.haskell.org/00-index.tar -C /dev/shm/hackage\n"
197184 ]
198185
199186 cmdlineError :: String -> IO a
@@ -207,11 +194,13 @@ main = bracket (return ()) (\() -> hFlush stdout >> hFlush stderr) $ \() -> do
207194
208195 when (PrintHelp `elem` opts) (cmdlineError "")
209196
197+ hackage <- DB.readHackage
210198 let cfg = defaultConfiguration
211199 { _msgDebug = if Verbose `elem` opts then _msgDebug defaultConfiguration else const (return ())
212− , _hackageDb = last $ _hackageDb defaultConfiguration : [ p | HackageDB p <- opts ]
200+ , _hackageDb = hackage
213201 }
214− flip evalStateT cfg (updateNixPkgs args)
202+ ((),_,()) <- runRWST (updateNixPkgs args) cfg Set.empty
203+ return ()
215204
216205
217206-- Packages that we cannot parse.