diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,29 @@ +Copyright (c) 2015, Rogan Creswick +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 Rogan Creswick nor the names of his or her +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 +HOLDER 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/cabalQuery.cabal b/cabalQuery.cabal new file mode 100644 --- /dev/null +++ b/cabalQuery.cabal @@ -0,0 +1,49 @@ +name: cabalQuery +version: 0.1.0.0 +synopsis: A simple tool to query cabal files. +description: Command line access to the cabal package description + files. + . + cabalQuery allows you to query one or more .cabal files + for fields that may be useful in other contexts, such + as a build system, where you may need the version number, + lincense, authors, copyright, etc.. in a programatic way, + but without access to the Cabal libraries. +license: BSD3 +homepage: http://github.com/creswick/cabal-query +Bug-Reports: http://github.com/creswick/cabal-query/issues +license-file: LICENSE +author: Rogan Creswick +maintainer: creswick@gmail.com +copyright: 2015, Rogan Creswick +category: Development +build-type: Simple +-- extra-source-files: +cabal-version: >=1.18 + +source-repository head + type: git + location: git://github.com/creswick/cabal-query.git + +library + exposed-modules: Distribution.Query + build-depends: base >=4.6 && <4.7, + Cabal >= 1.22, + pretty + + hs-source-dirs: src + default-language: Haskell2010 + ghc-options: -Wall + +executable cabalQuery + default-language: Haskell2010 + hs-source-dirs: tools + main-is: Main.hs + + build-depends: base >=4.6 && <4.7, + Cabal >= 1.22, + cabal-query, + MissingH, + containers + + ghc-options: -Wall 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,60 @@ +module Distribution.Query where + +import Data.List +import Data.Version (showVersion) +import Distribution.Package +import Distribution.PackageDescription (GenericPackageDescription) +import qualified Distribution.PackageDescription as PD +import Distribution.PackageDescription.Parse +import Distribution.Text +import Distribution.Version + +import Text.PrettyPrint (render) + +loadDescr :: FilePath -> IO (Either String GenericPackageDescription) +loadDescr cabalFile = do + content <- readFile cabalFile + return $ case parsePackageDescription content of + ParseFailed err -> Left (show err) + ParseOk _ gpd -> Right gpd + +numericVersion :: GenericPackageDescription -> String +numericVersion = showVersion . pkgVersion . PD.package . PD.packageDescription + +name :: GenericPackageDescription -> String +name = unPackageName . pkgName . PD.package . PD.packageDescription + +license :: GenericPackageDescription -> String +license = render . disp . PD.license . PD.packageDescription + +copyright :: GenericPackageDescription -> String +copyright = getField PD.copyright + +homepage :: GenericPackageDescription -> String +homepage = getField PD.homepage + +pkgUrl :: GenericPackageDescription -> String +pkgUrl = getField PD.pkgUrl + +bugReports :: GenericPackageDescription -> String +bugReports = getField PD.bugReports + +category :: GenericPackageDescription -> String +category = getField PD.category + +buildType :: GenericPackageDescription -> String +buildType = getField PD.buildType + +dataDir :: GenericPackageDescription -> String +dataDir = getField PD.dataDir + +synopsis :: GenericPackageDescription -> String +synopsis = getField PD.synopsis + +description :: GenericPackageDescription -> String +description = getField PD.description + + + +getField :: Show a => (PD.PackageDescription -> a) -> GenericPackageDescription -> String +getField getter = show . getter . PD.packageDescription diff --git a/tools/Main.hs b/tools/Main.hs new file mode 100644 --- /dev/null +++ b/tools/Main.hs @@ -0,0 +1,111 @@ +module Main where + +import System.Environment +import System.IO + +import Data.Either +import Data.List (isInfixOf, intercalate) +import Data.Map (Map) +import qualified Data.Map as Map +import Data.String.Utils +import Distribution.Query +import Distribution.PackageDescription (GenericPackageDescription) + +main :: IO () +main = do + args <- getArgs + eCfg <- parseArgs args + case eCfg of + Nothing -> printHelp + Just cfg | ["--help"] `isInfixOf` (options cfg) -> printHelp + | otherwise -> do + let cmds = map cmdFn $ commands cfg + mapM_ (query cmds) (files cfg) + +printHelp :: IO () +printHelp = do + putStrLn "Usage: cabalQuery [command] [cabalfile] [options]" + putStrLn "" + putStrLn "Commands, files and options can be interspersed." + putStrLn "" + putStrLn "Options:" + putStrLn " --help Prints this help output." + putStrLn " --version Nothing, yet." + putStrLn " --numeric-version Nothing, yet." + putStrLn "" + putStrLn "Commands:" + mapM_ (\cmd -> putStrLn (" " ++ (cmdName cmd) ++ "\t\t" ++ (cmdDesc cmd))) commandList + +commandMap :: Map String Command +commandMap = Map.fromList $ map (\cmd -> (cmdName cmd, cmd)) commandList + +commandList :: [Command] +commandList = + [ Command "numeric-version" + "Returns the numeric version in a machine-readable fashion." numericVersion + , Command "version" "An alias for numeric-version" numericVersion + , Command "name" "The package name." name + , Command "license" "The package license." license + , Command "copyright" "The package copyright." copyright + , Command "homepage" "The package homepage." homepage + , Command "pkgUrl" "The package url." pkgUrl + , Command "bugReports" "The bug reporting url." bugReports + , Command "synopsis" "The package synopsis." synopsis + , Command "description" "The package description." description + , Command "buildType" "The buildType." buildType + , Command "dataDir" "The dataDir." dataDir + ] + +data Command = Command { cmdName :: String + -- ^ The name of the command, as written on the command line. + , cmdDesc :: String + -- ^ A description of the command, for help output. + , cmdFn :: GenericPackageDescription -> String + -- ^ The function over a package description + -- to get the string value of the thing we're requesting. + } + +data Config = Config { files :: [FilePath] + -- ^ The cabal file(s) to examine. Defaults to ./*.cabal + , commands :: [Command] + -- ^ The things to show, from the cabal file. + -- e.g., 'numeric-version' + , options :: [String] + -- ^ Any options to pass to cabalQuery, starting with "--" + } + +toCommand :: String -> Either String Command +toCommand str = case Map.lookup str commandMap of + Nothing -> Left str + Just cmd -> Right cmd + +parseArgs :: [String] -> IO (Maybe Config) +parseArgs args = do + let eCmds = map toCommand $ filter isCommand args + case (lefts eCmds, rights eCmds) of + ([] , cmds) -> + return (Just (Config { files = filter isCabalFile args + , options = filter isOption args + , commands = cmds + })) + (errs, _) -> do + hPutStrLn stderr "Invalid commands specified:" + mapM_ (hPrint stderr) errs + return Nothing + +isCabalFile :: FilePath -> Bool +isCabalFile file = endswith ".cabal" file + +isOption :: String -> Bool +isOption str = startswith "--" str + +isCommand :: String -> Bool +isCommand str = not (isOption str || isCabalFile str) + + +query :: [GenericPackageDescription -> String] -> FilePath -> IO () +query cmds file = do + eGpb <- loadDescr file + case eGpb of + Left err -> hPrint stderr err + Right gpb -> putStrLn $ intercalate ", " (map ($ gpb) cmds)