diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,29 @@ +Copyright (c) 2009, Max Desyatov +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. + + * 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 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,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/cabal-query.cabal b/cabal-query.cabal new file mode 100644 --- /dev/null +++ b/cabal-query.cabal @@ -0,0 +1,30 @@ +name: cabal-query +version: 0.1 +copyright: (c) 2009 Max Desyatov +category: System +maintainer: Max Desyatov +author: Max Desyatov +license: BSD3 +license-file: LICENSE +cabal-version: >= 1.6 +synopsis: Helpers for quering .cabal files or hackageDB's 00-index.tar +description: This package was written to assist you at finding a set of packages, + which satisfy your needs. At the moment it doesn't have a standalone executable, + but you can do the queries from your Haskell code. +stability: Experimental +build-type: Simple +homepage: http://github.com/explicitcall/cabal-query +bug-reports: http://github.com/explicitcall/cabal-query/issues + +library + exposed-modules: Distribution.Query + other-modules: Distribution.Query.TH, + Distribution.Query.Types + hs-source-dirs: src + ghc-options: -Wall -fno-warn-orphans + build-depends: base >= 4 && < 5, mtl, template-haskell, derive, Cabal >= 1.6 && < 1.7, + MissingH, uniplate, bytestring, tar, ghc >= 6.10 && < 6.11 + +source-repository head + type: git + location: git://github.com/explicitcall/cabal-query.git diff --git a/src/Distribution/Query.hs b/src/Distribution/Query.hs new file mode 100644 --- /dev/null +++ b/src/Distribution/Query.hs @@ -0,0 +1,88 @@ +{-# LANGUAGE ScopedTypeVariables #-} + +-- | This package uses "Data.Generics.PlateData", so +-- +-- * when Cabal package format changes, we don't have to rewrite anything +-- +-- * all queries are statically typed +-- +-- * as a disadvantage, we may suffer some performance loss when doing very complex queries, +-- anyway most of processing goes while we read package descriptions, not querying them +-- +-- Example of enduser querying code: +-- +-- @ +--module Main where +-- +-- import qualified Data.ByteString.Lazy as B +--import System.Environment +--import Distribution.Query +--import Distribution.Compiler +--import Distribution.License +--import Distribution.ModuleName hiding (main) +--import Distribution.Package +--import Distribution.PackageDescription +--import Distribution.Version +--import Distribution.Text +--import Language.Haskell.Extension +-- +-- main = (head \`fmap\` getArgs) >>= +-- B.readFile >>= +-- mapM_ (putStrLn . show . (\x -> (display $ package x, display $ license x))) . +-- queryIndex (Not (Id (== GPL)) :& Not (Id (== BSD3))) +-- @ +-- +-- You can query any field of 'PackageDescription' no matter how deep it is. +-- You don't need to provide any type signature for comparison functions, +-- which are wrapped in 'Id', as long as you use data constructors for which type can be inferred. +-- +-- See 'PackageDescription' fields for details. +module Distribution.Query + ( queryFiles + , queryIndex + , module Distribution.Query.Types ) where + +import Codec.Archive.Tar as T hiding (unpack) +import Data.ByteString.Internal (w2c) +import Data.ByteString.Lazy (ByteString) +import qualified Data.ByteString.Lazy as B +import Data.Generics.PlateData +import Data.Maybe +import Distribution.PackageDescription +import Distribution.PackageDescription.Parse + +import Distribution.Query.Types + +-- | Queries an index file, which is commonly located at +-- <~/.cabal/packages/hackage.haskell.org/00-index.tar> in POSIX systems. +queryIndex :: Query + -> ByteString -- ^ The index file must be read as lazy ByteString + -> [PackageDescription] -- ^ Returns a list of package descriptions which satisfy the query +queryIndex q = procQuery q . foldEntries foldF [] (const []) . T.read + where + foldF :: Entry -> [PackageDescription] -> [PackageDescription] + foldF c rest = + case entryContent c of + NormalFile s _ -> maybe rest (:rest) $ parsePD s + _ -> rest + +parsePD :: ByteString -> Maybe PackageDescription +parsePD s = + case (parsePackageDescription $ map w2c $ B.unpack s) of + ParseOk _ x -> Just $ packageDescription x + _ -> Nothing + +-- | Queries .cabal files. +queryFiles :: Query + -> [ByteString] -- ^ All files must be read as lazy ByteStrings + -> [PackageDescription] -- ^ Returns a list of package descriptions which satisfy the query +queryFiles q = procQuery q . catMaybes . map parsePD + +procQuery :: Query -> [PackageDescription] -> [PackageDescription] +procQuery q = filter (doQuery q) + +doQuery :: Query -> PackageDescription -> Bool +doQuery (Id f) pd = or [f x | x <- universeBi pd] +doQuery (Not q) pd = not $ doQuery q pd +doQuery (q1 :& q2) pd = doQuery q1 pd && doQuery q2 pd +doQuery (q1 :| q2) pd = doQuery q1 pd || doQuery q2 pd diff --git a/src/Distribution/Query/TH.hs b/src/Distribution/Query/TH.hs new file mode 100644 --- /dev/null +++ b/src/Distribution/Query/TH.hs @@ -0,0 +1,8 @@ +module Distribution.Query.TH where + +import MonadUtils +import Data.DeriveTH +import Language.Haskell.TH + +deriveMany :: Derivation -> [Name] -> Q [Dec] +deriveMany = concatMapM . derive diff --git a/src/Distribution/Query/Types.hs b/src/Distribution/Query/Types.hs new file mode 100644 --- /dev/null +++ b/src/Distribution/Query/Types.hs @@ -0,0 +1,81 @@ +{-# LANGUAGE TemplateHaskell, GADTs #-} +module Distribution.Query.Types + ( Query(..) ) where + +import Data.Data +import Data.DeriveTH +import Data.List.Utils (join) +import Distribution.Compiler +import Distribution.License +import Distribution.ModuleName hiding (main) +import Distribution.Package +import Distribution.PackageDescription +import Distribution.Version +import Language.Haskell.Extension + +import Distribution.Query.TH + +-- | Heterogenous query tree. Example of constructed query: +-- +-- > Not (Id (== GPL)) :& Not (Id (== BSD3)) +-- +-- 'Id' takes comparison function as its argument. +-- Commonly this must be a partially applied ('/=') or ('=='). +-- Data instance is required for 'PackageDescription' traversal. +-- All appropriate instances are generated automagically, +-- so you don't have to bother as long as Cabal doesn't change its +-- package description format. +data Query where + (:&) :: Query -> Query -> Query + (:|) :: Query -> Query -> Query + Not :: Query -> Query + Id :: Data a => (a -> Bool) -> Query + +$(deriveMany makeTypeable + [''PackageDescription + ,''Executable + ,''Library + ,''BuildType + ,''VersionRange + ,''Dependency + ,''SourceRepo + ,''CompilerFlavor + ,''License + ,''PackageIdentifier + ,''BuildInfo + ,''ModuleName + ,''PackageName + ,''RepoType + ,''RepoKind + ,''Extension]) + +$(deriveMany makeData + [''PackageDescription + ,''Executable + ,''Library + ,''BuildType + ,''VersionRange + ,''Dependency + ,''SourceRepo + ,''CompilerFlavor + ,''License + ,''PackageIdentifier + ,''BuildInfo + ,''PackageName + ,''RepoType + ,''RepoKind + ,''Extension + ,''Version]) + +-- Workaround for ModuleName, see http://code.google.com/p/ndmitchell/issues/detail?id=209 +instance Data ModuleName where + gfoldl _ z = z . simple . join "." . components + gunfold _ z _ = z $ simple "" + toConstr _ = con_C + dataTypeOf _ = ty_T + +con_C :: Constr +con_C = mkConstr ty_T "ModuleName" [] Prefix + +ty_T :: DataType +ty_T = mkDataType "Distribution.ModuleName.ModuleName" [con_C]