diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,8 @@ +#!/usr/bin/env runhaskell + +module Main where + +import Distribution.Simple + +main :: IO () +main = defaultMain diff --git a/cabal2doap.cabal b/cabal2doap.cabal new file mode 100644 --- /dev/null +++ b/cabal2doap.cabal @@ -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 +Maintainer: Greg Heartsfield +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 diff --git a/cabal2doap.hs b/cabal2doap.hs new file mode 100644 --- /dev/null +++ b/cabal2doap.hs @@ -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 +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 ()