diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for cabal-edit + +## 0.1.0.0 -- 2020-07-01 + +* Initial release. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,19 @@ +Copyright (c) 2020, Stephen Diehl + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to +deal in the Software without restriction, including without limitation the +rights to use, copy, modify, merge, publish, distribute, sublicense, and/or +sell copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in +all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS +IN THE SOFTWARE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,366 @@ +cabal-edit +========== + +![Cabal CI](https://github.com/sdiehl/cabal-edit/workflows/Cabal%20CI/badge.svg) +![Stack CI](https://github.com/sdiehl/cabal-edit/workflows/Stack%20CI/badge.svg) + +This is an extension to Haskell's package manager Cabal to allow you to add, +remove, and upgrade dependencies by modifying your cabal file from the +command line. This behaves similar to `install --save` commands in other +package managers. + + +* [`cabal-edit add`](#add) +* [`cabal-edit upgrade`](#upgrade) +* [`cabal-edit upgradeall`](#upgradeall) +* [`cabal-edit remove`](#remove) +* [`cabal-edit list`](#list) +* [`cabal-edit format`](#format) +* [`cabal-edit extensions`](#extensions) +* [`cabal-edit lint`](#lint) +* [`cabal-edit latest`](#latest) +* [`cabal-edit rebuild`](#rebuild) + +Usage +----- + +### add + +For example to setup a new project one often wants to add common dependencies +like `text` and `aeson`. We can use `cabal-edit` to automatically append these +to our dependency list and deduce the latest versions from Hackage. + +```bash +$ cabal init --lib --cabal-version=3.0 + +$ cabal-edit add aeson +Adding dependency: aeson ^>=1.5 to sample.cabal + +$ cabal-edit add text +Adding dependency: text ^>=1.2 to sample.cabal +``` + +If we want to depend on a specific version of `aeson`, we can pass this +explicitly as an argument. + +```bash +$ cabal-edit add aeson==1.4.0.0 +``` + +Multiple packages can be passed to the add command at once. For example: + +```bash +$ cabal-edit add base bytestring aeson text process filepath directory mtl transformers protolude +Adding latest dependency: base ^>=4.14 to sample.cabal +Adding latest dependency: bytestring ^>=0.10 to sample.cabal +Adding latest dependency: aeson ^>=1.5 to sample.cabal +Adding latest dependency: text ^>=1.2 to sample.cabal +Adding latest dependency: process ^>=1.6 to sample.cabal +Adding latest dependency: filepath ^>=1.4 to sample.cabal +Adding latest dependency: directory ^>=1.3 to sample.cabal +Adding latest dependency: mtl ^>=2.2 to sample.cabal +Adding latest dependency: transformers ^>=0.5 to sample.cabal +Adding latest dependency: protolude ^>=0.3 to sample.cabal +``` + +*Note: Dependency modification will happen over the library stanza of your Cabal +file, and not the executable sections.* + +### upgrade + +The upgrade command can be used to safely manipulate the version bounds for a +given library. For instance if one has a simple dependency on `text` for `1.0` +version range, like as follows: + + +```haskell +library + exposed-modules: MyLib + default-language: Haskell2010 + build-depends: + base >= 4.14 && <=5.0, + text ^>= 1.0 +``` + +We can bump the bound of this library to upgrade it to allow the latest version +from Hackage. We simply pass the `upgrade` command the name of the package (i.e. +`text`) and it will automatically figure out the appropriate version range for +the upgrade including previously version ranges. The resulting version ranges +will always have an upper bound and will conform to Hackage PVP standards. + +```bash +$ cabal-edit upgrade text +Upgrading bounds for text to 1.3 +``` + +This will produce the following modified Cabal file. + +```haskell +library + exposed-modules: MyLib + default-language: Haskell2010 + build-depends: + base >=4.14 && <=5.0, + text >=1.0 && <=1.3 +``` + +### upgradeall + +`upgradeall` behaves like `upgrade` but performs the version bound bump for all +available dependencies. This sets the upper bounds for all dependencies to the +latest available version on Hackage. + +```bash +$ cabal-edit upgradeall +Upgrading bounds for Cabal to 3.3 +Upgrading bounds for aeson to 1.6 +Upgrading bounds for base to 4.15 +Upgrading bounds for bytestring to 0.11 +Upgrading bounds for ghc to 8.11 +Upgrading bounds for text to 1.3 +``` + +### remove + +Remove will remove a given dependency from the file completely. + +``` +$ cabal-edit remove microlens +Removing depndency on microlens +``` + +### list + +The Hackage database can be queried from the command line to search for all +available versions to use with the `list` command. + +```bash +$ cabal-edit list filepath +1.0 +1.1.0.0 +1.1.0.1 +1.1.0.2 +1.1.0.3 +1.1.0.4 +1.2.0.0 +1.2.0.1 +1.3.0.0 +1.3.0.1 +1.3.0.2 +1.4.0.0 +1.4.1.0 +1.4.1.1 +1.4.1.2 +1.4.2 +1.4.2.1 +``` + +### format + +The `format` command will canonicalise the Cabal into by parsing it and running +it through the pretty printer again. + +```bash +$ cabal-edit format +Formatting: sample.cabal +``` + +### extensions + +The `extensions` command will enumerate all the default extensions enabled for +the given library. This is useful if you wish to add these headers to files +within the project. + +```bash +$ cabal-edit extensions + +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +``` + +### lint + +The `lint` command will detect common problems with your version bounds and +recommend package upgrades when available. + +```bash +$ cabal-edit lint +aeson : Consider upgrading major bound to latest version 1.6 +text : Consider upgrading major bound to latest version 1.3 +``` + +### latest + +The `latest` command will return the dependency string for adding the latest +version of a given package. + +```bash +$ cabal-edit latest aeson +aeson ^>=1.5 +``` + +### rebuild + +cabal-edit uses a cache of Hackage package versions internally. This is normally +built on first run and whenever the package database is older than 30 days. If +you wish to manually rebuild it after running `cabal update` then run: + +``` +$ cabal-edit rebuild +Done. +``` + +Installation +------------ + +Download this repository. + +```bash +$ git clone git@github.com:sdiehl/cabal-edit.git +$ cd cabal-edit +``` + +Then install either with Stack, Cabal or Nix. + +```bash +$ stack install +$ cabal install --installdir=/home/$USER/.local/bin +$ nix-build -A cabal-edit +``` + +*Note: This library links directly against Cabal, so you must be using the same +version of Cabal you intend to compile your package against. It is reccomened to +use Cabal > 3.0 to support modern versioning schemes.* + +Shell Completions +------------------ + +We can tab complete on the Hackage package index we install the local +completions for you shell. Run one of the following commands to generate the +shell completer appropriate to your shell. Then add the output to one of +`~/.zshrc`, `~/.bashrc` or `~/.config/fish/config.fish`. + +```bash +$ cabal-edit --zsh-completion-script cabal-edit +$ cabal-edit --bash-completion-script cabal-edit +$ cabal-edit --fish-completion-script cabal-edit +``` + +This will completion against the Hackage database prefixed by name. + +``` +$ cabal-edit add gh +zsh: do you wish to see all 103 possibilities (15 lines)? +$ cabal-edit add ghc-pa +ghc-parmake ghc-parser ghc-paths +``` + +**bash** + +```bash +_cabal-edit() +{ + local CMDLINE + local IFS=$'\n' + CMDLINE=(--bash-completion-index $COMP_CWORD) + + for arg in ${COMP_WORDS[@]}; do + CMDLINE=(${CMDLINE[@]} --bash-completion-word $arg) + done + + COMPREPLY=( $(cabal-edit "${CMDLINE[@]}") ) +} + +complete -o filenames -F _cabal-edit cabal-edit +``` + +**zsh** + +```bash +#compdef cabal-edit + +local request +local completions +local word +local index=$((CURRENT - 1)) + +request=(--bash-completion-enriched --bash-completion-index $index) +for arg in ${words[@]}; do + request=(${request[@]} --bash-completion-word $arg) +done + +IFS=$'\n' completions=($( cabal-edit "${request[@]}" )) + +for word in $completions; do + local -a parts + + # Split the line at a tab if there is one. + IFS=$'\t' parts=($( echo $word )) + + if [[ -n $parts[2] ]]; then + if [[ $word[1] == "-" ]]; then + local desc=("$parts[1] ($parts[2])") + compadd -d desc -- $parts[1] + else + local desc=($(print -f "%-019s -- %s" $parts[1] $parts[2])) + compadd -l -d desc -- $parts[1] + fi + else + compadd -f -- $word + fi +done +``` + +**fish** + +```bash + function _cabal-edit + set -l cl (commandline --tokenize --current-process) + # Hack around fish issue #3934 + set -l cn (commandline --tokenize --cut-at-cursor --current-process) + set -l cn (count $cn) + set -l tmpline --bash-completion-enriched --bash-completion-index $cn + for arg in $cl + set tmpline $tmpline --bash-completion-word $arg + end + for opt in (cabal-edit $tmpline) + if test -d $opt + echo -E "$opt/" + else + echo -E "$opt" + end + end +end + +complete --no-files --command cabal-edit --arguments '(_cabal-edit)' +``` + +Limitations +----------- + +Since this library works directly with the `PackageDescription` data structure +it cannot handle Cabal files in their full generality. Instead we directly +manipulate the internal structure used to represent the Cabal file which is not +capable of representing all surface constructs. If your Cabal file currently +uses: + +* Common stanzas +* Conditional blocks +* Preprocessor definitions + +These constructs will be compiled into the `PackageDescription` and inlined if +you use `cabal-edit`. This makes `cabal-edit` useful for small beginning +projects and ones that don't use advanced Cabal features. + +License +------- + +MIT License +Copyright (c) 2020, Stephen Diehl 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-edit.cabal b/cabal-edit.cabal new file mode 100644 --- /dev/null +++ b/cabal-edit.cabal @@ -0,0 +1,41 @@ +cabal-version: 3.0 +name: cabal-edit +version: 0.1.0.0 +license: MIT +license-file: LICENSE +copyright: 2020 Stephen Diehl +maintainer: stephen.m.diehl@gmail.com +author: sdiehl +bug-reports: https:/www.github.com/sdiehl/cabal-add/issues +synopsis: Cabal utility +description: + A utility for managing Hackage dependencies from the command line. + +category: Development +build-type: Simple +extra-source-files: + CHANGELOG.md + README.md + +source-repository head + type: git + location: git@github.com:sdiehl/cabal-edit.git + +executable cabal-edit + main-is: Main.hs + hs-source-dirs: exe + default-language: Haskell2010 + ghc-options: -Wall + build-depends: + , base >=4.12 && <5.0 + , bytestring ^>=0.10 + , Cabal >=3.0 && <4.0 + , containers ^>=0.6 + , directory ^>=1.3 + , filepath ^>=1.4 + , Glob ^>=0.10 + , hackage-db ^>=2.1 + , optparse-applicative ^>=0.15 + , process ^>=1.6 + , store ^>=0.7 + , time >=1.8 && <1.11 diff --git a/exe/Main.hs b/exe/Main.hs new file mode 100644 --- /dev/null +++ b/exe/Main.hs @@ -0,0 +1,552 @@ +{-# LANGUAGE RecordWildCards #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Main + ( main, + ) +where + +import Control.Monad +import qualified Data.ByteString as BS +import Data.List +import Data.Map as Map +import Data.Maybe +import Data.Set as Set +import Data.Store +import Data.Time.Clock +import qualified Distribution.Hackage.DB.Parsed as P +import Distribution.Hackage.DB.Path +import qualified Distribution.Hackage.DB.Unparsed as U +import Distribution.PackageDescription.Parsec +import Distribution.PackageDescription.PrettyPrint +import Distribution.Parsec +import Distribution.Pretty +import Distribution.Types.BuildInfo +import Distribution.Types.CondTree +import Distribution.Types.Dependency +import Distribution.Types.GenericPackageDescription +import Distribution.Types.Library +import Distribution.Types.LibraryName +import Distribution.Types.PackageDescription +import Distribution.Types.PackageName +import Distribution.Types.Version +import Distribution.Types.VersionRange.Internal +import Distribution.Utils.ShortText +import Distribution.Verbosity +import Options.Applicative +import System.Directory +import System.Exit +import System.FilePath.Glob +import System.FilePath.Posix +import System.Process + +------------------------------------------------------------------------------- +-- Library Manipulation +------------------------------------------------------------------------------- + +buildInfo :: GenericPackageDescription -> Maybe BuildInfo +buildInfo GenericPackageDescription {..} = fmap go condLibrary + where + go (CondNode Library {..} _ _) = libBuildInfo + +setBuildInfo :: + BuildInfo -> + GenericPackageDescription -> + GenericPackageDescription +setBuildInfo binfo pkg@GenericPackageDescription {..} = pkg {condLibrary = fmap go condLibrary} + where + go (CondNode var deps libs) = CondNode (var {libBuildInfo = binfo}) deps libs + +addLibDep :: + Dependency -> + BuildInfo -> + BuildInfo +addLibDep dep binfo@BuildInfo {..} = binfo {targetBuildDepends = targetBuildDepends <> [dep]} + +setLibDeps :: + [Dependency] -> + BuildInfo -> + BuildInfo +setLibDeps deps binfo@BuildInfo {} = binfo {targetBuildDepends = deps} + +hasLib :: GenericPackageDescription -> IO () +hasLib pkg = + if hasLibs (packageDescription pkg) + then pure () + else die "Package has no public library. Cannot modify dependencies." + +------------------------------------------------------------------------------- +-- Dependency Manipulation +------------------------------------------------------------------------------- + +getDeps :: + GenericPackageDescription -> + [Dependency] +getDeps pkg = concat (maybeToList depends) + where + depends = fmap targetBuildDepends (buildInfo pkg) + +setDeps :: + [Dependency] -> + GenericPackageDescription -> + GenericPackageDescription +setDeps deps pkg@GenericPackageDescription {..} = pkg {condLibrary = fmap go condLibrary} + where + go (CondNode var@Library {..} libdeps libs) = + CondNode (var {libBuildInfo = setLibDeps deps libBuildInfo}) libdeps libs + +modifyDeps :: + (PackageName -> Dependency -> Dependency) -> + GenericPackageDescription -> + GenericPackageDescription +modifyDeps f pkg = setDeps [f (depPkgName dep) dep | dep <- getDeps pkg] pkg + +------------------------------------------------------------------------------- +-- DepMap +------------------------------------------------------------------------------- + +udpateDep :: + GenericPackageDescription -> + (PackageName -> Dependency -> Maybe Dependency) -> + PackageName -> + Map PackageName Dependency +udpateDep pkg f pk = Map.updateWithKey f pk (depMap pkg) + +lookupDep :: GenericPackageDescription -> PackageName -> Maybe Dependency +lookupDep pkg pk = Map.lookup pk (depMap pkg) + +modifyDep :: GenericPackageDescription -> PackageName -> Dependency -> GenericPackageDescription +modifyDep pkg pk dep = setDepMap (Map.insert pk dep (depMap pkg)) pkg + +deleteDep :: GenericPackageDescription -> PackageName -> GenericPackageDescription +deleteDep pkg pk = setDepMap (Map.delete pk (depMap pkg)) pkg + +setDepMap :: Map.Map PackageName Dependency -> GenericPackageDescription -> GenericPackageDescription +setDepMap pkm = setDeps (fmap snd (Map.toList pkm)) + +depMap :: GenericPackageDescription -> Map.Map PackageName Dependency +depMap pkg = Map.fromList [(depPkgName dep, dep) | dep <- getDeps pkg] + +------------------------------------------------------------------------------- +-- Dependency Addition +------------------------------------------------------------------------------- + +majorBound :: Version -> Version +majorBound = alterVersion $ \numbers -> case numbers of + [] -> [0, 1] + [m1] -> [m1] + (m1 : m2 : _) -> [m1, m2] + +add :: + Dependency -> + (FilePath, GenericPackageDescription) -> + IO GenericPackageDescription +add dep (fname, cabalFile) = + case depVerRange dep of + AnyVersion -> do + let pk = depPkgName dep + verMap <- cacheDeps + -- Lookup the latest version and use the majorBound of it. + ver <- case Map.lookup pk verMap of + Nothing -> die $ "No such package named: " ++ show pk + Just vers -> pure (maximum vers) + let dependency = Dependency pk (majorBoundVersion (majorBound ver)) (Set.singleton defaultLibName) + putStrLn $ "Adding latest dependency: " ++ prettyShow dependency ++ " to " ++ takeFileName fname + pure $ modifyDep cabalFile pk dependency + ThisVersion givenVersion -> addVer ThisVersion givenVersion (fname, cabalFile) dep + LaterVersion givenVersion -> addVer LaterVersion givenVersion (fname, cabalFile) dep + OrLaterVersion givenVersion -> addVer OrLaterVersion givenVersion (fname, cabalFile) dep + EarlierVersion givenVersion -> addVer EarlierVersion givenVersion (fname, cabalFile) dep + WildcardVersion givenVersion -> addVer WildcardVersion givenVersion (fname, cabalFile) dep + givenVersion -> die $ "Given version is not on available on Hackage." ++ show givenVersion + +upgrade :: + PackageName -> + Version -> + (FilePath, GenericPackageDescription) -> + IO GenericPackageDescription +upgrade pk latest (_, cabalFile) = + case lookupDep cabalFile pk of + Nothing -> do + putStrLn $ "No current dependency on: " ++ prettyShow pk + die $ "Perhaps you want to run: cabal-edit add " ++ prettyShow pk + Just dep -> do + case depVerRange dep of + LaterVersion prev -> + if prev < latest + then do + let ver' = intersectVersionRanges (orLaterVersion prev) (orEarlierVersion latest) + let dep' = Dependency (depPkgName dep) ver' (depLibraries dep) + pure $ modifyDep cabalFile pk dep' + else do + putStrLn "Previous version is inconsistent, replacing lower bound." + replaceVersion dep + OrLaterVersion prev -> do + let ver' = intersectVersionRanges (orLaterVersion prev) (orEarlierVersion latest) + let dep' = Dependency (depPkgName dep) ver' (depLibraries dep) + pure $ modifyDep cabalFile pk dep' + AnyVersion -> replaceVersion dep + WildcardVersion _ -> replaceVersion dep + ThisVersion _ -> replaceVersion dep + OrEarlierVersion _ -> replaceVersion dep + EarlierVersion _ -> replaceVersion dep + VersionRangeParens _ -> replaceVersion dep + IntersectVersionRanges lower _ -> do + if extractLower lower < latest + then do + let ver' = intersectVersionRanges lower (orEarlierVersion latest) + let dep' = Dependency (depPkgName dep) ver' (depLibraries dep) + pure $ modifyDep cabalFile pk dep' + else replaceVersion dep + UnionVersionRanges _ _ -> replaceVersion dep + MajorBoundVersion prev -> do + if prev < latest + then do + let ver' = intersectVersionRanges (orLaterVersion prev) (orEarlierVersion latest) + let dep' = Dependency (depPkgName dep) ver' (depLibraries dep) + pure $ modifyDep cabalFile pk dep' + else replaceVersion dep + where + extractLower :: VersionRange -> Version + extractLower (LaterVersion ver) = ver + extractLower (OrLaterVersion ver) = ver + extractLower _ = version0 + replaceVersion dep = do + let dep' = Dependency (depPkgName dep) (majorBoundVersion latest) (depLibraries dep) + pure $ modifyDep cabalFile pk dep' + +remove :: + PackageName -> + (FilePath, GenericPackageDescription) -> + IO GenericPackageDescription +remove pk (_, cabalFile) = + case lookupDep cabalFile pk of + Nothing -> die $ "No dependency on: " ++ show pk + Just _ -> pure $ deleteDep cabalFile pk + +addVer :: + (Version -> VersionRange) -> + Version -> + (FilePath, GenericPackageDescription) -> + Dependency -> + IO GenericPackageDescription +addVer f givenVersion (fname, cabalFile) dep = do + let pk = depPkgName dep + verMap <- cacheDeps + let dependency = Dependency pk (f givenVersion) (Set.singleton defaultLibName) + case Map.lookup pk verMap of + Nothing -> die $ "No such named: " ++ show pk + Just vers -> + if givenVersion `elem` vers + then do + putStrLn $ "Adding explicit dependency: " ++ prettyShow dependency ++ " to " ++ takeFileName fname + let dep' = Dependency (depPkgName dep) (majorBoundVersion givenVersion) (depLibraries dep) + pure $ modifyDep cabalFile pk dep' + else die $ "Given version is not on available on Hackage." ++ show givenVersion + +------------------------------------------------------------------------------- +-- Version Cache +------------------------------------------------------------------------------- + +cacheFile :: FilePath +cacheFile = ".cabal-cache.db" + +cacheDeps :: IO (Map PackageName [Version]) +cacheDeps = do + cache <- cacheDb + cacheExists <- doesFileExist cache + if cacheExists + then do + dbContents <- BS.readFile cache + case decode dbContents of + Left _ -> die "Corrupted cabal cache file. Run 'cabal-edit rebuild'." + Right db -> pure db + else do + putStrLn "No cache file found, building from HackageDB." + buildCache + +buildCache :: IO (Map PackageName [Version]) +buildCache = do + cache <- cacheDb + hdb <- hackageTarball + now <- getCurrentTime + tdb <- U.readTarball (Just now) hdb + vers <- forM (Map.toList tdb) $ \(pk, pdata) -> do + let verMap = Map.keys (P.parsePackageData pk pdata) + pure (pk, verMap) + let db = Map.fromList vers + BS.writeFile cache (encode db) + pure db + +cacheDb :: IO FilePath +cacheDb = do + home <- getHomeDirectory + cabalExists <- doesDirectoryExist (home ".cabal") + if cabalExists + then pure (home ".cabal" cacheFile) + else die "No ~/.cabal directory found. Is cabal installed?" + +------------------------------------------------------------------------------- +-- Version Linting +------------------------------------------------------------------------------- + +lint :: Bool -> (PackageName, Dependency, Version) -> IO () +lint fix (pk, dep, latest) = + case depVerRange dep of + AnyVersion -> putStrLn $ prettyShow pk ++ " : " ++ "Wildcard version detected. Instead use explicit version bounds." + ThisVersion _ -> putStrLn $ prettyShow pk ++ " : " ++ "Explicit version detected. Considering allowing a range." + LaterVersion _ -> putStrLn $ prettyShow pk ++ " : " ++ "No upper bound detected. Add an upper bound." + OrLaterVersion _ -> putStrLn $ prettyShow pk ++ " : " ++ "No upper bound detected. Add an upper bound." + EarlierVersion ver -> + case versionNumbers ver of + (1 : _) -> pure () + _ -> putStrLn $ prettyShow pk ++ " : " ++ "Upper bound only for package with >1.0 admits all previous versions. Add a lower bound to major version." + OrEarlierVersion ver -> + case versionNumbers ver of + (1 : _) -> pure () + _ -> putStrLn $ prettyShow pk ++ " : " ++ "Upper bound only for package with >1.0 admits all previous versions. Add a lower bound to major version." + WildcardVersion ver -> + if Data.List.length (versionNumbers ver) > 2 + then putStrLn $ prettyShow pk ++ " : " ++ "Wildcard on minor version, consider rewriting wildcard to major version n.x" + else pure () + MajorBoundVersion ver -> + if majorUpperBound ver == majorUpperBound latest + then pure () + else putStrLn $ prettyShow pk ++ " : " ++ "Consider ugprading major bound to latest version " ++ prettyShow (majorBound latest) + UnionVersionRanges _ _ -> pure () + IntersectVersionRanges lower upper -> + case (lower, upper) of + (LaterVersion lower, EarlierVersion upper) -> lintRange pk lower upper latest + (OrLaterVersion lower, EarlierVersion upper) -> lintRange pk lower upper latest + (LaterVersion lower, OrEarlierVersion upper) -> lintRange pk lower upper latest + (OrLaterVersion lower, OrEarlierVersion upper) -> lintRange pk lower upper latest + _ -> putStrLn $ prettyShow pk ++ " : " ++ "Upper and lower bounds for range are inconsistent." + VersionRangeParens _ -> pure () + +lintRange :: PackageName -> Version -> Version -> Version -> IO () +lintRange pk lower upper latest + | lower >= upper = putStrLn $ prettyShow pk ++ " : " ++ "Lower bound is greater or equal to than upper bound. Reverse bounds." + | upper < latest = putStrLn $ prettyShow pk ++ " : " ++ "Consider upgrading upper bound to latest version " ++ prettyShow latest + | otherwise = pure () + +------------------------------------------------------------------------------- +-- Commands +------------------------------------------------------------------------------- + +listCmd :: String -> IO () +listCmd packName = do + pk <- case (simpleParsec packName :: Maybe PackageName) of + Nothing -> die "Invalid package name." + Just pk -> pure pk + verMap <- cacheDeps + vers <- case Map.lookup pk verMap of + Nothing -> die $ "No such named: " ++ show pk + Just vers -> pure (sort vers) + mapM_ (putStrLn . prettyShow) vers + +latestCmd :: String -> IO () +latestCmd packName = do + pk <- case (simpleParsec packName :: Maybe PackageName) of + Nothing -> die "Invalid package name." + Just pk -> pure pk + verMap <- cacheDeps + latest <- case Map.lookup pk verMap of + Nothing -> die $ "No such named: " ++ show pk + Just vers -> pure (maximum vers) + let dependency = Dependency pk (majorBoundVersion (majorBound latest)) (Set.singleton defaultLibName) + putStrLn (prettyShow dependency) + +addCmd :: [String] -> IO () +addCmd = mapM_ addSingle + +addSingle :: String -> IO () +addSingle packName = do + dep <- case (simpleParsec packName :: Maybe Dependency) of + Nothing -> die "Invalid dependency version number." + Just dep -> pure dep + (fname, cabalFile) <- getCabal + cabalFile' <- add dep (fname, cabalFile) + --hasLib cabalFile + writeGenericPackageDescription fname cabalFile' + formatCabalFile fname + +upgradeCmd :: String -> IO () +upgradeCmd packName = do + pk <- case (simpleParsec packName :: Maybe PackageName) of + Nothing -> die "Invalid package name." + Just pk -> pure pk + verMap <- cacheDeps + latestVer <- case Map.lookup pk verMap of + Nothing -> die $ "No such named: " ++ show pk + Just vers -> pure (maximum vers) + (fname, cabalFile) <- getCabal + --hasLib cabalFile + case lookupDep cabalFile pk of + Nothing -> die $ "No current dependency on: " ++ show pk + Just _ -> do + let ver' = majorUpperBound latestVer + putStrLn $ "Upgrading bounds for " ++ prettyShow pk ++ " to " ++ prettyShow ver' + --traverse (putStrLn . prettyShow) (depMap cabalFile) + cabalFile' <- upgrade pk ver' (fname, cabalFile) + writeGenericPackageDescription fname cabalFile' + formatCabalFile fname + +upgradeAllCmd :: IO () +upgradeAllCmd = do + verMap <- cacheDeps + (fname, cabalFile) <- getCabal + let pks = fmap depPkgName (getDeps cabalFile) + forM_ pks $ \pk -> do + latestVer <- case Map.lookup pk verMap of + Nothing -> die $ "No such named: " ++ show pk + Just vers -> pure (maximum vers) + let ver' = majorUpperBound latestVer + putStrLn $ "Upgrading bounds for " ++ prettyShow pk ++ " to " ++ prettyShow ver' + cabalFile <- readGenericPackageDescription normal fname + cabalFile' <- upgrade pk ver' (fname, cabalFile) + writeGenericPackageDescription fname cabalFile' + formatCabalFile fname + +lintCmd :: IO () +lintCmd = do + verMap <- cacheDeps + (fname, cabalFile) <- getCabal + let pks = Map.toList $ depMap cabalFile + forM_ pks $ \(pk, dep) -> do + latestVer <- case Map.lookup pk verMap of + Nothing -> die $ "No such named: " ++ show pk + Just vers -> pure (maximum vers) + lint False (pk, dep, latestVer) + +removeCmd :: String -> IO () +removeCmd packName = do + pk <- case (simpleParsec packName :: Maybe PackageName) of + Nothing -> die "Invalid package name." + Just pk -> pure pk + (fname, cabalFile) <- getCabal + case lookupDep cabalFile pk of + Nothing -> die $ "No current dependency on: " ++ show pk + Just _ -> do + putStrLn $ "Removing dependency on " ++ prettyShow pk + cabalFile' <- remove pk (fname, cabalFile) + writeGenericPackageDescription fname cabalFile' + formatCabalFile fname + +rebuildCmd :: IO () +rebuildCmd = buildCache >> putStrLn "Done." + +extensionsCmd :: IO () +extensionsCmd = do + (fname, cabalFile) <- getCabal + let extensions = fmap defaultExtensions (buildInfo cabalFile) + case extensions of + Nothing -> putStrLn $ "No default extensions in " ++ takeFileName fname + Just exts -> mapM_ (putStrLn . showExt) exts + where + showExt ext = "{-# LANGUAGE " ++ prettyShow ext ++ " #-}" + +formatCmd :: IO () +formatCmd = do + (fname, cabalFile) <- getCabal + putStrLn $ "Formatting: " ++ takeFileName fname + writeGenericPackageDescription fname cabalFile + formatCabalFile fname + +getCabal :: IO (FilePath, GenericPackageDescription) +getCabal = do + cabalFiles <- glob "*.cabal" + case cabalFiles of + [] -> die "No cabal file found in current directory." + [fname] -> do + pkg <- readGenericPackageDescription normal fname + pure (fname, pkg) + _ -> die "Multiple cabal-files found." + +formatCabalFile :: FilePath -> IO () +formatCabalFile fpath = do + mexe <- findExecutable "cabal-fmt" + case mexe of + Just _ -> callCommand $ "cabal-fmt --inplace " ++ fpath + Nothing -> pure () + +------------------------------------------------------------------------------- +-- Orphan Sinbin +------------------------------------------------------------------------------- + +instance Store PackageName + +instance Store ShortText + +instance Store Version + +------------------------------------------------------------------------------- +-- Options Parsing +------------------------------------------------------------------------------- + +data Cmd + = Add [String] + | List String + | Upgrade String + | UpgradeAll + | Remove String + | Latest String + | Format + | Rebuild + | Extensions + | Lint + deriving (Eq, Show) + +completerPacks :: IO [String] +completerPacks = do + db <- cacheDeps + pure (unPackageName <$> Map.keys db) + +addParse :: [String] -> Parser Cmd +addParse localPackages = Add <$> many (argument str (metavar "PACKAGE" <> completeWith localPackages)) + +listParse :: [String] -> Parser Cmd +listParse localPackages = List <$> argument str (metavar "PACKAGE" <> completeWith localPackages) + +upgradeParse :: [String] -> Parser Cmd +upgradeParse localPackages = Upgrade <$> argument str (metavar "PACKAGE" <> completeWith localPackages) + +removeParse :: [String] -> Parser Cmd +removeParse localPackages = Remove <$> argument str (metavar "PACKAGE" <> completeWith localPackages) + +latestParse :: [String] -> Parser Cmd +latestParse localPackages = Latest <$> argument str (metavar "PACKAGE" <> completeWith localPackages) + +opts :: [String] -> Parser Cmd +opts localPackages = + subparser $ + mconcat + [ command "add" (info (addParse localPackages) (progDesc "Add dependency to cabal file.")), + command "list" (info (listParse localPackages) (progDesc "List available versions from Hackage.")), + command "upgrade" (info (upgradeParse localPackages) (progDesc "Upgrade bounds for given package.")), + command "remove" (info (removeParse localPackages) (progDesc "Remove a given package.")), + command "latest" (info (latestParse localPackages) (progDesc "Get the latest version of a given package.")), + command "rebuild" (info (pure Rebuild) (progDesc "Rebuild cache.")), + command "upgradeall" (info (pure UpgradeAll) (progDesc "Upgrade all dependencies.")), + command "format" (info (pure Format) (progDesc "Format cabal file.")), + command "extensions" (info (pure Extensions) (progDesc "List all default language extensions pragmas.")), + command "lint" (info (pure Lint) (progDesc "Lint dependency bounds.")) + ] + +main :: IO () +main = do + comps <- completerPacks + let options = info (opts comps <**> helper) idm + cmd <- customExecParser p options + case cmd of + Add deps -> addCmd deps + List dep -> listCmd dep + Upgrade dep -> upgradeCmd dep + Remove dep -> removeCmd dep + Format -> formatCmd + Rebuild -> rebuildCmd + Latest dep -> latestCmd dep + Extensions -> extensionsCmd + UpgradeAll -> upgradeAllCmd + Lint -> lintCmd + where + p = prefs showHelpOnEmpty