archlinux-web (empty) → 0.1
raw patch · 10 files changed
+1108/−0 lines, 10 filesdep +Cabaldep +HTTPdep +archlinuxsetup-changed
Dependencies added: Cabal, HTTP, archlinux, base, containers, csv, deepseq, directory, filepath, json, old-time, parallel, pretty, prettyclass, process, strict-concurrency, xhtml
Files
- Distribution/ArchLinux/AUR.hs +333/−0
- Distribution/ArchLinux/Report.hs +378/−0
- LICENSE +30/−0
- Setup.lhs +3/−0
- archlinux-web.cabal +150/−0
- scripts/arch-report.hs +24/−0
- scripts/distro-map.hs +155/−0
- scripts/get-arch-url.hs +16/−0
- scripts/mypackages.hs +12/−0
- scripts/update-aur-log.hs +7/−0
+ Distribution/ArchLinux/AUR.hs view
@@ -0,0 +1,333 @@+-- |+-- Module : Distribution.ArchLinux.AUR+-- Copyright : (c) 2009 Don Stewart+-- License : BSD3+-- Maintainer : Don Stewart+--+-- Support for querying the AUR database.+--+module Distribution.ArchLinux.AUR (+ AURInfo(..),+ info,+ search,+ maintainer,+ package++ ) where++{-+The methods currently allowed are:++ * search+ * info++Each method requires the following HTTP GET syntax:+ type=methodname&arg=data++Where methodname is the name of an allowed method, and data is the argument to the call.++If you need jsonp type callback specification, you can provide an additional variable callback.+Example URL:+ http://aur-url/rpc.php?type=search&arg=foobar&callback=jsonp1192244621103+-}++import Network.HTTP+import Distribution.Version+import Distribution.Text+import Text.JSON+import Text.JSON.String+import Text.PrettyPrint+import Text.PrettyPrint.HughesPJClass+import qualified Data.Map as M+import Control.Monad+import System.FilePath+import Data.List+import Data.Char++import Distribution.ArchLinux.PkgBuild++------------------------------------------------------------------------++-- | Query AUR for information on a package +--+-- > $ info "xmonad"+-- >+-- > Right (AURInfo { packageID = 10593+-- > , packageName = "xmonad"+-- > , packageVersion = Right (Version {versionBranch = [0,8,1] , versionTags = []},"1.2")i+-- > , packageCategory = 17+-- > , packageDesc = "A lightweight X11 tiled window manager written in Haskell"+-- > , packageLocation = 3+-- > , packageURL = "http://xmonad.org/"+-- > , packagePath = "/packages/xmonad/xmonad.tar.gz"+-- > , packageLicense = "custom:BSD3"+-- > , packageVotes = 260+-- > , packageOutOfDate = False })+--+info :: String -> IO (Either String AURInfo)+info m = eval (InfoRequest (Name m))++-- | Search AUR for packages matching pattern. Returns a list of info results.+search :: String -> IO [AURInfo]+search m = do+ v <- eval (SearchRequest (Name m))+ return $ case v of+ Left e -> []+ Right a -> flatten a++-- | Search AUR for packages owned by maintainer. Returns a list of info results.+maintainer :: String -> IO [AURInfo]+maintainer m = do+ v <- eval (MaintainerRequest (Name m))+ return $ case v of+ Left e -> []+ Right a -> maintainerPackages a++------------------------------------------------------------------------+--+-- TODO: programmatically list all packages by arch-haskell+-- generate table of versions.+-- colour out of date things.+--++-- | Return the parsed PKGBUILD+-- pkgbuild :: String -> IO (Either String [String]) -- (Either String PkgBuild)++package :: String -> IO (Either String AURInfo, Either String AnnotatedPkgBuild)+package m = do+ v <- info m+ case v of+ Left s -> return $ (Left s, Left "No PKGBUILD found")+ Right p -> do+ let name = packageName p+ aurUrl = "http://aur.archlinux.org/packages" </> name </> name </> "PKGBUILD"++ rsp <- simpleHTTP (getRequest aurUrl)+ case rsp of+ Left err -> return $ (Right p, Left (show err))+ Right _ -> do+ pkg <- getResponseBody rsp -- TODO 404+ case decodePackage pkg of+ Left e -> return (Right p, Left e)+ Right k -> return (Right p, Right k)++------------------------------------------------------------------------+--+-- TODO:+-- generate report on packages. groupBy+--++-- | List packages not built with up to date version of cabal2arch+{-+lint_cabal2arch = do+ aurs <- search "haskell"+ forM_ aurs $ \aur -> do+ let n = packageName aur+ k <- pkgbuild n+ case k of+ Left _ -> putStrLn $ "No pkgbuild for" ++ packageName aur+ Right p -> do++ case cabal2arch_version p of+ v | v == simpleParse "0.6"+ -> putStrLn $ "GOOD " ++ packageName aur ++ v -> do putStrLn $ "Missing cabal2arch version for: " ++ packageName aur ++ " " ++ show v+ putStrLn $ "http://aur.archlinux.org/packages.php?ID=" ++ show ( packageID aur)+ putStrLn ""+-}++------------------------------------------------------------------------+--+-- TODO: from the packagename, construct the url to the AUR page.+--++-- | URL for AUR RPC server+url :: Doc+url = text "http://aur.archlinux.org/rpc.php"++-- | Query the server+eval :: JSON a => AURRequest -> IO (Either String a)+eval m = do+ rsp <- simpleHTTP (getRequest call)+ json <- getResponseBody rsp+ return . resultToEither . decode $ json+ where+ call = render $ url <?> pPrint m++------------------------------------------------------------------------+-- RPC requests++-- | Type for AUR RPC requests. They can be info queries, or search queries.+--+data AURRequest+ = SearchRequest Name+ | MaintainerRequest Name+ | InfoRequest Name+ deriving Show++instance Pretty AURRequest where+ pPrint (SearchRequest n) = text "type" <=> text "search" <&> text "arg" <=> pPrint n+ pPrint (InfoRequest n) = text "type" <=> text "info" <&> text "arg" <=> pPrint n+ pPrint (MaintainerRequest n) = text "type" <=> text "msearch" <&> text "arg" <=> pPrint n++-- | Wrap up a package name a bit safely.+newtype Name = Name String+ deriving Show++instance Pretty Name where+ pPrint (Name n) = text n++-- | Useful combinators+infixl 6 <=>, <&>, <?>++(<=>), (<&>), (<?>) :: Doc -> Doc -> Doc+p <=> q = p <> char '=' <> q+p <&> q = p <> char '&' <> q+p <?> q = p <> char '?' <> q++------------------------------------------------------------------------+-- RPC response values++-- We can in turn use this info to query PKGBUILDs on the server++-- | A type for maintainer search.+data AURMaintainer = AURMaintainer { maintainerPackages :: [AURInfo] } deriving Show++instance JSON AURMaintainer where+ showJSON = undefined++ readJSON (JSObject o) = do+ -- sanity check:+ case M.lookup "type" json of+ Just (JSString t) | fromJSString t == "msearch" -> do+ as <- forM results $ \(JSObject o) -> do+ let obj = M.fromList (fromJSObject o) :: M.Map String JSValue+ parseInfo obj++ return (AURMaintainer as)++ s -> fail $ "No type field in JSON response!" ++ show s++ where+ json = M.fromList (fromJSObject o) :: M.Map String JSValue+ results = case M.lookup "results" json of+ Nothing -> error $ "No results for info object"+ Just (JSArray a) -> a -- a list.++------------------------------------------------------------------------++-- | Type for AUR RPC responses.+data AURInfo+ = AURInfo {+ packageID :: Integer -- ^ unique ID of the package on AUR+ ,packageURLinAUR :: String -- ^ url of AUR package+ ,packageName :: String -- ^ string name of package+ ,packageVersion :: Either String (Version,String) -- ^ either the AUR version (version,rev) or a string+ ,packageCategory :: Integer -- ^ numeric category of the package (e.g. 17 == System)+ ,packageDesc :: String -- ^ package synopsis+ ,packageLocation :: Integer -- ^ which repository is it stored in (community, AUR etc)+ ,packageURL :: String -- ^ url (sanity check: should be hackage url mostly)+ ,packagePath :: FilePath -- ^ url path to package source.+ ,packageLicense :: String -- ^ type of license+ ,packageVotes :: Integer -- ^ votes on package+ ,packageOutOfDate :: Bool -- ^ is the package flagged as out of date+ }++ deriving Show++instance JSON AURInfo where+ showJSON = undefined++ readJSON (JSObject o) = do+ -- sanity check:+ case M.lookup "type" json of+ Just (JSString t) | fromJSString t == "info" -> parseInfo results+ s -> fail $ "No type field in JSON response!" ++ show s+ where+ json = M.fromList (fromJSObject o) :: M.Map String JSValue++ results = case M.lookup "results" json of+ Nothing -> error $ "No results for info object"+ Just (JSObject o) -> M.fromList (fromJSObject o) :: M.Map String JSValue++-- Need a different JSON instance+data AURSearch = AURSearch { flatten :: [AURInfo] }++-- A list of results+instance JSON AURSearch where+ showJSON = undefined++ readJSON (JSObject o) = do+ -- sanity check:+ case M.lookup "type" json of+ Just (JSString t) | fromJSString t == "search" -> do+ as <- forM results $ \(JSObject o) -> do+ let obj = M.fromList (fromJSObject o) :: M.Map String JSValue+ parseInfo obj++ return (AURSearch as)++ s -> fail $ "No type field in JSON response!" ++ show s++ where+ json = M.fromList (fromJSObject o) :: M.Map String JSValue+ results = case M.lookup "results" json of+ Nothing -> error $ "No results for info object"+ Just (JSArray a) -> a -- a list.+++-- | Parse a AURInfo.+parseInfo :: M.Map String JSValue -> Result AURInfo+parseInfo info_obj = do+ JSString id_ <- label "ID"+ JSString name_ <- label "Name"+ JSString vers_ <- label "Version"+ JSString cat_ <- label "CategoryID"+ JSString desc_ <- label "Description"+ JSString loc_ <- label "LocationID"+ JSString url_ <- label "URL"+ JSString path_ <- label "URLPath"+ JSString lic_ <- label "License"+ JSString vote_ <- label "NumVotes"+ JSString date_ <- label "OutOfDate"++ let vers__ = fromJSString vers_+ (x,xs) = break (== '-') vers__+ version | '-' `elem` vers__ = case simpleParse x of+ Nothing -> Left vers__+ Just v -> Right (v, tail xs)+ | otherwise = Left vers__++ id_ident = read (fromJSString id_)++ return $ AURInfo {+ packageID = id_ident+ ,packageURLinAUR = "http://aur.archlinux.org/packages.php?ID=" ++ show id_ident+ ,packageName = fromJSString name_+ ,packageVersion = version+ ,packageCategory = read (fromJSString cat_)+ ,packageDesc = fromJSString desc_+ ,packageLocation = read (fromJSString loc_)+ ,packageURL = fromJSString url_ -- TODO : should be hackage url+ ,packagePath = fromJSString path_ -- TODO : should be hackage url+ ,packageLicense = fromJSString lic_ -- TODO : should be hackage url+ ,packageVotes = read (fromJSString vote_)+ ,packageOutOfDate = case fromJSString date_ of+ "0" -> False+ _ -> True+ }+ where++ label k = case M.lookup k info_obj of+ Nothing -> fail $ "No field " ++ show k+ Just o -> return o++++{-+JSObject (JSONObject {fromJSObject = [("type",JSString (JSONString {fromJSString = "info"})),("results",JSObject (JSONObject {fromJSObject = [("ID",JSString (JSONString {fromJSString = "10593"})),("Name",JSString (JSONString {fromJSString = "xmonad"})),("Version",JSString (JSONString {fromJSString = "0.8.1-1.2"})),("CategoryID",JSString (JSONString {fromJSString = "17"})),("Description",JSString (JSONString {fromJSString = "A lightweight X11 tiled window manager written in Haskell"})),("LocationID",JSString (JSONString {fromJSString = "3"})),("URL",JSString (JSONString {fromJSString = "http://xmonad.org/"})),("URLPath",JSString (JSONString {fromJSString = "/packages/xmonad/xmonad.tar.gz"})),("License",JSString (JSONString {fromJSString = "custom:BSD3"})),("NumVotes",JSString (JSONString {fromJSString = "259"})),("OutOfDate",JSString (JSONString {fromJSString = "0"}))]}))]})+Right ()+-}++------------------------------------------------------------------------
+ Distribution/ArchLinux/Report.hs view
@@ -0,0 +1,378 @@+{-# LANGUAGE FlexibleInstances #-}+-- | Construct reports about a set of packages in AUR+--+module Distribution.ArchLinux.Report (+ report , loadPackageIndex+ ) where++import Distribution.ArchLinux.AUR+import Distribution.ArchLinux.PkgBuild+import Distribution.ArchLinux.CabalTranslation (oldCabal2Arch)++import Distribution.Text+import Control.DeepSeq++import System.FilePath+import Data.Maybe++import Text.XHtml.Transitional+import Control.OldException+import Control.Monad+import Data.List+import Data.Ord+import Data.Char++import System.Directory+import System.Environment+import System.Exit+import System.FilePath+import Control.Concurrent (forkIO)+import Control.Concurrent.Chan.Strict+import Control.Concurrent.MVar.Strict+import qualified Control.OldException as C+import System.IO+import System.Process+import System.Time+import GHC.Conc (numCapabilities)+import Text.Printf+import Control.Parallel.Strategies++import Distribution.Version+import qualified Data.Map as M++import Text.CSV+import Network.HTTP++instance NFData (IO a) where rnf x = ()++instance NFData Version where rnf x = x `seq` ()+instance NFData AURInfo where rnf x = x `seq` ()+instance NFData AnnotatedPkgBuild where rnf x = x `seq` ()++-- Parallel work queue, similar to forM+--+parM tests f = do+ let n = numCapabilities+ chan <- newChan+ ps <- getChanContents chan -- results+ work <- newMVar tests -- where to take jobs from+ let m = n * 64+ forM_ [1..m] $ forkIO . thread work chan -- how many threads to fork++ -- wait on i threads to close+ -- logging them as they go+ let wait xs i acc+ | i >= m = return acc -- done+ | otherwise = case xs of+ Nothing : xs -> wait xs (i+1) acc+ Just (s,a) : xs -> do a ; wait xs i (s : acc)+ wait ps 0 []++ where+ -- thread :: MVar [Test] -> Chan (Maybe String) -> Int -> IO ()+ thread work chan me = loop+ where+ loop = do+ job <- modifyMVar work $ \jobs -> return $ case jobs of+ [] -> ([], Nothing)+ (j:js) -> (js, Just j)+ case job of+ Nothing -> writeChan chan Nothing -- done+ Just name -> do+ v <- f name+ writeChan chan . Just $ (v, printf "%d: %-25s\n" me name)+ loop+++-- | Take as input a list of package names, return an html page+-- with interesting facts about the state of the packages.+--+report :: [String] -> IO String+report xs = do+ -- load current index.+ putStr "Loading package index ... " >> hFlush stdout+ index <- loadPackageIndex+ downloads <- loadHackageDownloads+ builds <- loadBuildStatus+ putStrLn "Done."++ -- collect sets of results+ res_ <- parM (nub xs) $ \p -> do+ handle (\s -> return (p, Nothing, (Left (show s), Left []))) $ do+ k <- package p++ -- if there is a hackage path, lookup version.+ -- cabal info xmonad -v0+ vers <- case k of++ (Right aur, _) | not (null (packageURL aur)) -> do+ let name = takeFileName (packageURL aur) -- haskell package name+ return $! M.lookup name index+ _ -> return Nothing++ vers `seq` k `seq` return $! (p, vers, k)++ time <- getClockTime++ let results = sortBy (\(n,x,_) (m,y,_) -> n `compare` m) res_++ return. showHtml $+ (header $+ (thetitle (toHtml "Arch Haskell Package Report")) ++++ (script ! [src "http://galois.com/~dons/sorttable.js"]) (toHtml "") ++++ ((thelink noHtml) ! [ rel "stylesheet"+ , href "http://galois.com/~dons/arch-haskell.css"+ , thetype "text/css" ])) +++++ (body $+ center ((h2 (toHtml "Arch Haskell Package Status")))+ ++++ (table $+ (tr (td (toHtml $ "Results from " ++ show time)))+ ++++ (tr (td (toHtml $ "Found " ++ show (length results) ++ " packages" )))+ )+ ++++ (scores . sortable . table $+ tr (concatHtml+ [ th . categoryTag . toHtml $ "Package"+ , th . categoryTag . toHtml $ "Hackage"+ , th . categoryTag . toHtml $ "Version"+ , th . categoryTag . toHtml $ "Latest"+ , th . categoryTag . toHtml $ "cabal2arch"+ , th . categoryTag . toHtml $ "Votes"+ , th . categoryTag . toHtml $ "Downloads"+ , th . categoryTag . toHtml $ "Description"+ ]) +++++ concatHtml++ [++ tr $ concatHtml $+ case aur_ of+ Left err ->+ [ td $ (maybe id (\n -> if n then good else bad) (M.lookup p builds)) ( toHtml p )+ , td $ bad (toHtml "No AUR entry found!")+ , td $ toHtml ""+ , td $ toHtml ""+ , td $ toHtml ""+ , td $ toHtml ""+ , td $ toHtml ""+ , td $ toHtml ""+ ]++ Right aur -> case pkg_ of++ -- Didn't find a PKGBUILD+ Left err ->+ [ td . toHtml $+ hotlink+ (packageURLinAUR aur)+ ((maybe id (\n -> if n then good else bad)+ (M.lookup p builds)) (toHtml p))++ , td .+ (if null (packageURL aur) then bad else id) . toHtml $+ hotlink+ (packageURL aur)+ (toHtml (takeFileName (packageURL aur)))++ , td $ case packageVersion aur of+ Left s -> bad $ toHtml s+ Right (v,_) -> toHtml $ display v++ , td $++ case vers of+ Nothing | packageLocation aur == 3 -> toHtml ""+ Nothing -> bad (toHtml "-")+ Just v -> case packageVersion aur of+ Left s -> toHtml (display v)+ Right (v',_) | v == v' -> toHtml (display v)+ | otherwise -> bad (toHtml (display v))++ , td $ if packageLocation aur /= 3+ then bad (toHtml "Not Found")+ else toHtml ""++ , td $ if packageVotes aur > 10+ then good $ toHtml $ show $ packageVotes aur+ else toHtml $ show $ packageVotes aur++ , td $ case M.lookup (let n = takeFileName (packageURL aur) in if null n then packageName aur else n) downloads of+ Nothing -> toHtml ""+ Just n | n >= 1000 -> good (toHtml (show n))+ | otherwise -> (toHtml (show n))++ , td $ toHtml $ packageDesc aur+ ]++ -- Found everything+ -- TODO parallelise this and remove redundancies+ Right pkg ->+ [ td . toHtml $+ hotlink+ (packageURLinAUR aur)+ ((maybe id (\n -> if n then good else bad)+ (M.lookup p builds)) (toHtml p))++ , td .+ (if null (packageURL aur) then bad else id) . toHtml $+ hotlink+ (packageURL aur)+ (toHtml (takeFileName (packageURL aur)))++ , td $+ case packageVersion aur of+ Left s -> bad $ toHtml s+ Right (v,_) -> toHtml $ display v++ , td $+ case vers of+ Nothing | packageLocation aur == 3 -> toHtml ""+ Nothing -> bad (toHtml "-")+ Just v -> case packageVersion aur of+ Left s -> toHtml (display v)+ Right (v',_) | v == v' -> toHtml (display v)+ | otherwise -> bad (toHtml (display v))++ , td $+ if oldCabal2Arch pkg+ then bad . toHtml $+ case pkgBuiltWith pkg of+ Nothing -> "Nothing"+ Just v -> display v++ else toHtml $+ case pkgBuiltWith pkg of+ Nothing -> "Nothing"+ Just v -> display v++ , td $ if packageVotes aur > 10+ then good $ toHtml $ show $ packageVotes aur+ else toHtml $ show $ packageVotes aur++ -- bug in computing real Haskell name.+ , td $ case M.lookup (let n = takeFileName (packageURL aur) in if null n then packageName aur else n) downloads of+ Nothing -> toHtml ""+ Just n | n >= 1000 -> good (toHtml (show n))+ | otherwise -> (toHtml (show n))++ , td $ toHtml $ packageDesc aur++ ]++ | (p, vers, (aur_,pkg_)) <- results+ ]+ )+ )++categoryTag x = thediv x ! [identifier "Category" ]+bad x = thediv x ! [identifier "Bad" ]+good x = thediv x ! [identifier "Best" ]+scores x = thediv x ! [identifier "Scores" ]++sortable x = x ! [theclass "sortable"]+++------------------------------------------------------------------------+--+-- Strict process reading+--+myReadProcess :: FilePath -- ^ command to run+ -> [String] -- ^ any arguments+ -> String -- ^ standard input+ -> IO (Either (ExitCode,String,String) String) -- ^ either the stdout, or an exitcode and any output++myReadProcess cmd args input = C.handle (return . handler) $ do+ (inh,outh,errh,pid) <- runInteractiveProcess cmd args Nothing Nothing++ output <- hGetContents outh+ outMVar <- newEmptyMVar+ forkIO $ (C.evaluate (length output) >> putMVar outMVar ())++ errput <- hGetContents errh+ errMVar <- newEmptyMVar+ forkIO $ (C.evaluate (length errput) >> putMVar errMVar ())++ when (not (null input)) $ hPutStr inh input+ takeMVar outMVar+ takeMVar errMVar+ ex <- C.catch (waitForProcess pid) (\_e -> return ExitSuccess)+ hClose outh+ hClose inh -- done with stdin+ hClose errh -- ignore stderr++ return $ case ex of+ ExitSuccess -> Right output+ ExitFailure _ -> Left (ex, errput, output)++ where+ handler (C.ExitException e) = Left (e,"","")+ handler e = Left (ExitFailure 1, show e, "")++------------------------------------------------------------------------+--+-- | Load a table of packag names associated with their latest versions+--+loadPackageIndex :: IO (M.Map String Version)+loadPackageIndex = do+ v <- myReadProcess "cabal" ["list", "--simple-output"] []+ case v of+ Left err -> error (show err)+ Right idx -> do++ let table :: M.Map String Version+ table = M.fromList -- last value is used. cabal prints in version order.+ [ (name, vers)+ | pkg <- lines idx+ , let (name, _:vers_) = break isSpace pkg+ , let vers = (case (simpleParse vers_) of+ Nothing -> fromJust (simpleParse "0.0")+ Just n -> n)+ ]++ return $! table++ -- Data.Map String Version+ --++------------------------------------------------------------------------+--+-- Todo : update+--++url :: String+url = "http://www.galois.com/~dons/hackage/hackage-downloads.csv"++loadHackageDownloads :: IO (M.Map String Integer)+loadHackageDownloads = do+ rsp <- simpleHTTP (getRequest url)+ case rsp of+ Left err -> error "Unable to get Hackage data"+ Right _ -> do+ idx <- getResponseBody rsp -- TODO 404+ case parseCSV "hackage.csv" idx of+ Left err -> error (show err)+ Right cvs -> do+ let+ table = M.fromList -- last value is used. cabal prints in version order.+ [ (head row+ ,read (last row))+ | row <- init (tail cvs) ]+ return $! table++filepath :: FilePath+filepath = ".build-all.log"++loadBuildStatus :: IO (M.Map String Bool)+loadBuildStatus = do+ s <- readFile filepath+ let table = M.fromList+ [ (n, read k)+ | l <- lines s+ , let [n, k] = words l+ ]++ return $! table
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2009 Don Stewart++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.++3. Neither the name of the author nor the names of his contributors+ may be used to endorse or promote products derived from this software+ without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ archlinux-web.cabal view
@@ -0,0 +1,150 @@+name: archlinux-web+version: 0.1+license: BSD3+license-file: LICENSE+author: Don Stewart <dons@galois.com>+maintainer: Don Stewart <dons@galois.com>+homepage: http://code.haskell.org/~dons/code/archlinux+category: Distribution+synopsis: Website maintenance for Arch Linux packages+description: Website maintenance for Arch Linux packages+ .+ To get info about a package:+ .+ > info "xmonad"+ .+ To find packages matching a string:+ .+ > search "xmonad"+ .+ To find packages owned by a maintainer:+ .+ > maintainer "arch-haskell"+ .+ Generate an html page of interesting facts about+ packages in AUR and Hackage.+ .+ > report ["xmonad"]+ .+ See also the cabal2arch tool <http://hackage.haskell.org/package/cabal2arch>+ for conversion between Hackage and AUR.++build-type: Simple+stability: stable+cabal-version: >= 1.8++library+ build-depends: base >= 4 && < 6,+ HTTP,+ Cabal >= 1.6,+ json,+ pretty,+ prettyclass,+ containers,+ filepath,+ xhtml,+ process,+ directory,+ parallel,+ deepseq,+ strict-concurrency,+ old-time,+ csv,+ archlinux++ exposed-modules:+ Distribution.ArchLinux.AUR+ Distribution.ArchLinux.Report++executable arch-report+ main-is: scripts/arch-report.hs+ build-depends:+ base >= 4 && < 6,+ HTTP,+ Cabal >= 1.6,+ json,+ pretty,+ prettyclass,+ containers,+ filepath,+ xhtml,+ process,+ directory,+ parallel,+ deepseq,+ strict-concurrency,+ old-time,+ csv,+ archlinux++ other-modules:+ Distribution.ArchLinux.Report+ Distribution.ArchLinux.AUR++executable distro-map+ main-is: scripts/distro-map.hs+ build-depends:+ base >= 4 && < 6,+ HTTP,+ Cabal >= 1.6,+ json,+ pretty,+ prettyclass,+ containers,+ filepath,+ xhtml,+ process,+ directory,+ parallel,+ deepseq,+ strict-concurrency,+ old-time,+ csv,+ archlinux++ other-modules:+ Distribution.ArchLinux.AUR+ Distribution.ArchLinux.Report++executable get-arch-url+ main-is: scripts/get-arch-url.hs+ build-depends:+ base >= 4 && < 6,+ HTTP,+ Cabal >= 1.6,+ json,+ pretty,+ prettyclass,+ containers,+ filepath,+ process,+ directory,+ csv,+ archlinux++ other-modules:+ Distribution.ArchLinux.AUR++executable arch-haskell-packages+ main-is: scripts/mypackages.hs+ build-depends:+ base >= 4 && < 6,+ HTTP,+ Cabal >= 1.6,+ json,+ pretty,+ prettyclass,+ containers,+ filepath,+ process,+ directory,+ csv,+ archlinux++ other-modules:+ Distribution.ArchLinux.AUR++executable update-aur-log+ main-is: scripts/update-aur-log.hs+ build-depends:+ base >= 4 && < 6
+ scripts/arch-report.hs view
@@ -0,0 +1,24 @@+import Distribution.ArchLinux.Report+import Distribution.ArchLinux.AUR+import Data.List++-- $ time ./arch-report +RTS -N4+-- compiled with -threaded.++--+-- Assumes the .build-all.log is in the current directory+-- To generate this file,+--+-- > mypackages | sort > arch-haskell-packages.txt+--++me = "arch-haskell"++main = do+ -- s <- lines `fmap` readFile "arch-haskell-packages.txt"+ packages <- maintainer me+ let s = sort $ map packageName packages++ writeFile "/tmp/arch-haskell-status.html" =<< report s+ putStrLn "scp /tmp/arch-haskell-status.html code.haskell.org:/srv/code/arch/"+
+ scripts/distro-map.hs view
@@ -0,0 +1,155 @@+import Distribution.ArchLinux.Report+import Distribution.ArchLinux.AUR+import Distribution.ArchLinux.PkgBuild++import System.FilePath+import Control.Monad++import Data.List+import Distribution.Text+import Distribution.Version++import System.Directory+import Text.Printf+import Control.DeepSeq++import GHC.Conc (numCapabilities)+import Control.Concurrent+import qualified Control.OldException as C+import Control.Concurrent.Chan+import Control.Concurrent.MVar+import Control.Parallel.Strategies+++{-+Generate the report of mappings of hackage to distro urls for Hackage+-}++k = 32++-- Parallel work queue, similar to forM+--+parM tests f = do+ let n = numCapabilities+ chan <- newChan+ ps <- getChanContents chan -- results+ work <- newMVar tests -- where to take jobs from+ forM_ [1..n*k] $ forkIO . thread work chan -- how many threads to fork++ -- wait on i threads to close+ -- logging them as they go+ let wait xs i acc+ | i >= (n*k) = return acc -- done+ | otherwise = case xs of+ Nothing : xs -> wait xs (i+1) acc+ Just (s,a) : xs -> do a ; wait xs i (s : acc)+ wait ps 0 []++ where+ -- thread :: MVar [Test] -> Chan (Maybe String) -> Int -> IO ()+ thread work chan me = loop+ where+ loop = do+ job <- modifyMVar work $ \jobs -> return $ case jobs of+ [] -> ([], Nothing)+ (j:js) -> (js, Just j)+ case job of+ Nothing -> writeChan chan Nothing -- done+ Just name -> do+ v <- f name+ writeChan chan . Just $ (v, printf "%d: %-25s\n" me name)+ loop++writer ch = do+ v <- readChan ch+ case v of+ Nothing -> return ()+ Just s -> do appendFile "cabalArchMap.txt" s+ writer ch++me = "arch-haskell"++main = do+ C.handle (\e -> return ()) (removeFile "cabalArchMap.txt")++ -- todo: replace this with call to AUR json interface.+ -- s <- lines `fmap` readFile "arch-haskell-packages.txt"+ packages <- maintainer me+ let s = sort $ map packageName packages++ -- just write out the ones we already know.+ forM community $ \p@(name, vers, url) -> do+ appendFile "cabalArchMap.txt" $ show p ++ "\n"++ -- one output writer+ out <- newChan+ forkIO $ writer out++ -- start with the Arch Package names, deriving the Cabal names, the+ -- version, and the URL to find them.+ --+ parM s $ \p -> do+ k <- info p+ case k of+ Left err -> do putStrLn $ "Couldn't find package: " ++ show p+ return ()+ Right aur -> do++ let name = takeFileName (packageURL aur)+ vers = case packageVersion aur of+ Left _ -> ""+ Right (v,_) -> display v+ url = packageURLinAUR aur++ -- (Agda,"2.2.4+dfsg","http://packages.debian.org/source/sid/agda")++ let s = show (name, vers, Just url) ++ "\n"+ rnf s `seq` writeChan out . Just $ s++ writeChan out Nothing++ putStrLn "scp cabalArchMap.txt www.galois.com:www/"++-- hand search:+--+-- http://www.archlinux.org/packages/?sort=&arch=x86_64&repo=Extra&q=haskell&last_update=&limit=all+--+community =+ [ ("xmonad", "0.9.1", Just "http://www.archlinux.org/packages/community/i686/xmonad/")++ , ("packedstring", "0.1.0.1", Just "http://www.archlinux.org/packages/extra/i686/haskell-packedstring/")+ , ("deepseq", "1.1.0.0", Just "http://www.archlinux.org/packages/extra/i686/haskell-deepseq/")+ , ("haskell-src", "1.0.1.3", Just "http://www.archlinux.org/packages/extra/i686/haskell-haskell-src/")+ , ("HUnit", "1.2.2.1", Just "http://www.archlinux.org/packages/extra/i686/haskell-hunit/")+ , ("parallel", "2.2.0.1", Just "http://www.archlinux.org/packages/extra/i686/haskell-parallel/")+ , ("QuickCheck", "2.1.0.3", Just "http://www.archlinux.org/packages/extra/i686/haskell-quickcheck/")+ , ("stm", "2.1.1.2", Just "http://www.archlinux.org/packages/extra/i686/haskell-stm/")+ , ("xhtml", "3000.2.0.1", Just "http://www.archlinux.org/packages/extra/i686/haskell-xhtml/")+ , ("extensible-exceptions", "0.1.1.0", Just "http://www.archlinux.org/packages/extra/i686/haskell-extensible-exceptions/")+ , ("haskeline", "0.6.2.2", Just "http://www.archlinux.org/packages/extra/i686/haskell-haskeline/")+ , ("terminfo", "0.3.0.2", Just "http://www.archlinux.org/packages/extra/i686/haskell-terminfo/")+ , ("mtl", "1.1.0.2", Just "http://www.archlinux.org/packages/extra/i686/haskell-mtl/")+ , ("network", "2.2.1.7", Just "http://www.archlinux.org/packages/extra/i686/haskell-network/")+ , ("dataenc", "0.13.0.2", Just "http://www.archlinux.org/packages/extra/i686/haskell-dataenc/")+ , ("hashed-storage", "0.4.13", Just "http://www.archlinux.org/packages/extra/i686/haskell-hashed-storage/")++ , ("html", "1.0.1.2", Just "http://www.archlinux.org/packages/extra/i686/haskell-html/")+ , ("mmap", "0.4.1", Just "http://www.archlinux.org/packages/extra/i686/haskell-mmap/")+ , ("parsec", "3.0.1", Just "http://www.archlinux.org/packages/extra/i686/haskell-parsec/")+ , ("regex-base", "0.93.1", Just "http://www.archlinux.org/packages/extra/i686/haskell-regex-base/")+ , ("regex-compat", "0.92", Just "http://www.archlinux.org/packages/extra/i686/haskell-regex-compat/")+ , ("regex-posix", "0.94.1", Just "http://www.archlinux.org/packages/extra/i686/haskell-regex-posix/")+ , ("utf8-string","0.3.6", Just "http://www.archlinux.org/packages/extra/i686/haskell-utf8-string/")+ , ("zlib", "0.5.2.0", Just "http://www.archlinux.org/packages/community/i686/haskell-zlib/")++ , ("happy" ,"1.18.4", Just "http://www.archlinux.org/packages/extra/i686/happy/")+ , ("alex", "2.3.1", Just "http://www.archlinux.org/packages/community/i686/alex/")+ , ("X11-xft", "0.3", Just "http://www.archlinux.org/packages/community/i686/haskell-x11-xft/")+ , ("X11", "1.5.0.0", Just "http://www.archlinux.org/packages/community/i686/haskell-x11/")+ , ("HTTP", "4000.0.9", Just "http://www.archlinux.org/packages/community/i686/haskell-http/")++ , ("gtk2hs", "0.10.1", Just "http://www.archlinux.org/packages/community/i686/gtk2hs/")++ , ("darcs", "2.3.1", Just "http://www.archlinux.org/packages/extra/i686/darcs/")+ , ("cabal-install", "0.8.0", Just "http://www.archlinux.org/packages/community/i686/cabal-install/")+ ]
+ scripts/get-arch-url.hs view
@@ -0,0 +1,16 @@+import Distribution.ArchLinux.AUR+import System.Environment+import System.Exit++--+-- given the name of a package in AUR, find the URL in AUR for that package.+--++main = do+ [arch_name] <- getArgs+ q <- info arch_name+ case q of+ Left err -> exitWith (ExitFailure 1)+ Right v -> do+ putStrLn (packageURLinAUR v)+ exitSuccess
+ scripts/mypackages.hs view
@@ -0,0 +1,12 @@+import Distribution.ArchLinux.AUR+import Control.Monad++--+-- packages maintained by arch-haskell+--++me = "arch-haskell"++main = do+ packages <- maintainer me+ forM_ packages $ putStrLn . packageName
+ scripts/update-aur-log.hs view
@@ -0,0 +1,7 @@+main = do+ s <- getContents+ let (name,desc,url) = read s+ writeFile "/tmp/title" name+ writeFile "/tmp/desc" desc+ writeFile "/tmp/link" url+