diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,26 @@ +Copyright © 2012 Frank S. Thomas +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 University nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE REGENTS 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 REGENTS 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/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,38 @@ +ohloh-hs +======== + +ohloh-hs is a Haskell Interface to the [Ohloh API][], which provides access +to the data of the Ohloh open source directory. It consists mainly of simple +data types for the items exposed by the API and corresponding [HXT][] +pickler functions in order to convert those types from/to XML easily. + +[Ohloh API]: http://meta.ohloh.net/getting_started/ +[HXT]: http://www.fh-wedel.de/~si/HXmlToolbox/ + +Building +-------- + +ohloh-hs uses the [Cabal](http://www.haskell.org/cabal/) build system. +To build ohloh-hs' tests and tools, run these command in its source tree: + + cabal configure --enable-tests + cabal build + +If the build succeeded, you can for example run the `cmdoh` tool: + + dist/build/cmdoh/cmdoh --help + +Examples +-------- + +Here are some example invocations of the `cmdoh` tool: + + cmdoh fetch -k YOUR_API_KEY_HERE language haskell + + cmdoh read -f tests/queries/language.xml + + +Author +------ + +ohloh-hs was written by Frank S. Thomas <> diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/TODO b/TODO new file mode 100644 --- /dev/null +++ b/TODO @@ -0,0 +1,1 @@ +- use special type for dates diff --git a/Web/Ohloh.hs b/Web/Ohloh.hs new file mode 100644 --- /dev/null +++ b/Web/Ohloh.hs @@ -0,0 +1,40 @@ +-- Copyright © 2012 Frank S. Thomas +-- All rights reserved. +-- +-- Use of this source code is governed by a BSD-style license that +-- can be found in the LICENSE file. + +-- | +-- Module : Web.Ohloh +-- License : BSD3 +-- +-- Maintainer : Frank S. Thomas +-- Stability : experimental +-- Portability: portable +-- +-- Top-level module for the Ohloh API (). +-- Examples how to use this module can be found in the \"tests\/read-haskell.hs\", +-- \"tests\/fetch-haskell.hs\", and \"tools\/cmdoh.hs\" files in ohloh-hs' source +-- tree. +module Web.Ohloh (module X) where +import Web.Ohloh.Account as X +import Web.Ohloh.ActivityFact as X +import Web.Ohloh.Analysis as X +import Web.Ohloh.Common as X +import Web.Ohloh.ContributorFact as X +import Web.Ohloh.ContributorLanguageFact as X +import Web.Ohloh.Enlistment as X +import Web.Ohloh.Factoid as X +import Web.Ohloh.Kudo as X +import Web.Ohloh.KudoScore as X +import Web.Ohloh.Language as X +import Web.Ohloh.Lens.IdL as X +import Web.Ohloh.Lens.NameL as X +import Web.Ohloh.Lens.UpdatedAtL as X +import Web.Ohloh.Project as X +import Web.Ohloh.Repository as X +import Web.Ohloh.Response as X +import Web.Ohloh.ResultType as X +import Web.Ohloh.SizeFact as X +import Web.Ohloh.Stack as X +import Web.Ohloh.StackEntry as X diff --git a/Web/Ohloh/Account.hs b/Web/Ohloh/Account.hs new file mode 100644 --- /dev/null +++ b/Web/Ohloh/Account.hs @@ -0,0 +1,82 @@ +-- Copyright © 2012 Frank S. Thomas +-- All rights reserved. +-- +-- Use of this source code is governed by a BSD-style license that +-- can be found in the LICENSE file. + +-- | Ohloh API Reference: +module Web.Ohloh.Account ( + Account(..), + xpAccount +) where + +import Data.Lens.Common +import Text.XML.HXT.Arrow.Pickle + +import Web.Ohloh.Common +import Web.Ohloh.KudoScore +import Web.Ohloh.Lens.IdL +import Web.Ohloh.Lens.NameL +import Web.Ohloh.Lens.UpdatedAtL + +-- | 'Account' represents an Ohloh member. +data Account = Account { + accId :: String, + accName :: String, + accAbout :: Maybe String, + accLogin :: String, + accCreatedAt :: String, + accUpdatedAt :: String, + accHomepageUrl :: Maybe String, + accTwitterAccount :: Maybe String, + accUrl :: String, + accHtmlUrl :: String, + accAvatarUrl :: String, + accEmailSha1 :: String, + accPostsCount :: Int, + accLocation :: Maybe String, + accCountryCode :: Maybe String, + accLatitude :: Maybe String, + accLongitude :: Maybe String, + accKudoScore :: Maybe KudoScore +} deriving (Eq, Read, Show) + +instance XmlPickler Account where + xpickle = xpAccount + +instance ReadXmlString Account +instance ShowXmlString Account + +xpAccount :: PU Account +xpAccount = + xpElem "account" $ + xpWrap (uncurry18 Account, + \(Account i n a log ca ua hu ta u htu au es pc l cc la lo ks) -> + (i, n, a, log, ca, ua, hu, ta, u, htu, au, es, pc, l, cc, la, lo, ks)) $ + xp18Tuple (xpElem "id" xpText0) + (xpElem "name" xpText0) + (xpOption (xpElem "about" xpText0)) + (xpElem "login" xpText0) + (xpElem "created_at" xpText0) + (xpElem "updated_at" xpText0) + (xpOption (xpElem "homepage_url" xpText0)) + (xpOption (xpElem "twitter_account" xpText0)) + (xpElem "url" xpText0) + (xpElem "html_url" xpText0) + (xpElem "avatar_url" xpText0) + (xpElem "email_sha1" xpText0) + (xpElem "posts_count" xpInt) + (xpOption (xpElem "location" xpText0)) + (xpOption (xpElem "country_code" xpText0)) + (xpOption (xpElem "latitude" xpText0)) + (xpOption (xpElem "longitude" xpText0)) + (xpOption xpKudoScore) + +instance IdL Account where + idL = lens accId $ \id acc -> acc { accId = id } + +instance NameL Account where + nameL = lens accName $ \name acc -> acc { accName = name } + +instance UpdatedAtL Account where + updatedAtL = lens accUpdatedAt $ \updatedAt acc -> acc { accUpdatedAt = updatedAt } diff --git a/Web/Ohloh/ActivityFact.hs b/Web/Ohloh/ActivityFact.hs new file mode 100644 --- /dev/null +++ b/Web/Ohloh/ActivityFact.hs @@ -0,0 +1,51 @@ +-- Copyright © 2012 Frank S. Thomas +-- All rights reserved. +-- +-- Use of this source code is governed by a BSD-style license that +-- can be found in the LICENSE file. + +-- | Ohloh API Reference: +module Web.Ohloh.ActivityFact ( + ActivityFact(..), + xpActivityFact +) where + +import Text.XML.HXT.Arrow.Pickle + +import Web.Ohloh.Common + +-- | 'ActivityFact' is a pre-computed collection of statistics about +-- 'Web.Ohloh.Project.Project' source code. +data ActivityFact = ActivityFact { + afMonth :: String, + afCodeAdded :: Int, + afCodeRemoved :: Int, + afCommentsAdded :: Int, + afCommentsRemoved :: Int, + afBlanksAdded :: Int, + afBlanksRemoved :: Int, + afCommits :: Int, + afContributors :: Int +} deriving (Eq, Read, Show) + +instance XmlPickler ActivityFact where + xpickle = xpActivityFact + +instance ReadXmlString ActivityFact +instance ShowXmlString ActivityFact + +xpActivityFact :: PU ActivityFact +xpActivityFact = + xpElem "activity_fact" $ + xpWrap (uncurry9 ActivityFact, + \(ActivityFact m ca cr coa cor ba br c co) -> + (m, ca, cr, coa, cor, ba, br, c, co)) $ + xp9Tuple (xpElem "month" xpText0) + (xpElem "code_added" xpInt) + (xpElem "code_removed" xpInt) + (xpElem "comments_added" xpInt) + (xpElem "comments_removed" xpInt) + (xpElem "blanks_added" xpInt) + (xpElem "blanks_removed" xpInt) + (xpElem "commits" xpInt) + (xpElem "contributors" xpInt) diff --git a/Web/Ohloh/Analysis.hs b/Web/Ohloh/Analysis.hs new file mode 100644 --- /dev/null +++ b/Web/Ohloh/Analysis.hs @@ -0,0 +1,63 @@ +-- Copyright © 2012 Frank S. Thomas +-- All rights reserved. +-- +-- Use of this source code is governed by a BSD-style license that +-- can be found in the LICENSE file. + +-- | Ohloh API Reference: +module Web.Ohloh.Analysis ( + Analysis(..), + xpAnalysis +) where + +import Data.Lens.Common +import Text.XML.HXT.Arrow.Pickle + +import Web.Ohloh.Common +import Web.Ohloh.Lens.IdL +import Web.Ohloh.Lens.UpdatedAtL + +-- | 'Analysis' is a pre-computed collection of statistics about +-- 'Web.Ohloh.Project.Project' source code and contributors. +data Analysis = Analysis { + anaId :: String, + anaProjectId :: String, + anaUpdatedAt :: String, + anaLoggedAt :: String, + anaMinMonth :: String, + anaMaxMonth :: String, + anaTwelveMonthContributorCount :: Int, + anaTotalCodeLines :: Int, + anaMainLanguageId :: String, + anaMainLanguageName :: String +} deriving (Eq, Read, Show) + +instance XmlPickler Analysis where + xpickle = xpAnalysis + +instance ReadXmlString Analysis +instance ShowXmlString Analysis + +xpAnalysis :: PU Analysis +xpAnalysis = + xpElem "analysis" $ + xpWrap (uncurry10 Analysis, + \(Analysis i pi ua la min max tmcc tcl mli mln) -> + (i, pi, ua, la, min, max, tmcc, tcl, mli, mln)) $ + xp10Tuple (xpElem "id" xpText0) + (xpElem "project_id" xpText0) + (xpElem "updated_at" xpText0) + (xpElem "logged_at" xpText0) + (xpElem "min_month" xpText0) + (xpElem "max_month" xpText0) + (xpElem "twelve_month_contributor_count" xpInt) + (xpElem "total_code_lines" xpInt) + (xpElem "main_language_id" xpText0) + (xpElem "main_language_name" xpText0) + +instance IdL Analysis where + idL = lens anaId $ \id ana -> ana { anaId = id } + +instance UpdatedAtL Analysis where + updatedAtL = lens anaUpdatedAt $ \updatedAt ana -> ana { anaUpdatedAt = updatedAt } + diff --git a/Web/Ohloh/ContributorFact.hs b/Web/Ohloh/ContributorFact.hs new file mode 100644 --- /dev/null +++ b/Web/Ohloh/ContributorFact.hs @@ -0,0 +1,62 @@ +-- Copyright © 2012 Frank S. Thomas +-- All rights reserved. +-- +-- Use of this source code is governed by a BSD-style license that +-- can be found in the LICENSE file. + +-- | Ohloh API Reference: +module Web.Ohloh.ContributorFact ( + ContributorFact(..), + xpContributorFact +) where + +import Text.XML.HXT.Arrow.Pickle + +import Web.Ohloh.Common +import Web.Ohloh.ContributorLanguageFact + +-- | 'ContributorFact' contains a selection of high-level statistics about a +-- person who commited source code to a 'Web.Ohloh.Project.Project'. +data ContributorFact = ContributorFact { + cfContributorId :: String, + cfAccountId :: Maybe String, + cfAccountName :: Maybe String, + cfAnalysisId :: String, + cfContributorName :: String, + cfPrimaryLanguageId :: String, + cfPrimaryLanguageNiceName :: String, + cfCommentRatio :: Double, + cfFirstCommitTime :: String, + cfLastCommitTime :: String, + cfManMonths :: Int, + cfCommits :: Int, + cfMedianCommits :: Int, + cfContributorLanguageFacts :: Maybe [ContributorLanguageFact] +} deriving (Eq, Read, Show) + +instance XmlPickler ContributorFact where + xpickle = xpContributorFact + +instance ReadXmlString ContributorFact +instance ShowXmlString ContributorFact + +xpContributorFact :: PU ContributorFact +xpContributorFact = + xpElem "contributor_fact" $ + xpWrap (uncurry14 ContributorFact, + \(ContributorFact ci aci acn ai cn pli plnn cr fct lct mm c mc clf) -> + (ci, aci, acn, ai, cn, pli, plnn, cr, fct, lct, mm, c, mc, clf)) $ + xp14Tuple (xpElem "contributor_id" xpText0) + (xpOption (xpElem "account_id" xpText0)) + (xpOption (xpElem "account_name" xpText0)) + (xpElem "analysis_id" xpText0) + (xpElem "contributor_name" xpText0) + (xpElem "primary_language_id" xpText0) + (xpElem "primary_language_nice_name" xpText0) + (xpElem "comment_ratio" xpPrim) + (xpElem "first_commit_time" xpText0) + (xpElem "last_commit_time" xpText0) + (xpElem "man_months" xpInt) + (xpElem "commits" xpInt) + (xpElem "median_commits" xpInt) + (xpOption (xpElem "contributor_language_facts" xpickle)) diff --git a/Web/Ohloh/ContributorLanguageFact.hs b/Web/Ohloh/ContributorLanguageFact.hs new file mode 100644 --- /dev/null +++ b/Web/Ohloh/ContributorLanguageFact.hs @@ -0,0 +1,52 @@ +-- Copyright © 2012 Frank S. Thomas +-- All rights reserved. +-- +-- Use of this source code is governed by a BSD-style license that +-- can be found in the LICENSE file. + +-- | Ohloh API Reference: +module Web.Ohloh.ContributorLanguageFact ( + ContributorLanguageFact(..), + xpContributorLanguageFact +) where + +import Text.XML.HXT.Arrow.Pickle + +import Web.Ohloh.Common + +-- | 'ContributorLanguageFact' contains a selection of +-- 'Web.Ohloh.Language.Language'-specific statistics about a single person +-- who commited source code to a 'Web.Ohloh.Project.Project'. +data ContributorLanguageFact = ContributorLanguageFact { + clfAnalysisId :: String, + clfContributorId :: String, + clfContributorName :: String, + clfLanguageId :: String, + clfLanguageNiceName :: String, + clfCommentRatio :: Double, + clfManMonths :: Int, + clfCommits :: Int, + clfMedianCommits :: Int +} deriving (Eq, Read, Show) + +instance XmlPickler ContributorLanguageFact where + xpickle = xpContributorLanguageFact + +instance ReadXmlString ContributorLanguageFact +instance ShowXmlString ContributorLanguageFact + +xpContributorLanguageFact :: PU ContributorLanguageFact +xpContributorLanguageFact = + xpElem "contributor_language_fact" $ + xpWrap (uncurry9 ContributorLanguageFact, + \(ContributorLanguageFact ai ci cn li lnn cr mm c mc) -> + (ai, ci, cn, li, lnn, cr, mm, c, mc)) $ + xp9Tuple (xpElem "analysis_id" xpText0) + (xpElem "contributor_id" xpText0) + (xpElem "contributor_name" xpText0) + (xpElem "language_id" xpText0) + (xpElem "language_nice_name" xpText0) + (xpElem "comment_ratio" xpPrim) + (xpElem "man_months" xpInt) + (xpElem "commits" xpInt) + (xpElem "median_commits" xpInt) diff --git a/Web/Ohloh/Enlistment.hs b/Web/Ohloh/Enlistment.hs new file mode 100644 --- /dev/null +++ b/Web/Ohloh/Enlistment.hs @@ -0,0 +1,47 @@ +-- Copyright © 2012 Frank S. Thomas +-- All rights reserved. +-- +-- Use of this source code is governed by a BSD-style license that +-- can be found in the LICENSE file. + +-- | Ohloh API Reference: +module Web.Ohloh.Enlistment ( + Enlistment(..), + xpEnlistment +) where + +import Data.Lens.Common +import Text.XML.HXT.Arrow.Pickle + +import Web.Ohloh.Common +import Web.Ohloh.Lens.IdL +import Web.Ohloh.Repository + +-- | 'Enlistment' joins a 'Web.Ohloh.Project.Project' to a source control +-- 'Web.Ohloh.Repository.Repository'. +data Enlistment = Enlistment { + enId :: String, + enProjectId :: String, + enRepositoryId :: String, + enRepository :: Repository +} deriving (Eq, Read, Show) + +instance XmlPickler Enlistment where + xpickle = xpEnlistment + +instance ReadXmlString Enlistment +instance ShowXmlString Enlistment + +xpEnlistment :: PU Enlistment +xpEnlistment = + xpElem "enlistment" $ + xpWrap (uncurry4 Enlistment, + \(Enlistment i pi ri r) -> + (i, pi, ri, r)) $ + xp4Tuple (xpElem "id" xpText0) + (xpElem "project_id" xpText0) + (xpElem "repository_id" xpText0) + xpRepository + +instance IdL Enlistment where + idL = lens enId $ \id en -> en { enId = id } diff --git a/Web/Ohloh/Factoid.hs b/Web/Ohloh/Factoid.hs new file mode 100644 --- /dev/null +++ b/Web/Ohloh/Factoid.hs @@ -0,0 +1,73 @@ +-- Copyright © 2012 Frank S. Thomas +-- All rights reserved. +-- +-- Use of this source code is governed by a BSD-style license that +-- can be found in the LICENSE file. + +-- | Ohloh API Reference: +module Web.Ohloh.Factoid ( + Factoid(..), + FactoidType(..), + xpFactoid +) where + +import Data.Lens.Common +import Text.XML.HXT.Arrow.Pickle + +import Web.Ohloh.Common +import Web.Ohloh.Lens.IdL + +data FactoidType = + FactoidActivityDecreasing | + FactoidActivityStable | + FactoidActivityIncreasing | + FactoidAgeYoung | + FactoidAgeOld | + FactoidAgeVeryOld | + FactoidCommentsVeryLow | + FactoidCommentsLow | + FactoidCommentsAverage | + FactoidCommentsHigh | + FactoidCommentsVeryHigh | + FactoidDistributionOnePerson | + FactoidTeamSizeZero | + FactoidTeamSizeOne | + FactoidTeamSizeSmall | + FactoidTeamSizeAverage | + FactoidTeamSizeLarge | + FactoidTeamSizeVeryLarge | + FactoidGplConflict + deriving (Eq, Read, Show) + +-- | 'Factoid' is a short, high-level bullet point delivering a simple +-- observation about a 'Web.Ohloh.Project.Project'. +data Factoid = Factoid { + factId :: String, + factAnalysisId :: String, + factType :: FactoidType, + factDescription :: String, + factSeverity :: Int, + factLicenseId :: Maybe String +} deriving (Eq, Read, Show) + +instance XmlPickler Factoid where + xpickle = xpFactoid + +instance ReadXmlString Factoid +instance ShowXmlString Factoid + +xpFactoid :: PU Factoid +xpFactoid = + xpElem "factoid" $ + xpWrap (uncurry6 Factoid, + \(Factoid i ai t d s li) -> + (i, ai, t, d, s, li)) $ + xp6Tuple (xpElem "id" xpText0) + (xpElem "analysis_id" xpText0) + (xpElem "type" xpPrim) + (xpElem "description" xpText0) + (xpElem "severity" xpInt) + (xpOption (xpElem "license_id" xpText0)) + +instance IdL Factoid where + idL = lens factId $ \id fact -> fact { factId = id } diff --git a/Web/Ohloh/Kudo.hs b/Web/Ohloh/Kudo.hs new file mode 100644 --- /dev/null +++ b/Web/Ohloh/Kudo.hs @@ -0,0 +1,51 @@ +-- Copyright © 2012 Frank S. Thomas +-- All rights reserved. +-- +-- Use of this source code is governed by a BSD-style license that +-- can be found in the LICENSE file. + +-- | Ohloh API Reference: +module Web.Ohloh.Kudo ( + Kudo(..), + xpKudo +) where + +import Text.XML.HXT.Arrow.Pickle + +import Web.Ohloh.Common + +-- | 'Kudo' is a simple gesture of thanks, praise, or endorsement from an +-- 'Web.Ohloh.Account.Account' to another person. +data Kudo = Kudo { + kudoCreatedAt :: String, + kudoSenderAccountId :: String, + kudoSenderAccountName :: String, + kudoReceiverAccountId :: Maybe String, + kudoReceiverAccountName :: Maybe String, + kudoProjectId :: Maybe String, + kudoProjectName :: Maybe String, + kudoContributorId :: Maybe String, + kudoContributorName :: Maybe String +} deriving (Eq, Read, Show) + +instance XmlPickler Kudo where + xpickle = xpKudo + +instance ReadXmlString Kudo +instance ShowXmlString Kudo + +xpKudo :: PU Kudo +xpKudo = + xpElem "kudo" $ + xpWrap (uncurry9 Kudo, + \(Kudo ca sai san rai ran pi pn ci cn) -> + (ca, sai, san, rai, ran, pi, pn, ci, cn)) $ + xp9Tuple (xpElem "created_at" xpText0) + (xpElem "sender_account_id" xpText0) + (xpElem "sender_account_name" xpText0) + (xpOption (xpElem "receiver_account_id" xpText0)) + (xpOption (xpElem "receiver_account_name" xpText0)) + (xpOption (xpElem "project_id" xpText0)) + (xpOption (xpElem "project_name" xpText0)) + (xpOption (xpElem "contributor_id" xpText0)) + (xpOption (xpElem "contributor_name" xpText0)) diff --git a/Web/Ohloh/KudoScore.hs b/Web/Ohloh/KudoScore.hs new file mode 100644 --- /dev/null +++ b/Web/Ohloh/KudoScore.hs @@ -0,0 +1,41 @@ +-- Copyright © 2012 Frank S. Thomas +-- All rights reserved. +-- +-- Use of this source code is governed by a BSD-style license that +-- can be found in the LICENSE file. + +-- | Ohloh API Reference: +module Web.Ohloh.KudoScore ( + KudoScore(..), + xpKudoScore +) where + +import Text.XML.HXT.Arrow.Pickle + +import Web.Ohloh.Common + +data KudoScore = KudoScore { + ksCreatedAt :: Maybe String, + ksKudoRank :: Int, + ksPosition :: Int, + ksMaxPosition :: Maybe Int, + ksPositionDelta :: Maybe Int +} deriving (Eq, Read, Show) + +instance XmlPickler KudoScore where + xpickle = xpKudoScore + +instance ReadXmlString KudoScore +instance ShowXmlString KudoScore + +xpKudoScore :: PU KudoScore +xpKudoScore = + xpElem "kudo_score" $ + xpWrap (uncurry5 KudoScore, + \(KudoScore ca kr p mp pd) -> + (ca, kr, p, mp, pd)) $ + xp5Tuple (xpOption (xpElem "created_at" xpText0)) + (xpElem "kudo_rank" xpInt) + (xpElem "position" xpInt) + (xpOption (xpElem "max_position" xpInt)) + (xpOption (xpElem "position_delta" xpInt)) diff --git a/Web/Ohloh/Language.hs b/Web/Ohloh/Language.hs new file mode 100644 --- /dev/null +++ b/Web/Ohloh/Language.hs @@ -0,0 +1,64 @@ +-- Copyright © 2012 Frank S. Thomas +-- All rights reserved. +-- +-- Use of this source code is governed by a BSD-style license that +-- can be found in the LICENSE file. + +-- | Ohloh API Reference: +module Web.Ohloh.Language ( + Language(..), + xpLanguage +) where + +import Data.Lens.Common +import Text.XML.HXT.Arrow.Pickle + +import Web.Ohloh.Common +import Web.Ohloh.Lens.IdL +import Web.Ohloh.Lens.NameL + +-- | 'Language' contains the name and various statistics related to a +-- programming language. +data Language = Language { + langId :: String, + langName :: String, + langNiceName :: String, + langCategory :: String, + langCode :: Int, + langComments :: Int, + langBlanks :: Int, + langCommentRatio :: Double, + langProjects :: Int, + langContributors :: Int, + langCommits :: Int +} deriving (Eq, Read, Show) + +instance XmlPickler Language where + xpickle = xpLanguage + +instance ReadXmlString Language +instance ShowXmlString Language + +xpLanguage :: PU Language +xpLanguage = + xpElem "language" $ + xpWrap (uncurry11 Language, + \(Language i n nn ca co cm b cr p cn ci) -> + (i, n, nn, ca, co, cm, b, cr, p, cn, ci)) $ + xp11Tuple (xpElem "id" xpText0) + (xpElem "name" xpText0) + (xpElem "nice_name" xpText0) + (xpElem "category" xpText0) + (xpElem "code" xpInt) + (xpElem "comments" xpInt) + (xpElem "blanks" xpInt) + (xpElem "comment_ratio" xpPrim) + (xpElem "projects" xpInt) + (xpElem "contributors" xpInt) + (xpElem "commits" xpInt) + +instance IdL Language where + idL = lens langId $ \id lang -> lang { langId = id } + +instance NameL Language where + nameL = lens langName $ \name lang -> lang { langName = name } diff --git a/Web/Ohloh/Lens/IdL.hs b/Web/Ohloh/Lens/IdL.hs new file mode 100644 --- /dev/null +++ b/Web/Ohloh/Lens/IdL.hs @@ -0,0 +1,12 @@ +-- Copyright © 2012 Frank S. Thomas +-- All rights reserved. +-- +-- Use of this source code is governed by a BSD-style license that +-- can be found in the LICENSE file. + +module Web.Ohloh.Lens.IdL where + +import Data.Lens.Common + +class IdL a where + idL :: Lens a String diff --git a/Web/Ohloh/Lens/NameL.hs b/Web/Ohloh/Lens/NameL.hs new file mode 100644 --- /dev/null +++ b/Web/Ohloh/Lens/NameL.hs @@ -0,0 +1,12 @@ +-- Copyright © 2012 Frank S. Thomas +-- All rights reserved. +-- +-- Use of this source code is governed by a BSD-style license that +-- can be found in the LICENSE file. + +module Web.Ohloh.Lens.NameL where + +import Data.Lens.Common + +class NameL a where + nameL :: Lens a String diff --git a/Web/Ohloh/Lens/UpdatedAtL.hs b/Web/Ohloh/Lens/UpdatedAtL.hs new file mode 100644 --- /dev/null +++ b/Web/Ohloh/Lens/UpdatedAtL.hs @@ -0,0 +1,12 @@ +-- Copyright © 2012 Frank S. Thomas +-- All rights reserved. +-- +-- Use of this source code is governed by a BSD-style license that +-- can be found in the LICENSE file. + +module Web.Ohloh.Lens.UpdatedAtL where + +import Data.Lens.Common + +class UpdatedAtL a where + updatedAtL :: Lens a String diff --git a/Web/Ohloh/Project.hs b/Web/Ohloh/Project.hs new file mode 100644 --- /dev/null +++ b/Web/Ohloh/Project.hs @@ -0,0 +1,81 @@ +-- Copyright © 2012 Frank S. Thomas +-- All rights reserved. +-- +-- Use of this source code is governed by a BSD-style license that +-- can be found in the LICENSE file. + +-- | Ohloh API Reference: +module Web.Ohloh.Project ( + Project(..), + xpProject +) where + +import Data.Lens.Common +import Text.XML.HXT.Arrow.Pickle + +import Web.Ohloh.Analysis +import Web.Ohloh.Common +import Web.Ohloh.Lens.IdL +import Web.Ohloh.Lens.NameL +import Web.Ohloh.Lens.UpdatedAtL + +-- | 'Project' represents a collection of source code, documentation, and web +-- sites treated together as a unit. +data Project = Project { + projId :: String, + projName :: String, + projUrl :: String, + projHtmlUrl :: String, + projCreatedAt :: String, + projUpdatedAt :: String, + projDescription :: Maybe String, + projHomepageUrl :: Maybe String, + projDownloadUrl :: Maybe String, + projUrlName :: String, + projMediumLogoUrl :: String, + projSmallLogoUrl :: String, + projUserCount :: Int, + projAverageRating :: String, + projRatingCount :: Int, + projAnalysisId :: String, + projAnalysis :: Analysis +} deriving (Eq, Read, Show) + +instance XmlPickler Project where + xpickle = xpProject + +instance ReadXmlString Project +instance ShowXmlString Project + +xpProject :: PU Project +xpProject = + xpElem "project" $ + xpWrap (uncurry17 Project, + \(Project i n u htu ca ua d hu du un mlu slu uc ar rc ai a) -> + (i, n, u, htu, ca, ua, d, hu, du, un, mlu, slu, uc, ar, rc, ai, a)) $ + xp17Tuple (xpElem "id" xpText0) + (xpElem "name" xpText0) + (xpElem "url" xpText0) + (xpElem "html_url" xpText0) + (xpElem "created_at" xpText0) + (xpElem "updated_at" xpText0) + (xpOption (xpElem "description" xpText0)) + (xpOption (xpElem "homepage_url" xpText0)) + (xpOption (xpElem "download_url" xpText0)) + (xpElem "url_name" xpText0) + (xpElem "medium_logo_url" xpText0) + (xpElem "small_logo_url" xpText0) + (xpElem "user_count" xpInt) + (xpElem "average_rating" xpText0) + (xpElem "rating_count" xpInt) + (xpElem "analysis_id" xpText0) + xpAnalysis + +instance IdL Project where + idL = lens projId $ \id proj -> proj { projId = id } + +instance NameL Project where + nameL = lens projName $ \name proj -> proj { projName = name } + +instance UpdatedAtL Project where + updatedAtL = lens projUpdatedAt $ \updatedAt proj -> proj { projUpdatedAt = updatedAt } diff --git a/Web/Ohloh/Repository.hs b/Web/Ohloh/Repository.hs new file mode 100644 --- /dev/null +++ b/Web/Ohloh/Repository.hs @@ -0,0 +1,65 @@ +-- Copyright © 2012 Frank S. Thomas +-- All rights reserved. +-- +-- Use of this source code is governed by a BSD-style license that +-- can be found in the LICENSE file. + +-- | Ohloh API Reference: +module Web.Ohloh.Repository ( + Repository(..), + RepositoryType(..), + xpRepository +) where + +import Data.Lens.Common +import Text.XML.HXT.Arrow.Pickle + +import Web.Ohloh.Common +import Web.Ohloh.Lens.IdL + +data RepositoryType = + SvnRepository | + CvsRepository | + GitRepository | + HgRepository | + BzrRepository | + SvnSyncRepository + deriving (Eq, Read, Show) + +-- | 'Repository' represents an individual source control repository. +data Repository = Repository { + repoId :: String, + repoRepoType :: RepositoryType, + repoUrl :: String, + repoModuleName :: Maybe String, + repoUsername :: Maybe String, + repoPassword :: Maybe String, + repoLoggedAt :: String, + repoCommits :: Int, + repoOhlohJobStatus :: String +} deriving (Eq, Read, Show) + +instance XmlPickler Repository where + xpickle = xpRepository + +instance ReadXmlString Repository +instance ShowXmlString Repository + +xpRepository :: PU Repository +xpRepository = + xpElem "repository" $ + xpWrap (uncurry9 Repository, + \(Repository i rt u mn un pw la c ojs) -> + (i, rt, u, mn, un, pw, la, c, ojs)) $ + xp9Tuple (xpElem "id" xpText0) + (xpElem "type" xpPrim) + (xpElem "url" xpText0) + (xpOption (xpElem "module_name" xpText0)) + (xpOption (xpElem "username" xpText0)) + (xpOption (xpElem "password" xpText0)) + (xpElem "logged_at" xpText0) + (xpElem "commits" xpInt) + (xpElem "ohloh_job_status" xpText0) + +instance IdL Repository where + idL = lens repoId $ \id repo -> repo { repoId = id } diff --git a/Web/Ohloh/Response.hs b/Web/Ohloh/Response.hs new file mode 100644 --- /dev/null +++ b/Web/Ohloh/Response.hs @@ -0,0 +1,43 @@ +-- Copyright © 2012 Frank S. Thomas +-- All rights reserved. +-- +-- Use of this source code is governed by a BSD-style license that +-- can be found in the LICENSE file. + +module Web.Ohloh.Response ( + Response(..), + xpResponse +) where + +import Text.XML.HXT.Arrow.Pickle + +import Web.Ohloh.Common +import Web.Ohloh.ResultType + +data Response = Response { + respStatus :: String, + respError :: Maybe String, + respItemsReturned :: Maybe Int, + respItemsAvailable :: Maybe Int, + respFirstItemPosition :: Maybe Int, + respResult :: [ResultType] +} deriving (Eq, Show, Read) + +instance XmlPickler Response where + xpickle = xpResponse + +instance ReadXmlString Response +instance ShowXmlString Response + +xpResponse :: PU Response +xpResponse = + xpElem "response" $ + xpWrap (uncurry6 Response, + \(Response s e ir ia fip r) -> + (s, e, ir, ia, fip, r)) $ + xp6Tuple (xpElem "status" xpText0) + (xpOption (xpElem "error" xpText0)) + (xpOption (xpElem "items_returned" xpInt)) + (xpOption (xpElem "items_available" xpInt)) + (xpOption (xpElem "first_item_position" xpInt)) + (xpElem "result" xpickle) diff --git a/Web/Ohloh/ResultType.hs b/Web/Ohloh/ResultType.hs new file mode 100644 --- /dev/null +++ b/Web/Ohloh/ResultType.hs @@ -0,0 +1,87 @@ +-- Copyright © 2012 Frank S. Thomas +-- All rights reserved. +-- +-- Use of this source code is governed by a BSD-style license that +-- can be found in the LICENSE file. + +module Web.Ohloh.ResultType ( + ResultType(..), + xpResultType +) where + +import Text.XML.HXT.Arrow.Pickle + +import Web.Ohloh.Account +import Web.Ohloh.ActivityFact +import Web.Ohloh.Analysis +import Web.Ohloh.ContributorFact +import Web.Ohloh.ContributorLanguageFact +import Web.Ohloh.Enlistment +import Web.Ohloh.Factoid +import Web.Ohloh.Kudo +import Web.Ohloh.Language +import Web.Ohloh.Project +import Web.Ohloh.SizeFact +import Web.Ohloh.Stack + +-- | ResultType is a simple sum type that can hold those types which can be part +-- of the @\/response\/result@ element (see 'Ohloh.Response.respResult'). +data ResultType = + AccountR Account | + ActivityFactR ActivityFact | + AnalysisR Analysis | + ContributorFactR ContributorFact | + ContributorLanguageFactR ContributorLanguageFact | + EnlistmentR Enlistment | + FactoidR Factoid | + KudoR Kudo | + LanguageR Language | + ProjectR Project | + SizeFactR SizeFact | + StackR Stack + deriving (Eq, Read, Show) + +instance XmlPickler ResultType where + xpickle = xpResultType + +xpResultType :: PU ResultType +xpResultType = xpAlt tag ps + where + tag (AccountR _) = 0 + tag (ActivityFactR _) = 1 + tag (AnalysisR _) = 2 + tag (ContributorFactR _) = 3 + tag (ContributorLanguageFactR _) = 4 + tag (EnlistmentR _) = 5 + tag (FactoidR _) = 6 + tag (KudoR _) = 7 + tag (LanguageR _) = 8 + tag (ProjectR _) = 9 + tag (SizeFactR _) = 10 + tag (StackR _) = 11 + ps = [ + xpWrap (AccountR, \(AccountR x) -> x) + xpAccount, + xpWrap (ActivityFactR, \(ActivityFactR x) -> x) + xpActivityFact, + xpWrap (AnalysisR, \(AnalysisR x) -> x) + xpAnalysis, + xpWrap (ContributorFactR, \(ContributorFactR x) -> x) + xpContributorFact, + xpWrap (ContributorLanguageFactR, \(ContributorLanguageFactR x) -> x) + xpContributorLanguageFact, + xpWrap (EnlistmentR, \(EnlistmentR x) -> x) + xpEnlistment, + xpWrap (FactoidR, \(FactoidR x) -> x) + xpFactoid, + xpWrap (KudoR, \(KudoR x) -> x) + xpKudo, + xpWrap (LanguageR, \(LanguageR x) -> x) + xpLanguage, + xpWrap (ProjectR, \(ProjectR x) -> x) + xpProject, + xpWrap (SizeFactR, \(SizeFactR x) -> x) + xpSizeFact, + xpWrap (StackR, \(StackR x) -> x) + xpStack + ] diff --git a/Web/Ohloh/SizeFact.hs b/Web/Ohloh/SizeFact.hs new file mode 100644 --- /dev/null +++ b/Web/Ohloh/SizeFact.hs @@ -0,0 +1,47 @@ +-- Copyright © 2012 Frank S. Thomas +-- All rights reserved. +-- +-- Use of this source code is governed by a BSD-style license that +-- can be found in the LICENSE file. + +-- | Ohloh API Reference: +module Web.Ohloh.SizeFact ( + SizeFact(..), + xpSizeFact +) where + +import Text.XML.HXT.Arrow.Pickle + +import Web.Ohloh.Common + +-- | 'SizeFact' is a pre-computed collection of statistics about +-- 'Web.Ohloh.Project.Project' source code. +data SizeFact = SizeFact { + sfMonth :: String, + sfCode :: Int, + sfComments :: Int, + sfBlanks :: Int, + sfCommentRatio :: Double, + sfCommits :: Int, + sfManMonths :: Int +} deriving (Eq, Read, Show) + +instance XmlPickler SizeFact where + xpickle = xpSizeFact + +instance ReadXmlString SizeFact +instance ShowXmlString SizeFact + +xpSizeFact :: PU SizeFact +xpSizeFact = + xpElem "size_fact" $ + xpWrap (uncurry7 SizeFact, + \(SizeFact m c co b cr cm mm) -> + (m, c, co, b, cr, cm, mm)) $ + xp7Tuple (xpElem "month" xpText0) + (xpElem "code" xpInt) + (xpElem "comments" xpInt) + (xpElem "blanks" xpInt) + (xpElem "comment_ratio" xpPrim) + (xpElem "commits" xpInt) + (xpElem "man_months" xpInt) diff --git a/Web/Ohloh/Stack.hs b/Web/Ohloh/Stack.hs new file mode 100644 --- /dev/null +++ b/Web/Ohloh/Stack.hs @@ -0,0 +1,60 @@ +-- Copyright © 2012 Frank S. Thomas +-- All rights reserved. +-- +-- Use of this source code is governed by a BSD-style license that +-- can be found in the LICENSE file. + +-- | Ohloh API Reference: +module Web.Ohloh.Stack ( + Stack(..), + xpStack +) where + +import Data.Lens.Common +import Text.XML.HXT.Arrow.Pickle + +import Web.Ohloh.Account +import Web.Ohloh.Common +import Web.Ohloh.Lens.IdL +import Web.Ohloh.Lens.UpdatedAtL +import Web.Ohloh.StackEntry + +-- | 'Stack' represents a collection of 'Web.Ohloh.Project.Project's used by +-- a single person. +data Stack = Stack { + staId :: String, + staTitle :: String, + staDescription :: String, + staUpdatedAt :: String, + staProjectCount :: Int, + staStackEntries :: [StackEntry], + staAccountId :: String, + staAccount :: Maybe Account +} deriving (Eq, Read, Show) + +instance XmlPickler Stack where + xpickle = xpStack + +instance ReadXmlString Stack +instance ShowXmlString Stack + +xpStack :: PU Stack +xpStack = + xpElem "stack" $ + xpWrap (uncurry8 Stack, + \(Stack i t d ua pc se ai a) -> + (i, t, d, ua, pc, se, ai, a)) $ + xp8Tuple (xpElem "id" xpText0) + (xpElem "title" xpText0) + (xpElem "description" xpText0) + (xpElem "updated_at" xpText0) + (xpElem "project_count" xpInt) + (xpElem "stack_entries" (xpList xpickle)) + (xpElem "account_id" xpText0) + (xpOption xpAccount) + +instance IdL Stack where + idL = lens staId $ \id sta -> sta { staId = id } + +instance UpdatedAtL Stack where + updatedAtL = lens staUpdatedAt $ \updatedAt sta -> sta { staUpdatedAt = updatedAt } diff --git a/Web/Ohloh/StackEntry.hs b/Web/Ohloh/StackEntry.hs new file mode 100644 --- /dev/null +++ b/Web/Ohloh/StackEntry.hs @@ -0,0 +1,49 @@ +-- Copyright © 2012 Frank S. Thomas +-- All rights reserved. +-- +-- Use of this source code is governed by a BSD-style license that +-- can be found in the LICENSE file. + +-- | Ohloh API Reference: +module Web.Ohloh.StackEntry ( + StackEntry(..), + xpStackEntry +) where + +import Data.Lens.Common +import Text.XML.HXT.Arrow.Pickle + +import Web.Ohloh.Common +import Web.Ohloh.Lens.IdL +import Web.Ohloh.Project + +-- | 'StackEntry' joins one 'Web.Ohloh.Stack.Stack' to one +-- 'Web.Ohloh.Project.Project'. +data StackEntry = StackEntry { + seId :: String, + seStackId :: String, + seProjectId :: String, + seCreatedAt :: String, + seProject :: Maybe Project +} deriving (Eq, Read, Show) + +instance XmlPickler StackEntry where + xpickle = xpStackEntry + +instance ReadXmlString StackEntry +instance ShowXmlString StackEntry + +xpStackEntry :: PU StackEntry +xpStackEntry = + xpElem "stack_entry" $ + xpWrap (uncurry5 StackEntry, + \(StackEntry i si pi ca p) -> + (i, si, pi, ca, p)) $ + xp5Tuple (xpElem "id" xpText0) + (xpElem "stack_id" xpText0) + (xpElem "project_id" xpText0) + (xpElem "created_at" xpText0) + (xpOption xpProject) + +instance IdL StackEntry where + idL = lens seId $ \id se -> se { seId = id } diff --git a/ohloh-hs.cabal b/ohloh-hs.cabal new file mode 100644 --- /dev/null +++ b/ohloh-hs.cabal @@ -0,0 +1,118 @@ +name: ohloh-hs +version: 0.0.1 +synopsis: Interface to the Ohloh API +description: + ohloh-hs is an interface to the Ohloh API (), which + provides access to the data of the Ohloh open source directory. It consists + mainly of simple data types for the items exposed by the API and + corresponding "Text.XML.HXT.Arrow.Pickle" pickler functions in order to + convert those types from\/to XML easily. + +homepage: https://github.com/fthomas/ohloh-hs +bug-reports: https://github.com/fthomas/ohloh-hs/issues +license: BSD3 +license-file: LICENSE +author: Frank S. Thomas +maintainer: Frank S. Thomas +category: Web +stability: experimental +build-type: Simple +cabal-version: >= 1.9.2 +extra-source-files: README.md TODO tests/read-haskell.xml + +source-repository head + type: git + location: https://github.com/fthomas/ohloh-hs + +library + exposed-modules: Web.Ohloh + Web.Ohloh.Account + Web.Ohloh.ActivityFact + Web.Ohloh.Analysis + Web.Ohloh.ContributorFact + Web.Ohloh.ContributorLanguageFact + Web.Ohloh.Enlistment + Web.Ohloh.Factoid + Web.Ohloh.Kudo + Web.Ohloh.KudoScore + Web.Ohloh.Language + Web.Ohloh.Lens.IdL + Web.Ohloh.Lens.NameL + Web.Ohloh.Lens.UpdatedAtL + Web.Ohloh.Project + Web.Ohloh.Repository + Web.Ohloh.Response + Web.Ohloh.ResultType + Web.Ohloh.SizeFact + Web.Ohloh.Stack + Web.Ohloh.StackEntry + build-depends: base >= 4 && < 5, + data-lens, + hxt, + text-format-simple + +executable cmdoh + main-is: cmdoh.hs + hs-source-dirs: . tools + ghc-options: -Wall + -fno-warn-missing-signatures + -fno-warn-name-shadowing + build-depends: base >= 4 && < 5, + data-lens, + hxt, + hxt-curl, + cmdargs, + pretty-show, + text-format-simple + +--executable fetch-haskell +-- main-is: fetch-haskell.hs +-- hs-source-dirs: . tests +-- ghc-options: -Wall +-- -fno-warn-missing-signatures +-- -fno-warn-name-shadowing +-- build-depends: base >= 4 && < 5, +-- data-lens, +-- hxt, +-- hxt-curl, +-- pretty-show, +-- text-format-simple +-- +--executable read-haskell +-- main-is: read-haskell.hs +-- hs-source-dirs: . tests +-- ghc-options: -Wall +-- -fno-warn-missing-signatures +-- -fno-warn-name-shadowing +-- build-depends: base >= 4 && < 5, +-- data-lens, +-- hxt, +-- pretty-show, +-- text-format-simple +-- +--executable update-queries +-- main-is: update.hs +-- hs-source-dirs: . tests/queries +-- ghc-options: -Wall +-- -fno-warn-missing-signatures +-- -fno-warn-name-shadowing +-- build-depends: base >= 4 && < 5, +-- bytestring, +-- data-lens, +-- download-curl, +-- hxt, +-- text-format-simple + +test-suite tests + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: tests + ghc-options: -Wall + -fno-warn-name-shadowing + build-depends: base >= 4 && < 5, + data-lens, + hxt, + text-format-simple, + test-framework, + test-framework-quickcheck2, + QuickCheck diff --git a/tests/Main.hs b/tests/Main.hs new file mode 100644 --- /dev/null +++ b/tests/Main.hs @@ -0,0 +1,304 @@ +-- Copyright © 2012 Frank S. Thomas +-- All rights reserved. +-- +-- Use of this source code is governed by a BSD-style license that +-- can be found in the LICENSE file. + +{-# OPTIONS -fno-warn-missing-signatures + -fno-warn-orphans #-} + +import Test.QuickCheck +import Test.Framework (defaultMain, testGroup) +import Test.Framework.Providers.QuickCheck2 (testProperty) + +import Text.XML.HXT.Core + +import Web.Ohloh + +main :: IO () +main = defaultMain tests + + +tests = [ + testGroup "Account" [ + testProperty "pickleUnpickle" (prop_pickleUnpickle :: Account -> Bool) + ], + testGroup "ActivityFact" [ + testProperty "pickleUnpickle" (prop_pickleUnpickle :: ActivityFact -> Bool) + ], + testGroup "Analysis" [ + testProperty "pickleUnpickle" (prop_pickleUnpickle :: Analysis -> Bool) + ], + testGroup "ContributorFact" [ + testProperty "pickleUnpickle" (prop_pickleUnpickle :: ContributorFact -> Bool) + ], + testGroup "ContributorLanguageFact" [ + testProperty "pickleUnpickle" (prop_pickleUnpickle :: ContributorLanguageFact -> Bool) + ], + testGroup "Enlistment" [ + testProperty "pickleUnpickle" (prop_pickleUnpickle :: Enlistment -> Bool) + ], + testGroup "Factoid" [ + testProperty "pickleUnpickle" (prop_pickleUnpickle :: Factoid -> Bool) + ], + testGroup "Kudo" [ + testProperty "pickleUnpickle" (prop_pickleUnpickle :: Kudo -> Bool) + ], + testGroup "KudoScore" [ + testProperty "pickleUnpickle" (prop_pickleUnpickle :: KudoScore -> Bool) + ], + testGroup "Language" [ + testProperty "pickleUnpickle" (prop_pickleUnpickle :: Language -> Bool) + ], + testGroup "Project" [ + testProperty "pickleUnpickle" (prop_pickleUnpickle :: Project -> Bool) + ], + testGroup "Repository" [ + testProperty "pickleUnpickle" (prop_pickleUnpickle :: Repository -> Bool) + ], + testGroup "SizeFact" [ + testProperty "pickleUnpickle" (prop_pickleUnpickle :: SizeFact -> Bool) + ], + testGroup "Stack" [ + testProperty "pickleUnpickle" (prop_pickleUnpickle :: Stack -> Bool) + ], + testGroup "StackEntry" [ + testProperty "pickleUnpickle" (prop_pickleUnpickle :: StackEntry -> Bool) + ] + ] + +prop_pickleUnpickle x = (unpickleDoc xpickle . pickleDoc xpickle) x == Just x + + +legalXmlCharsSubset = ['\x9', '\xA', '\xD'] ++ ['\x20' .. '\xFF'] + +xmlTextGen :: Gen String +xmlTextGen = (listOf . elements) legalXmlCharsSubset + +instance Arbitrary Account where + arbitrary = do + i <- xmlTextGen + n <- xmlTextGen + a <- xmlTextGen + log <- xmlTextGen + ca <- xmlTextGen + ua <- xmlTextGen + hu <- xmlTextGen + ta <- xmlTextGen + u <- xmlTextGen + htu <- xmlTextGen + au <- xmlTextGen + es <- xmlTextGen + pc <- arbitrary + l <- xmlTextGen + cc <- xmlTextGen + la <- xmlTextGen + lo <- xmlTextGen + ks <- arbitrary + return (Account i n (Just a) log ca ua (Just hu) (Just ta) u htu au es pc (Just l) (Just cc) (Just la) (Just lo) ks) + +instance Arbitrary ActivityFact where + arbitrary = do + m <- xmlTextGen + ca <- arbitrary + cr <- arbitrary + coa <- arbitrary + cor <- arbitrary + ba <- arbitrary + br <- arbitrary + c <- arbitrary + co <- arbitrary + return (ActivityFact m ca cr coa cor ba br c co) + +instance Arbitrary Analysis where + arbitrary = do + i <- xmlTextGen + pi <- xmlTextGen + ua <- xmlTextGen + la <- xmlTextGen + min <- xmlTextGen + max <- xmlTextGen + tmcc <- arbitrary + tcl <- arbitrary + mli <- xmlTextGen + mln <- xmlTextGen + return (Analysis i pi ua la min max tmcc tcl mli mln) + +instance Arbitrary ContributorFact where + arbitrary = do + ci <- xmlTextGen + aci <- xmlTextGen + acn <- xmlTextGen + ai <- xmlTextGen + cn <- xmlTextGen + pli <- xmlTextGen + plnn <- xmlTextGen + cr <- arbitrary + fct <- xmlTextGen + lct <- xmlTextGen + mm <- arbitrary + c <- arbitrary + mc <- arbitrary + clf <- arbitrary + return (ContributorFact ci (Just aci) (Just acn) ai cn pli plnn cr fct lct mm c mc clf) + +instance Arbitrary ContributorLanguageFact where + arbitrary = do + ai <- xmlTextGen + ci <- xmlTextGen + cn <- xmlTextGen + li <- xmlTextGen + lnn <- xmlTextGen + cr <- arbitrary + mm <- arbitrary + c <- arbitrary + mc <- arbitrary + return (ContributorLanguageFact ai ci cn li lnn cr mm c mc) + +instance Arbitrary Enlistment where + arbitrary = do + i <- xmlTextGen + pi <- xmlTextGen + ri <- xmlTextGen + r <- arbitrary + return (Enlistment i pi ri r) + +instance Arbitrary FactoidType where + arbitrary = + elements [FactoidActivityDecreasing, + FactoidActivityIncreasing, + FactoidAgeYoung, + FactoidAgeOld, + FactoidAgeVeryOld, + FactoidCommentsVeryLow, + FactoidCommentsLow, + FactoidCommentsHigh, + FactoidCommentsVeryHigh, + FactoidTeamSizeZero, + FactoidTeamSizeOne, + FactoidTeamSizeSmall, + FactoidTeamSizeLarge, + FactoidTeamSizeVeryLarge, + FactoidGplConflict] + +instance Arbitrary Factoid where + arbitrary = do + i <- xmlTextGen + ai <- xmlTextGen + t <- arbitrary + d <- xmlTextGen + s <- arbitrary + li <- xmlTextGen + return (Factoid i ai t d s (Just li)) + +instance Arbitrary Kudo where + arbitrary = do + ca <- xmlTextGen + sai <- arbitrary + san <- arbitrary + rai <- arbitrary + ran <- arbitrary + pi <- arbitrary + pn <- arbitrary + ci <- arbitrary + cn <- arbitrary + return (Kudo ca sai san rai ran pi pn ci cn) + +instance Arbitrary KudoScore where + arbitrary = do + ca <- xmlTextGen + kr <- arbitrary + p <- arbitrary + mp <- arbitrary + pd <- arbitrary + return (KudoScore (Just ca) kr p mp pd) + +instance Arbitrary Language where + arbitrary = do + i <- xmlTextGen + n <- xmlTextGen + nn <- xmlTextGen + ca <- xmlTextGen + co <- arbitrary + cm <- arbitrary + b <- arbitrary + cr <- arbitrary + p <- arbitrary + cn <- arbitrary + ci <- arbitrary + return (Language i n nn ca co cm b cr p cn ci) + +instance Arbitrary Project where + arbitrary = do + i <- xmlTextGen + u <- xmlTextGen + htu <- xmlTextGen + n <- xmlTextGen + ca <- xmlTextGen + ua <- xmlTextGen + d <- xmlTextGen + hu <- xmlTextGen + du <- xmlTextGen + un <- xmlTextGen + mlu <- xmlTextGen + slu <- xmlTextGen + uc <- arbitrary + ar <- xmlTextGen + rc <- arbitrary + ai <- xmlTextGen + a <- arbitrary + return (Project i n u htu ca ua (Just d) (Just hu) (Just du) un mlu slu uc ar rc ai a) + +instance Arbitrary RepositoryType where + arbitrary = + elements [SvnRepository, + CvsRepository, + GitRepository, + HgRepository, + BzrRepository, + SvnSyncRepository] + +instance Arbitrary Repository where + arbitrary = do + i <- xmlTextGen + rt <- arbitrary + u <- xmlTextGen + mn <- xmlTextGen + un <- xmlTextGen + pw <- xmlTextGen + la <- xmlTextGen + c <- arbitrary + ojs <- xmlTextGen + return (Repository i rt u (Just mn) (Just un) (Just pw) la c ojs) + +instance Arbitrary SizeFact where + arbitrary = do + m <- xmlTextGen + c <- arbitrary + co <- arbitrary + b <- arbitrary + cr <- arbitrary + cm <- arbitrary + mm <- arbitrary + return (SizeFact m c co b cr cm mm) + +instance Arbitrary Stack where + arbitrary = do + i <- xmlTextGen + t <- xmlTextGen + d <- xmlTextGen + ua <- xmlTextGen + pc <- arbitrary + se <- arbitrary + ai <- xmlTextGen + a <- arbitrary + return (Stack i t d ua pc se ai (Just a)) + +instance Arbitrary StackEntry where + arbitrary = do + i <- xmlTextGen + si <- xmlTextGen + pi <- xmlTextGen + ca <- xmlTextGen + p <- arbitrary + return (StackEntry i si pi ca (Just p)) diff --git a/tests/read-haskell.xml b/tests/read-haskell.xml new file mode 100644 --- /dev/null +++ b/tests/read-haskell.xml @@ -0,0 +1,19 @@ + + + success + + + 38 + haskell + Haskell + code + 4707403 + 1000082 + 931974 + 0.175222887138556 + 2134 + 3589 + 201723 + + + diff --git a/tools/cmdoh.hs b/tools/cmdoh.hs new file mode 100644 --- /dev/null +++ b/tools/cmdoh.hs @@ -0,0 +1,48 @@ +-- Copyright © 2012 Frank S. Thomas +-- All rights reserved. +-- +-- Use of this source code is governed by a BSD-style license that +-- can be found in the LICENSE file. + +{-# LANGUAGE DeriveDataTypeable, RecordWildCards #-} + +module Main where + +import Data.Maybe +import System.Console.CmdArgs +import Text.Show.Pretty +import Text.XML.HXT.Core +import Text.XML.HXT.Curl + +import Web.Ohloh + +data CmdOh = Read {file :: Maybe FilePath} + | Fetch {key :: String, queryItem :: String, queryArgs :: [String]} + deriving (Show, Data, Typeable) + +cmdRead = Read { + file = def &= typ "FILE" &= help "Read data from FILE" +} + +cmdFetch = Fetch { + key = def &= typ "KEY" &= help "Ohloh API key", + queryItem = def &= argPos 0, + queryArgs = def &= args &= typ "ITEM_ARGS" +} + +main :: IO () +main = do + args <- cmdArgs $ modes [cmdRead, cmdFetch] + handleArgs args + +handleArgs Read{..} = do + res <- runX $ xunpickleDocument xpResponse [ withRemoveWS yes ] $ fromMaybe "" file + putStrLn $ ppShow $ head res + +handleArgs Fetch{..} = do + let maybeUrl = queryUrl queryItem queryArgs `withApiKey` key + case maybeUrl of + Nothing -> putStrLn $ "Unknown query item: " ++ queryItem + Just url -> do + res <- runX $ xunpickleDocument xpResponse [ withRemoveWS yes, withCurl [] ] url + putStrLn $ ppShow $ head res