cabal2doap (empty) → 0.1
raw patch · 4 files changed
+256/−0 lines, 4 filesdep +Cabaldep +basedep +hsemailsetup-changed
Dependencies added: Cabal, base, hsemail, hxt, parsec, process
Files
- LICENSE +31/−0
- Setup.hs +8/−0
- cabal2doap.cabal +25/−0
- cabal2doap.hs +192/−0
+ LICENSE view
@@ -0,0 +1,31 @@+Copyright (c) 2009, Greg Heartsfield++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * 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.++ * The names of contributors may not be used to endorse or promote+ products derived from this software without specific prior+ written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"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 COPYRIGHT+OWNER 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.hs view
@@ -0,0 +1,8 @@+#!/usr/bin/env runhaskell++module Main where++import Distribution.Simple++main :: IO ()+main = defaultMain
+ cabal2doap.cabal view
@@ -0,0 +1,25 @@+Name: cabal2doap+Version: 0.1+License: BSD3+License-file: LICENSE+Cabal-Version: >= 1.6+Copyright: + Copyright (c) 2009, Greg Heartsfield+Author: Greg Heartsfield <scsibug@imap.cc>+Maintainer: Greg Heartsfield <scsibug@imap.cc>+Homepage: http://gregheartsfield.com/cabal2doap/+Category: Distribution+Stability: Alpha+build-type: Simple+Synopsis: Cabal to Description-of-a-Project (DOAP)+Description: A converter from Cabal build description files, to+ Description-of-a-Project (DOAP) RDF files, giving visibility on+ the semantic web to cabalized Haskell projects.++source-repository head+ type: darcs+ location: http://gregheartsfield.com/repos/cabal2doap/++Executable cabal2doap+ build-depends: base, hxt, Cabal >= 1.6, parsec, hsemail >= 1.1, process+ main-is: cabal2doap.hs
+ cabal2doap.hs view
@@ -0,0 +1,192 @@+import Distribution.PackageDescription+ (PackageDescription,SourceRepo,RepoKind(RepoHead),RepoType(..),repoLocation,repoKind,+ repoType,package,homepage,synopsis,buildDepends,maintainer,licenseFile,+ license,library,description,sourceRepos)+import Distribution.PackageDescription.Configuration+ (flattenPackageDescription)+import Distribution.PackageDescription.Parse+ (readPackageDescription)+import Distribution.Simple+import Distribution.Simple.Utils+ (defaultPackageDesc)+import Distribution.Verbosity+ (normal)+import Distribution.License+ (License)++import Text.XML.HXT.Arrow+import Data.Maybe (catMaybes,listToMaybe)+import Data.Either (rights)+import Data.List (nub)+import Data.Version (showVersion)++import Text.ParserCombinators.Parsec (parse)+import Text.ParserCombinators.Parsec.Rfc2822+ (mailbox_list,mailbox,NameAddr,nameAddr_addr,nameAddr_name)++import System.Process (readProcessWithExitCode)+import System.Exit (ExitCode(..))++-- Common namespaces+doap_ns = "http://usefulinc.com/ns/doap#"+foaf_ns = "http://xmlns.com/foaf/0.1/"+rdf_ns = "http://www.w3.org/1999/02/22-rdf-syntax-ns#"++------ Qualified Names we'll make use of+-- RDF QNames+rdfQ = mkQName "rdf" "RDF" rdf_ns+rdfresQ = mkQName "rdf" "resource" rdf_ns+rdfaboutQ = mkQName "rdf" "about" rdf_ns+-- DOAP QNames+projectQ = mkQName "doap" "Project" doap_ns+proj_nameQ = mkQName "doap" "name" doap_ns+shortdescQ = mkQName "doap" "shortdesc" doap_ns+descQ = mkQName "doap" "description" doap_ns+homepageQ = mkQName "doap" "homepage" doap_ns+licenseQ = mkQName "doap" "license" doap_ns+releaseQ = mkQName "doap" "release" doap_ns+versionQ = mkQName "doap" "Version" doap_ns+revisionQ = mkQName "doap" "revision" doap_ns+maintainerQ = mkQName "doap" "maintainer" doap_ns+developerQ = mkQName "doap" "developer" doap_ns+programminglangQ = mkQName "doap" "programming-language" doap_ns+repoRelQ = mkQName "doap" "repository" doap_ns+repoQ = mkQName "doap" "Repository" doap_ns+locationQ = mkQName "doap" "location" doap_ns+-- FOAF QNames+personQ = mkQName "foaf" "Person" foaf_ns+nameQ = mkQName "foaf" "name" foaf_ns+mboxQ = mkQName "foaf" "mbox" foaf_ns++-- directly map a string field to a DOAP top-level project element.+-- Empty strings result in Nothing.+simpleElement :: ArrowXml a => String -> QName -> Maybe (a XmlTree XmlTree)+simpleElement n qn = case n of+ [] -> Nothing+ _ -> Just (mkqelem qn [] [txt n])++-- Create homepage DOAP element, if it exists.+homepageElement :: ArrowXml a => String -> Maybe (a XmlTree XmlTree)+homepageElement h = case h of+ [] -> Nothing+ _ -> Just (mkqelem homepageQ [sqattr rdfresQ h] [])++-- Create release/version elements, if a Cabal version was specified.+-- release, Version, name/created/revision+versionElement :: ArrowXml a => String -> Maybe (a XmlTree XmlTree)+versionElement v =+ case v of+ [] -> Nothing+ _ -> Just $ mkqelem releaseQ []+ [mkqelem versionQ [] [mkqelem revisionQ [] [txt v]]]++-- Create maintainer elements, one for each address listed.+maintainerElements :: ArrowXml a => String -> [a XmlTree XmlTree]+maintainerElements m =+ let mboxes_parsed = parse mailbox_list "maintainers" m in+ case mboxes_parsed of+ Left _ -> [] --Error+ Right mboxes -> map (personElementFromAddr maintainerQ) mboxes++personElementFromAddr :: ArrowXml a => QName -> NameAddr -> a XmlTree XmlTree+personElementFromAddr rel na =+ mkqelem rel []+ [mkqelem personQ []+ (mkqelem mboxQ+ [sqattr rdfresQ ("mailto:" ++ nameAddr_addr na)] []+ : nameElems)]+ where+ nameElems = case (nameAddr_name na) of+ Nothing -> []+ Just name -> [mkqelem nameQ [] [txt name]]++-- Need URIs for other Cabal-recognized licenses+licenseElement :: ArrowXml a => License -> Maybe (a XmlTree XmlTree)+licenseElement l =+ case l of+ GPL -> Just (mkqelem licenseQ+ [sqattr rdfresQ "http://usefulinc.com/doap/licenses/gpl"] [])+ LGPL -> Just (mkqelem licenseQ+ [sqattr rdfresQ "http://usefulinc.com/doap/licenses/lgpl"] [])+ BSD3 -> Just (mkqelem licenseQ+ [sqattr rdfresQ "http://usefulinc.com/doap/licenses/bsd"] [])+ BSD4 -> Nothing+ PublicDomain -> Nothing+ AllRightsReserved -> Nothing+ OtherLicense -> Nothing+ UnknownLicense n -> Nothing++-- Find a "HEAD" source repository, if one exists, and reference the location.+-- Note: An active ticket on the DOAP Trac has a proposal for Darcs as+-- a subclass of Repository. We should use that as soon as it becomes+-- official.+sourceRepoElement :: ArrowXml a => [SourceRepo] -> Maybe (a XmlTree XmlTree)+sourceRepoElement repos =+ fmap (\r -> mkqelem repoRelQ [] [+ mkqelem repoQ [] [+ mkqelem locationQ [sqattr rdfresQ r] []+ ]]) source_repo+ where+ head_repos = filter (\r -> repoKind r == RepoHead) repos+ source_repo = listToMaybe head_repos >>= repoLocation++developerElements :: ArrowXml a => [NameAddr] -> [a XmlTree XmlTree]+developerElements = map (personElementFromAddr developerQ)++doapFromPackageDesc :: ArrowXml a => PackageDescription -- ^ Cabal package+ -> [NameAddr] -- ^ Developer addresses+ -> a XmlTree XmlTree+doapFromPackageDesc pkg_desc developers =+ mkqelem rdfQ [] [+ mkqelem projectQ [sqattr rdfaboutQ (homepage pkg_desc)]+ (catMaybes+ [(simpleElement (nameFromPkgDesc pkg_desc) proj_nameQ),+ (simpleElement (synopsis pkg_desc) shortdescQ),+ (simpleElement (description pkg_desc) descQ),+ (simpleElement "Haskell" programminglangQ),+ (licenseElement (license pkg_desc)),+ (homepageElement (homepage pkg_desc)),+ (sourceRepoElement (sourceRepos pkg_desc)),+ (versionElement (showVersion (packageVersion (package pkg_desc))))+ ] ++ maintainerElements (maintainer pkg_desc)+ ++ developerElements developers+ )+ ]++nameFromPkgDesc :: PackageDescription -> String+nameFromPkgDesc pkg_desc = case (pkgName (package pkg_desc)) of+ PackageName n -> n++-- Use darcs repo to get a change log (XML)+getDarcsChanges :: IO (Maybe String)+getDarcsChanges =+ do (ec, out, err) <- readProcessWithExitCode "darcs" ["changes", "--xml-output"] ""+ case ec of+ ExitSuccess -> return (Just out)+ ExitFailure _ -> return Nothing+++-- The vast majority of darcs author fields look like either:+-- contrib@example.org OR+-- Contributor Name <contrib@example.org>+developersFromDarcs :: String -- ^ Darcs XML changes+ -> IO [NameAddr] -- ^ list of developers+developersFromDarcs xml =+ do res <- runX (readString [] xml >>>+ deep (isElem >>>+ hasName "patch") >>>+ getAttrValue "author")+ let uniq_dvlp = map (parse mailbox "developers") (nub res)+ return (rights uniq_dvlp)++main = do+ chg <- getDarcsChanges+ dvlprs <- maybe (return []) developersFromDarcs chg+ packageDescPath <- defaultPackageDesc normal+ gDesc <- readPackageDescription normal packageDescPath+ let desc = flattenPackageDescription gDesc+ runX (root [] [doapFromPackageDesc desc dvlprs+ >>> uniqueNamespacesFromDeclAndQNames+ ]+ >>> writeDocument [(a_indent,v_1),(a_check_namespaces, v_1)] "-")+ return ()