@@ -8,10 +8,13 @@ import System.Directory
88import System.Environment
99import System.Exit
1010import Data.List
11+import qualified Data.Set as Set
1112import Control.Monad.State
1213import Control.Exception ( bracket )
1314import qualified Data.ByteString.Char8 as BS
1415import Text.Regex.Posix
16+import Data.Version
17+import Text.ParserCombinators.ReadP ( readP_to_S )
1518import Distribution.PackageDescription.Parse ( parsePackageDescription, ParseResult(..) )
1619import Distribution.PackageDescription ( GenericPackageDescription() )
1720import System.Console.GetOpt ( OptDescr(..), ArgDescr(..), ArgOrder(..), usageInfo, getOpt )
@@ -25,10 +28,13 @@ pack = BS.pack
2528unpack :: ByteString -> String
2629unpack = BS.unpack
2730
31+type PkgSet = Set.Set Pkg
32+
2833data Configuration = Configuration
2934 { _msgDebug :: String -> IO ()
3035 , _msgInfo :: String -> IO ()
3136 , _hackageDb :: FilePath
37+ , _pkgset :: PkgSet
3238 }
3339
3440defaultConfiguration :: Configuration
@@ -36,6 +42,7 @@ defaultConfiguration = Configuration
3642 { _msgDebug = hPutStrLn stderr
3743 , _msgInfo = hPutStrLn stderr
3844 , _hackageDb = "/dev/shm/hackage"
45+ , _pkgset = Set.empty
3946 }
4047
4148type Hackage4Nix a = StateT Configuration IO a
@@ -43,6 +50,11 @@ type Hackage4Nix a = StateT Configuration IO a
4350io :: (MonadIO m) => IO a -> m a
4451io = liftIO
4552
53+readDirectory :: FilePath -> IO [FilePath]
54+readDirectory dirpath = do
55+ entries <- getDirectoryContents dirpath
56+ return [ x | x <- entries, x /= ".", x /= ".." ]
57+
4658msgDebug, msgInfo :: String -> Hackage4Nix ()
4759msgDebug msg = get >>= \s -> io (_msgDebug s msg)
4860msgInfo msg = get >>= \s -> io (_msgInfo s msg)
@@ -65,7 +77,6 @@ badPackages =
6577
6678discoverNixFiles :: (FilePath -> Hackage4Nix ()) -> FilePath -> Hackage4Nix ()
6779discoverNixFiles yield dirOrFile
68− | takeFileName dirOrFile `elem` [".",".."] = return ()
6980 | "." `isPrefixOf` takeFileName dirOrFile = msgDebug $ "ignore file or directory " ++ dirOrFile
7081 | otherwise = do
7182 isFile <- io (doesFileExist dirOrFile)
@@ -76,11 +87,11 @@ discoverNixFiles yield dirOrFile
7687 (True,_) -> msgDebug $ "ignore file " ++ dirOrFile
7788 (False,_) -> do
7889 msgDebug ("discovered dir " ++ dirOrFile)
79− io (getDirectoryContents dirOrFile) >>= mapM_ (discoverNixFiles yield . (dirOrFile </>))
90+ io (readDirectory dirOrFile) >>= mapM_ (discoverNixFiles yield . (dirOrFile </>))
8091
8192type PkgVersion = String
8293data Pkg = Pkg PkgName PkgVersion PkgSHA256 PkgPlatforms PkgMaintainers FilePath
83− deriving (Show)
94+ deriving (Show, Eq, Ord)
8495
8596regmatch :: ByteString -> String -> Bool
8697regmatch buf patt = match (makeRegexOpts compExtended execBlank (pack patt)) buf
@@ -90,12 +101,17 @@ regsubmatch buf patt = let (_,_,_,x) = f in x
90101 where f :: (ByteString,ByteString,ByteString,[ByteString])
91102 f = match (makeRegexOpts compExtended execBlank (pack patt)) buf
92103
104+normalizeMaintainer :: String -> String
105+normalizeMaintainer x
106+ | "self.stdenv.lib.maintainers." `isPrefixOf` x = drop 28 x
107+ | otherwise = x
108+
93109parseNixFile :: FilePath -> ByteString -> Hackage4Nix (Maybe Pkg)
94110parseNixFile path buf
95111 | True <- buf `regmatch` "src = (fetchgit|sourceFromHead)"
96112 = msgDebug ("ignore non-hackage package " ++ path) >> return Nothing
97113 | True <- (pack path) `regmatch` (concat (intersperse "|" badPackages))
98− = msgInfo ("ignore known bad package " ++ path) >> return Nothing
114+ = msgDebug ("ignore known bad package " ++ path) >> return Nothing
99115 | True <- buf =~ pack "cabal.mkDerivation"
100116 , [name] <- buf `regsubmatch` "name *= *\"([^\"]+)\""
101117 , [vers] <- buf `regsubmatch` "version *= *\"([^\"]+)\""
@@ -109,12 +125,34 @@ parseNixFile path buf
109125 (unpack vers)
110126 (unpack sha)
111127 (map unpack plats')
112− (map unpack maint')
128+ (map (normalizeMaintainer . unpack) maint')
113129 (path)
114130 | True <- buf `regmatch` "cabal.mkDerivation"
115131 = msgInfo ("failed to parse file " ++ path) >> return Nothing
116132 | otherwise = return Nothing
117133
134+readVersion :: String -> Version
135+readVersion str =
136+ case [ v | (v,[]) <- readP_to_S parseVersion str ] of
137+ [ v' ] -> v'
138+ _ -> error ("invalid version specifier " ++ show str)
139+
140+selectLatestVersions :: PkgSet -> PkgSet
141+selectLatestVersions = Set.fromList . nubBy f2 . sortBy f1 . Set.toList
142+ where
143+ f1 (Pkg n1 v1 _ _ _ _) (Pkg n2 v2 _ _ _ _)
144+ | n1 == n2 = compare v2 v1
145+ | otherwise = compare n1 n2
146+ f2 (Pkg n1 _ _ _ _ _) (Pkg n2 _ _ _ _ _)
147+ = n1 == n2
148+
149+discoverUpdates :: PkgName -> PkgVersion -> Hackage4Nix [PkgVersion]
150+discoverUpdates name vers = do
151+ hackage <- gets _hackageDb
152+ versionStrings <- io $ readDirectory (hackage </> name)
153+ let versions = map readVersion versionStrings
154+ return [ showVersion v | v <- versions, v > readVersion vers ]
155+
118156updateNixPkgs :: [FilePath] -> Hackage4Nix ()
119157updateNixPkgs paths = do
120158 msgDebug $ "updating = " ++ show paths
@@ -126,6 +164,35 @@ updateNixPkgs paths = do
126164 msgDebug ("re-generate " ++ path)
127165 pkg <- readCabalFile name vers
128166 io $ writeFile path (showNixPkg (cabal2nix pkg sha plats maints))
167+ modify $ \cfg -> cfg { _pkgset = Set.insert nix (_pkgset cfg) }
168+ pkgset <- gets (selectLatestVersions . _pkgset)
169+ updates' <- flip mapM (Set.elems pkgset) $ \pkg -> do
170+ let Pkg name vers _ _ _ _ = pkg
171+ updates <- discoverUpdates name vers
172+ return (pkg,updates)
173+ let updates = [ u | u@(_,(_:_)) <- updates' ]
174+ when (not (null updates)) $ do
175+ msgInfo "The following updates are available:"
176+ flip mapM_ updates $ \(pkg,versions) -> do
177+ let Pkg name vers _ plats maints path = pkg
178+ msgInfo ""
179+ msgInfo $ name ++ "-" ++ vers ++ ":"
180+ flip mapM_ versions $ \newVersion -> do
181+ msgInfo $ " " ++ genCabal2NixCmdline (Pkg name newVersion undefined plats maints path)
182+ return ()
183+
184+genCabal2NixCmdline :: Pkg -> String
185+genCabal2NixCmdline (Pkg name vers _ plats maints path) = unwords $ ["cabal2nix"] ++ opts ++ [">"++path']
186+ where
187+ opts = [cabal] ++ maints' ++ plats'
188+ cabal = "cabal://" ++ name ++ "-" ++ vers
189+ maints' = [ "--maintainer=" ++ m | m <- maints ]
190+ plats'
191+ | ["self.ghc.meta.platforms"] == plats = []
192+ | otherwise = [ "--platform=" ++ p | p <- plats ]
193+ path'
194+ | takeFileName path == "default.nix" = path
195+ | otherwise = replaceFileName path (vers <.> "nix")
129196
130197data CliOption = PrintHelp | Verbose | HackageDB FilePath
131198 deriving (Eq)