@@ -0,0 +1,174 @@
1+{-# LANGUAGE OverloadedStrings, PatternGuards #-}
2+
3+module Main ( main ) where
4+
5+import System.IO
6+import System.FilePath
7+import System.Directory
8+import System.Environment
9+import System.Exit
10+import Data.List
11+import Control.Monad.State
12+import Control.Exception ( bracket )
13+import qualified Data.ByteString.Char8 as BS
14+import Text.Regex.Posix
15+import Distribution.PackageDescription.Parse ( parsePackageDescription, ParseResult(..) )
16+import Distribution.PackageDescription ( GenericPackageDescription() )
17+import System.Console.GetOpt ( OptDescr(..), ArgDescr(..), ArgOrder(..), usageInfo, getOpt )
18+import Cabal2Nix.Package ( cabal2nix, showNixPkg, PkgName, PkgSHA256, PkgPlatforms, PkgMaintainers )
19+
20+type ByteString = BS.ByteString
21+
22+pack :: String -> ByteString
23+pack = BS.pack
24+
25+unpack :: ByteString -> String
26+unpack = BS.unpack
27+
28+data Configuration = Configuration
29+ { _msgDebug :: String -> IO ()
30+ , _msgInfo :: String -> IO ()
31+ , _hackageDb :: FilePath
32+ }
33+
34+defaultConfiguration :: Configuration
35+defaultConfiguration = Configuration
36+ { _msgDebug = hPutStrLn stderr
37+ , _msgInfo = hPutStrLn stderr
38+ , _hackageDb = "/dev/shm/hackage"
39+ }
40+
41+type Hackage4Nix a = StateT Configuration IO a
42+
43+io :: (MonadIO m) => IO a -> m a
44+io = liftIO
45+
46+msgDebug, msgInfo :: String -> Hackage4Nix ()
47+msgDebug msg = get >>= \s -> io (_msgDebug s msg)
48+msgInfo msg = get >>= \s -> io (_msgInfo s msg)
49+
50+readCabalFile :: String -> String -> Hackage4Nix GenericPackageDescription
51+readCabalFile name vers = do
52+ hackageDir <- gets _hackageDb
53+ let cabal = hackageDir </> name </> vers </> name <.> "cabal"
54+ pkg' <- fmap parsePackageDescription (io (readFile cabal))
55+ pkg <- case pkg' of
56+ ParseOk _ a -> return a
57+ ParseFailed err -> fail ("cannot parse cabal file " ++ cabal ++ ": " ++ show err)
58+ return pkg
59+
60+badPackages :: [String]
61+badPackages =
62+ [ "haskell-platform"
63+ , "flapjax"
64+ ]
65+
66+discoverNixFiles :: (FilePath -> Hackage4Nix ()) -> FilePath -> Hackage4Nix ()
67+discoverNixFiles yield dirOrFile
68+ | takeFileName dirOrFile `elem` [".",".."] = return ()
69+ | "." `isPrefixOf` takeFileName dirOrFile = msgDebug $ "ignore file or directory " ++ dirOrFile
70+ | otherwise = do
71+ isFile <- io (doesFileExist dirOrFile)
72+ case (isFile, takeExtension dirOrFile) of
73+ (True,".nix") -> do
74+ msgDebug ("discovered file " ++ dirOrFile)
75+ yield dirOrFile
76+ (True,_) -> msgDebug $ "ignore file " ++ dirOrFile
77+ (False,_) -> do
78+ msgDebug ("discovered dir " ++ dirOrFile)
79+ io (getDirectoryContents dirOrFile) >>= mapM_ (discoverNixFiles yield . (dirOrFile </>))
80+
81+type PkgVersion = String
82+data Pkg = Pkg PkgName PkgVersion PkgSHA256 PkgPlatforms PkgMaintainers FilePath
83+ deriving (Show)
84+
85+regmatch :: ByteString -> String -> Bool
86+regmatch buf patt = match (makeRegexOpts compExtended execBlank (pack patt)) buf
87+
88+regsubmatch :: ByteString -> String -> [ByteString]
89+regsubmatch buf patt = let (_,_,_,x) = f in x
90+ where f :: (ByteString,ByteString,ByteString,[ByteString])
91+ f = match (makeRegexOpts compExtended execBlank (pack patt)) buf
92+
93+parseNixFile :: FilePath -> ByteString -> Hackage4Nix (Maybe Pkg)
94+parseNixFile path buf
95+ | True <- buf `regmatch` "src = (fetchgit|sourceFromHead)"
96+ = msgDebug ("ignore non-hackage package " ++ path) >> return Nothing
97+ | True <- (pack path) `regmatch` (concat (intersperse "|" badPackages))
98+ = msgInfo ("ignore known bad package " ++ path) >> return Nothing
99+ | True <- buf =~ pack "cabal.mkDerivation"
100+ , [name] <- buf `regsubmatch` "name *= *\"([^\"]+)\""
101+ , [vers] <- buf `regsubmatch` "version *= *\"([^\"]+)\""
102+ , [sha] <- buf `regsubmatch` "sha256 *= *\"([^\"]+)\""
103+ , plats <- buf `regsubmatch` "platforms *= *([^;]+);"
104+ , maint <- buf `regsubmatch` "maintainers *= *\\[([^\"]+)]"
105+ = let plats' = concatMap BS.words (map (BS.map (\c -> if c == '+' then ' ' else c)) plats)
106+ maint' = concatMap BS.words maint
107+ in
108+ return $ Just $ Pkg (unpack name)
109+ (unpack vers)
110+ (unpack sha)
111+ (map unpack plats')
112+ (map unpack maint')
113+ (path)
114+ | True <- buf `regmatch` "cabal.mkDerivation"
115+ = msgInfo ("failed to parse file " ++ path) >> return Nothing
116+ | otherwise = return Nothing
117+
118+updateNixPkgs :: [FilePath] -> Hackage4Nix ()
119+updateNixPkgs paths = do
120+ msgDebug $ "updating = " ++ show paths
121+ flip mapM_ paths $ \fileOrDir ->
122+ flip discoverNixFiles fileOrDir $ \file -> do
123+ nix' <- io (BS.readFile file) >>= parseNixFile file
124+ flip (maybe (return ())) nix' $ \nix -> do
125+ let Pkg name vers sha plats maints path = nix
126+ msgDebug ("re-generate " ++ path)
127+ pkg <- readCabalFile name vers
128+ io $ writeFile path (showNixPkg (cabal2nix pkg sha plats maints))
129+
130+data CliOption = PrintHelp | Verbose | HackageDB FilePath
131+ deriving (Eq)
132+
133+main :: IO ()
134+main = bracket (return ()) (\() -> hFlush stdout >> hFlush stderr) $ \() -> do
135+ let options :: [OptDescr CliOption]
136+ options =
137+ [ Option ['h'] ["help"] (NoArg PrintHelp) "show this help text"
138+ , Option ['v'] ["verbose"] (NoArg Verbose) "enable noisy debug output"
139+ , Option [] ["hackage"] (ReqArg HackageDB "HACKAGE-DIR") "path to hackage database"
140+ ]
141+
142+ usage :: String
143+ usage = usageInfo "Usage: hackage4nix [options] [dir-or-file ...]" options ++
144+ "\n\
145+ \The purpose of 'hackage4nix' is to keep all Haskell packages in our\n\
146+ \repository packages up-to-date. It scans a checked-out copy of\n\
147+ \Nixpkgs for expressions that use 'cabal.mkDerivation', and\n\
148+ \re-generates them in-place with cabal2nix.\n\
149+ \\n\
150+ \Because we don't want to generate a barrage of HTTP requests during\n\
151+ \that procedure, the tool expects a copy of the Hackage database\n\
152+ \available at some local path, i.e. \"/dev/shm/hackage\" by default.\n\
153+ \That directory can be set up as follows:\n\
154+ \\n\
155+ \ cabal update\n\
156+ \ mkdir -p /dev/shm/hackage\n\
157+ \ tar xf ~/.cabal/packages/hackage.haskell.org/00-index.tar -C /dev/shm/hackage\n"
158+
159+ cmdlineError :: String -> IO a
160+ cmdlineError "" = hPutStrLn stderr usage >> exitFailure
161+ cmdlineError errMsg = hPutStrLn stderr errMsg >> cmdlineError ""
162+
163+ args' <- getArgs
164+ (opts,args) <- case getOpt Permute options args' of
165+ (o,n,[] ) -> return (o,n)
166+ (_,_,errs) -> cmdlineError (concatMap (\e -> '*':'*':'*':' ':e) errs)
167+
168+ when (PrintHelp `elem` opts) (cmdlineError "")
169+
170+ let cfg = defaultConfiguration
171+ { _msgDebug = if Verbose `elem` opts then _msgDebug defaultConfiguration else const (return ())
172+ , _hackageDb = last $ _hackageDb defaultConfiguration : [ p | HackageDB p <- opts ]
173+ }
174+ flip evalStateT cfg (updateNixPkgs args)