git.iko.soy/typeable/cabal2nix
on master help sign in
Hackage4Nix: re-use hackage-db library
2a7437bPeter Simons
cabal2nix.cabal+2−1
@@ -61,7 +61,8 @@ Executable hackage4nix
61 main-is: Hackage4Nix.hs
61 main-is: Hackage4Nix.hs
62 hs-source-dirs: src
62 hs-source-dirs: src
63 Build-Depends: base >= 3 && < 5, regex-posix, pretty, Cabal >= 1.8,
63 Build-Depends: base >= 3 && < 5, regex-posix, pretty, Cabal >= 1.8,
64− mtl, containers, directory, filepath, nixos-types
64+ mtl, containers, directory, filepath, nixos-types,
65+ hackage-db
65 Extensions: PatternGuards, RecordWildCards, CPP
66 Extensions: PatternGuards, RecordWildCards, CPP
66 Ghc-Options: -Wall
67 Ghc-Options: -Wall
67 other-modules: Cabal2Nix.CorePackages
68 other-modules: Cabal2Nix.CorePackages
src/Hackage4Nix.hs+41−52
@@ -1,25 +1,26 @@
1module Main ( main ) where
1module Main ( main ) where
2
2
3−import System.IO
3+import Cabal2Nix.Normalize
4−import System.FilePath
4+import Cabal2Nix.Package
5−import System.Directory
5+import Control.Exception ( bracket )
6−import System.Environment
6+import Control.Monad.RWS
7−import System.Exit
8import Data.List
7import Data.List
8+import Data.Maybe
9import qualified Data.Set as Set
9import qualified Data.Set as Set
10−import Control.Monad.State
11−import Control.Exception ( bracket )
12−import Text.Regex.Posix
13import Data.Version
10import 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
15import Distribution.Package
14import Distribution.Package
16import Distribution.PackageDescription ( GenericPackageDescription() )
15import Distribution.PackageDescription ( GenericPackageDescription() )
17import Distribution.Text
16import Distribution.Text
18import System.Console.GetOpt ( OptDescr(..), ArgDescr(..), ArgOrder(..), usageInfo, getOpt )
17import System.Console.GetOpt ( OptDescr(..), ArgDescr(..), ArgOrder(..), usageInfo, getOpt )
19−import Cabal2Nix.Package
18+import System.Directory
20−import Cabal2Nix.Normalize
19+import System.Environment
21−import Distribution.NixOS.Derivation.Cabal
20+import System.Exit
22−import Distribution.NixOS.Derivation.Meta
21+import System.FilePath
22+import System.IO
23+import Text.Regex.Posix
23
24
24data Pkg = Pkg Derivation FilePath Bool
25data Pkg = Pkg Derivation FilePath Bool
25 deriving (Show, Eq, Ord)
26 deriving (Show, Eq, Ord)
@@ -29,7 +30,7 @@ type PkgSet = Set.Set Pkg
29data Configuration = Configuration
30data Configuration = Configuration
30 { _msgDebug :: String -> IO ()
31 { _msgDebug :: String -> IO ()
31 , _msgInfo :: String -> IO ()
32 , _msgInfo :: String -> IO ()
32− , _hackageDb :: FilePath
33+ , _hackageDb :: DB.Hackage
33 , _pkgset :: PkgSet
34 , _pkgset :: PkgSet
34 }
35 }
35
36
@@ -37,11 +38,11 @@ defaultConfiguration :: Configuration
37defaultConfiguration = Configuration
38defaultConfiguration = Configuration
38 { _msgDebug = hPutStrLn stderr
39 { _msgDebug = hPutStrLn stderr
39 , _msgInfo = hPutStrLn stderr
40 , _msgInfo = hPutStrLn stderr
40− , _hackageDb = "/dev/shm/hackage"
41+ , _hackageDb = DB.empty
41 , _pkgset = Set.empty
42 , _pkgset = Set.empty
42 }
43 }
43
44
44−type Hackage4Nix a = StateT Configuration IO a
45+type Hackage4Nix a = RWST Configuration () PkgSet IO a
45
46
46io :: (MonadIO m) => IO a -> m a
47io :: (MonadIO m) => IO a -> m a
47io = liftIO
48io = liftIO
@@ -52,18 +53,17 @@ readDirectory dirpath = do
52 return [ x | x <- entries, x /= ".", x /= ".." ]
53 return [ x | x <- entries, x /= ".", x /= ".." ]
53
54
54msgDebug, msgInfo :: String -> Hackage4Nix ()
55msgDebug, msgInfo :: String -> Hackage4Nix ()
55−msgDebug msg = get >>= \s -> io (_msgDebug s msg)
56+msgDebug msg = ask >>= \s -> io (_msgDebug s msg)
56−msgInfo msg = get >>= \s -> io (_msgInfo s msg)
57+msgInfo msg = ask >>= \s -> io (_msgInfo s msg)
57−
58+
58−readCabalFile :: String -> String -> Hackage4Nix GenericPackageDescription
59+getCabalPackage :: String -> Version -> Hackage4Nix GenericPackageDescription
59−readCabalFile name vers = do
60+getCabalPackage name vers = do
60− hackageDir <- gets _hackageDb
61+ db <- asks _hackageDb
61− let cabal = hackageDir </> name </> vers </> name <.> "cabal"
62+ case DB.lookup name db of
62− pkg' <- fmap parsePackageDescription (io (readFile cabal))
63+ Just db' -> case DB.lookup vers db' of
63− pkg <- case pkg' of
64+ Just pkg -> return pkg
64− ParseOk _ a -> return a
65+ Nothing -> fail ("hackage doesn't know about " ++ name ++ " version " ++ display vers)
65− ParseFailed err -> fail ("cannot parse cabal file " ++ cabal ++ ": " ++ show err)
66+ Nothing -> fail ("hackage doesn't know about " ++ show name)
66− return pkg
67
67
68discoverNixFiles :: (FilePath -> Hackage4Nix ()) -> FilePath -> Hackage4Nix ()
68discoverNixFiles :: (FilePath -> Hackage4Nix ()) -> FilePath -> Hackage4Nix ()
69discoverNixFiles yield dirOrFile = do
69discoverNixFiles yield dirOrFile = do
@@ -77,9 +77,6 @@ regenerateDerivation :: Derivation -> String -> Bool
77regenerateDerivation deriv buf = not (pname deriv `elem` patchedPackages) &&
77regenerateDerivation deriv buf = not (pname deriv `elem` patchedPackages) &&
78 not (buf =~ "(pre|post)Configure|configureFlags|(pre|post)Install|patchPhase")
78 not (buf =~ "(pre|post)Configure|configureFlags|(pre|post)Install|patchPhase")
79
79
80−readVersion :: String -> Version
81−readVersion str = maybe (error $ "cannot parse version " ++ show str) id (simpleParse str)
82−
83parseNixFile :: FilePath -> String -> Hackage4Nix (Maybe Pkg)
80parseNixFile :: FilePath -> String -> Hackage4Nix (Maybe Pkg)
84parseNixFile path buf
81parseNixFile path buf
85 | not (buf =~ "cabal.mkDerivation")
82 | not (buf =~ "cabal.mkDerivation")
@@ -100,12 +97,11 @@ selectLatestVersions = Set.fromList . nubBy f2 . sortBy f1 . Set.toList
100 | otherwise = compare (pname deriv1) (pname deriv2)
97 | otherwise = compare (pname deriv1) (pname deriv2)
101 f2 (Pkg deriv1 _ _) (Pkg deriv2 _ _) = pname deriv1 == pname deriv2
98 f2 (Pkg deriv1 _ _) (Pkg deriv2 _ _) = pname deriv1 == pname deriv2
102
99
103−discoverUpdates :: String -> String -> Hackage4Nix [String]
100+discoverUpdates :: String -> Version -> Hackage4Nix [Version]
104discoverUpdates name vers = do
101discoverUpdates name vers = do
105− hackage <- gets _hackageDb
102+ db <- asks _hackageDb
106− versionStrings <- io $ readDirectory (hackage </> name)
103+ let versions = DB.keys (fromJust (DB.lookup name db))
107− let versions = map readVersion versionStrings
104+ return (filter (>vers) versions)
108− return [ showVersion v | v <- versions, v > readVersion vers ]
109
105
110updateNixPkgs :: [FilePath] -> Hackage4Nix ()
106updateNixPkgs :: [FilePath] -> Hackage4Nix ()
111updateNixPkgs paths = do
107updateNixPkgs paths = do
@@ -117,10 +113,10 @@ updateNixPkgs paths = do
117 let Pkg deriv path regenerate = nix
113 let Pkg deriv path regenerate = nix
118 maints = maintainers (metaSection deriv)
114 maints = maintainers (metaSection deriv)
119 plats = platforms (metaSection deriv)
115 plats = platforms (metaSection deriv)
120− modify $ \cfg -> cfg { _pkgset = Set.insert nix (_pkgset cfg) }
116+ modify (Set.insert nix)
121 when regenerate $ do
117 when regenerate $ do
122 msgDebug ("re-generate " ++ path)
118 msgDebug ("re-generate " ++ path)
123− pkg <- readCabalFile (pname deriv) (display (version deriv))
119+ pkg <- getCabalPackage (pname deriv) (version deriv)
124 let deriv' = (cabal2nix pkg) { sha256 = sha256 deriv, runHaddock = runHaddock deriv }
120 let deriv' = (cabal2nix pkg) { sha256 = sha256 deriv, runHaddock = runHaddock deriv }
125 meta = metaSection deriv'
121 meta = metaSection deriv'
126 plats' = if null plats then platforms meta else plats
122 plats' = if null plats then platforms meta else plats
@@ -130,10 +126,10 @@ updateNixPkgs paths = do
130 }
126 }
131 }
127 }
132 io $ writeFile path (show (disp (normalize (deriv''))))
128 io $ writeFile path (show (disp (normalize (deriv''))))
133− pkgset <- gets (selectLatestVersions . _pkgset)
129+ pkgset <- asks (selectLatestVersions . _pkgset)
134 updates' <- flip mapM (Set.elems pkgset) $ \pkg -> do
130 updates' <- flip mapM (Set.elems pkgset) $ \pkg -> do
135 let Pkg deriv _ _ = pkg
131 let Pkg deriv _ _ = pkg
136− updates <- discoverUpdates (pname deriv) (display (version deriv))
132+ updates <- discoverUpdates (pname deriv) (version deriv)
137 return (pkg,updates)
133 return (pkg,updates)
138 let updates = [ u | u@(_,(_:_)) <- updates' ]
134 let updates = [ u | u@(_,(_:_)) <- updates' ]
139 when (not (null updates)) $ do
135 when (not (null updates)) $ do
@@ -143,7 +139,7 @@ updateNixPkgs paths = do
143 msgInfo ""
139 msgInfo ""
144 msgInfo $ (display (packageId deriv)) ++ ":"
140 msgInfo $ (display (packageId deriv)) ++ ":"
145 flip mapM_ versions $ \newVersion -> do
141 flip mapM_ versions $ \newVersion -> do
146− let deriv' = deriv { version = readVersion newVersion }
142+ let deriv' = deriv { version = newVersion }
147 msgInfo $ " " ++ genCabal2NixCmdline (Pkg deriv' path regenerate)
143 msgInfo $ " " ++ genCabal2NixCmdline (Pkg deriv' path regenerate)
148 return ()
144 return ()
149
145
@@ -185,15 +181,6 @@ main = bracket (return ()) (\() -> hFlush stdout >> hFlush stderr) $ \() -> do
185 , "repository packages up-to-date. It scans a checked-out copy of"
181 , "repository packages up-to-date. It scans a checked-out copy of"
186 , "Nixpkgs for expressions that use 'cabal.mkDerivation', and"
182 , "Nixpkgs for expressions that use 'cabal.mkDerivation', and"
187 , "re-generates them in-place with cabal2nix."
183 , "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"
197 ]
184 ]
198
185
199 cmdlineError :: String -> IO a
186 cmdlineError :: String -> IO a
@@ -207,11 +194,13 @@ main = bracket (return ()) (\() -> hFlush stdout >> hFlush stderr) $ \() -> do
207
194
208 when (PrintHelp `elem` opts) (cmdlineError "")
195 when (PrintHelp `elem` opts) (cmdlineError "")
209
196
197+ hackage <- DB.readHackage
210 let cfg = defaultConfiguration
198 let cfg = defaultConfiguration
211 { _msgDebug = if Verbose `elem` opts then _msgDebug defaultConfiguration else const (return ())
199 { _msgDebug = if Verbose `elem` opts then _msgDebug defaultConfiguration else const (return ())
212− , _hackageDb = last $ _hackageDb defaultConfiguration : [ p | HackageDB p <- opts ]
200+ , _hackageDb = hackage
213 }
201 }
214− flip evalStateT cfg (updateNixPkgs args)
202+ ((),_,()) <- runRWST (updateNixPkgs args) cfg Set.empty
203+ return ()
215
204
216
205
217-- Packages that we cannot parse.
206-- Packages that we cannot parse.