diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -1,60 +1,76 @@ name: Haskell CI - on: push: - branches: [ master ] + branches: [main, master] pull_request: - branches: [ master ] + branches: [main, master] +permissions: + contents: read + jobs: build: - - runs-on: ubuntu-latest + name: GHC ${{ matrix.ghc-version }} on ${{ matrix.os }} + runs-on: ${{ matrix.os }} strategy: + fail-fast: false matrix: - cabal: - [ "3.4" - , "3.6" - , "3.8" - ] - ghc: + os: [ubuntu-latest] + ghc-version: [ "8.8" , "8.10" , "9.0" , "9.2" + , "9.4" ] - exclude: - - cabal: "3.4" - ghc: "9.2" + steps: - - uses: actions/checkout@v3 - with: - submodules: 'recursive' - - uses: haskell/actions/setup@v2 - with: - ghc-version: ${{ matrix.ghc }} - cabal-version: ${{ matrix.cabal }} + - uses: actions/checkout@v3 + with: + submodules: 'recursive' - - name: Cache - uses: actions/cache@v3 - env: - cache-name: cache-cabal - with: - path: ~/.cabal - key: ${{ runner.os }}-build-${{ env.cache-name }}-${{ hashFiles('**/*.cabal') }}-${{ hashFiles('**/cabal.project') }} - restore-keys: | - ${{ runner.os }}-build-${{ env.cache-name }}- - ${{ runner.os }}-build- - ${{ runner.os }}- + - name: Set up GHC ${{ matrix.ghc-version }} + uses: haskell/actions/setup@v2 + id: setup + with: + ghc-version: ${{ matrix.ghc-version }} + # Defaults, added for clarity: + cabal-version: 'latest' + cabal-update: true - - name: Configure - run: | - cabal update - cabal configure --enable-tests --enable-benchmarks --flag=pedantic - - name: Install dependencies - run: | - cabal build --only-dependencies - - name: Build - run: cabal build - - name: Run spec test - run: cabal test --test-option=--color --test-show-details=streaming spec + - name: Check cabal file + run: cabal check + + - name: Configure the build + run: | + cabal configure --enable-tests --enable-benchmarks --disable-documentation --flag=pedantic + cabal build --dry-run + # The last step generates dist-newstyle/cache/plan.json for the cache key. + + - name: Restore cached dependencies + uses: actions/cache/restore@v3 + id: cache + env: + key: ${{ runner.os }}-ghc-${{ steps.setup.outputs.ghc-version }}-cabal-${{ steps.setup.outputs.cabal-version }} + with: + path: ${{ steps.setup.outputs.cabal-store }} + key: ${{ env.key }}-plan-${{ hashFiles('**/plan.json') }} + restore-keys: ${{ env.key }}- + + - name: Install dependencies + run: cabal build all --only-dependencies + + # Cache dependencies already here, so that we do not have to rebuild them should the subsequent steps fail. + - name: Save cached dependencies + uses: actions/cache/save@v3 + # Caches are immutable, trying to save with the same key would error. + if: ${{ steps.cache.outputs.cache-primary-key != steps.cache.outputs.cache-matched-key }} + with: + path: ${{ steps.setup.outputs.cabal-store }} + key: ${{ steps.cache.outputs.cache-primary-key }} + + - name: Build + run: cabal build all + + - name: Run tests + run: cabal test all --test-option=--color --test-show-details=streaming --jobs=1 diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,32 @@ +## v0.8.4.0 (2023-06-03) + +Release v0.8.4.0 + +- Do not add `[profile]` to dev-lang/ghc + + The needed changes have been addressed in haskell-cabal.eclass and + should not be handled by hackport + +- KEYWORDs are now automatically passed forward between version bumps + + This functionality was removed in the last version and has been added + back. Any "stable" keywords should automatically become "testing" + when passed forward. + +- Add shell completion functionality + + Use optparse-applicative's functionality to generate bash, zsh, and + fish completion scripts. Because autocompletion for `hackport merge` + requires searching the list of package/version strings from Hackage, + this data is stored in a trie which is cached in + ~/.hackport/packages.cache (which is removed when `hackport update` + is run). + +- Fix doctests + + Doctests should now work with cabal-v1 (Setup.hs), cabal-v2, and + GitHub CI setups. + ## v0.8.3.0 (2023-05-06) Release v0.8.3.0 diff --git a/exe/Main.hs b/exe/Main.hs --- a/exe/Main.hs +++ b/exe/Main.hs @@ -6,10 +6,11 @@ import Control.Applicative.Combinators import qualified Control.Applicative.Combinators.NonEmpty as CNE import Control.Monad -import Data.Bitraversable +import qualified Data.List as L import Data.Monoid (Endo(..)) import qualified Options.Applicative as Opt import qualified Options.Applicative.Help as Opt +import qualified Prettyprinter as PP import qualified Text.Parsec as P import qualified Text.Parsec.String as P import qualified Distribution.Verbosity as V @@ -22,6 +23,7 @@ import Hackport.Command.Update import Hackport.Command.Status import Hackport.Command.Merge +import Hackport.Completion import Data.Version (showVersion) import Distribution.Pretty (prettyShow) @@ -143,7 +145,7 @@ $ Opt.long "verbosity" <> helpMulti [ "Set verbosity level " - , "(0-3 or (silent,normal,verbose,deafening))" + , "(0-3) or (" ++ L.intercalate "," (show . fst <$> verbs) ++ ")" ] where readm :: Opt.ReadM V.Verbosity @@ -152,21 +154,18 @@ . P.runParser verbosityString () "command line option" err :: P.ParseError -> String - err _ = ($ "") $ Opt.displayS $ Opt.renderCompact $ Opt.extractChunk $ Opt.vsepChunks - [ Opt.stringChunk "Takes a number (0-3) or one of the following values:" - , Opt.tabulate -#if MIN_VERSION_optparse_applicative(0,17,0) - (Opt.prefColumns Opt.defaultPrefs) -#endif - =<< traverse (bitraverse Opt.stringChunk Opt.stringChunk) - [ ("silent", "No output") - , ("normal", "Default verbosity") - , ("verbose", "Increased verbosity") - , ("deafening", "Maximum verbosity") - ] - ] - + err _ = show $ PP.vsep $ + PP.pretty "Takes a number (0-3) or one of the following values:" : + ((\(k,v) -> PP.hsep [PP.pretty (show k), PP.pretty "=", PP.pretty v]) + <$> verbs + ) + verbs = + [ ("silent", "No output") + , ("normal", "Default verbosity") + , ("verbose", "Increased verbosity") + , ("deafening", "Maximum verbosity") + ] ----------------------------------------------------------------------- -- List @@ -192,8 +191,12 @@ where parser :: Opt.Parser MakeEbuildEnv parser = do - cat <- Opt.strArgument $ Opt.metavar "" - cabalFiles <- CNE.some $ Opt.strArgument $ Opt.metavar "[EBUILD FILE]" + cat <- Opt.strArgument + $ Opt.metavar "" + <> Opt.completer categoryCompleter + cabalFiles <- CNE.some $ Opt.strArgument + $ Opt.metavar "[EBUILD FILE]" + <> Opt.completer (Opt.bashCompleter "file") flags <- optional cabalFlagsParser notOnHackage <- Opt.switch $ Opt.long "not-on-hackage" @@ -259,7 +262,9 @@ parser :: Opt.Parser MergeEnv parser = do flags <- optional $ cabalFlagsParser - pkg <- Opt.strArgument $ Opt.metavar "PACKAGE" + pkg <- Opt.strArgument + $ Opt.metavar "PACKAGE" + <> Opt.completer cabalPackageCompleter pure $ MergeEnv flags pkg @@ -285,3 +290,4 @@ [ "Set cabal flags to certain state. Example:" , "--flags=-all_extensions" ] + diff --git a/hackport.cabal b/hackport.cabal --- a/hackport.cabal +++ b/hackport.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: hackport -version: 0.8.3.0 +version: 0.8.4.0 license: GPL-3.0-or-later license-file: LICENSE author: Henning Günther, Duncan Coutts, Lennart Kolmodin @@ -17,7 +17,8 @@ , GHC == 8.8.4 , GHC == 8.10.7 , GHC == 9.0.2 - , GHC == 9.2.4 + , GHC == 9.2.7 + , GHC == 9.4.5 source-repository head type: git @@ -782,16 +783,20 @@ , hackport-external-libs-cabal-install , base , async + , binary , bytestring , containers , deepseq , directory + , dlist , extensible-exceptions , filepath + , ghc-compact , lifted-base , monad-control , mtl , network-uri + , optparse-applicative , parallel >=3.2.1.0 , parsec , pretty @@ -801,6 +806,7 @@ , template-haskell , text , time + , transformers , xml -- Needed for doctests-v2 to work @@ -818,12 +824,14 @@ exposed-modules: AnsiColor Cabal2Ebuild + Data.Trie Error Hackport.Command.List Hackport.Command.MakeEbuild Hackport.Command.Merge Hackport.Command.Status Hackport.Command.Update + Hackport.Completion Hackport.Env Hackport.Util Merge @@ -861,7 +869,7 @@ import: warnings ghc-options: -threaded +RTS -N -RTS -with-rtsopts=-N if flag(profile) - ghc-prof-options: -caf-all -auto-all -rtsopts + ghc-prof-options: -fprof-cafs -fprof-auto -rtsopts main-is: Main.hs default-language: Haskell2010 hs-source-dirs: exe @@ -876,7 +884,8 @@ , optparse-applicative , parsec , parser-combinators - + , prettyprinter + , process other-modules: Paths_hackport other-extensions: ApplicativeDo @@ -1017,9 +1026,6 @@ test-suite doctests-v2 import: warnings - -- doctests-v2 is causing problems, looking for ghc lib and alex on - -- github CI. This may be fixable. - buildable: False type: exitcode-stdio-1.0 default-language: Haskell98 hs-source-dirs: tests/doctests-v2 @@ -1029,7 +1035,7 @@ , process build-tool-depends: - , cabal-install:cabal >=3.4 + -- cabal-install should already be installed if this is being built... , doctest:doctest >=0.8 if flag(cabal-v1) diff --git a/src/Data/Trie.hs b/src/Data/Trie.hs new file mode 100644 --- /dev/null +++ b/src/Data/Trie.hs @@ -0,0 +1,83 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE Strict #-} + +module Data.Trie + ( Trie(..) + , singleton + , lookup + , toList + , buildCompact + ) where + +import Control.Applicative +import Control.Monad +import Control.Monad.IO.Class +import Data.Binary +import qualified Data.DList as DList +import Data.DList (DList) +import qualified Data.Foldable as F +import qualified Data.Map.Strict as Map +import Data.Map.Strict (Map) +import GHC.Compact +import GHC.Generics + +import Prelude hiding (lookup) + +-- | A tree with branches keyed by a 'Map', which is useful for storing +-- and searching list prefixes in a compact way. Each node is marked +-- with a type signifying list enedings. +-- +-- Example: @"he"@ and @"hi"@ stored in a @'Trie' 'Char' '()'@ would look like: +-- +-- @Nothing :< toList [('h', Nothing :< toList [('e', Just () :< toList []),('i', Just () :< toList [])])]@ +data Trie k a = Maybe a :< Map k (Trie k a) + deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic) + +instance Ord k => Semigroup (Trie k a) where + ma1 :< f1 <> ma2 :< f2 = (ma2 <|> ma1) :< Map.unionWith (<>) f1 f2 + +instance Ord k => Monoid (Trie k a) where + mempty = Nothing :< Map.empty + +instance (Binary k, Binary a) => Binary (Trie k a) + +-- | Walk the 'Trie' using the given key list looking for a matching node. +lookup :: Ord k => Trie k a -> [k] -> Maybe (Trie k a) +lookup (_ :< mapK) (k:ks) = + Map.lookup k mapK >>= (\c -> lookup c ks) +lookup t [] = Just t + +-- | Return the path and value of every node marked with 'Just' +toList :: Trie k a -> [([k],a)] +toList = DList.toList . go DList.empty DList.empty + where + go :: DList ([k], a) -> DList k -> Trie k a -> DList ([k], a) + go justs path (b :< m) = + let justs' = case b of + Just x -> justs `DList.snoc` (DList.toList path, x) + Nothing -> justs + in justs' <> F.foldMap' + (\(x,t) -> go justs' (path `DList.snoc` x) t) + (Map.toAscList m) + +-- | Create a simple 'Trie' from a key list and a value. +singleton :: [k] -> a -> Trie k a +singleton l x = go l + where + go (k:ks) = Nothing :< Map.singleton k (go ks) + go [] = Just x :< Map.empty + +-- | Build a 'Trie' within a compact region +buildCompact :: (MonadIO m, Ord k) + => (a -> ([k], b)) + -> [a] + -> m (Compact (Trie k b)) +buildCompact _ [] = liftIO $ compact mempty +buildCompact f (x:xs) = do + ct <- buildCompact f xs + cs <- liftIO $ compactAdd ct (f x) + let (t,(s,b)) = (getCompact ct, getCompact cs) + cq <- liftIO $ compactAdd ct $ t <> singleton s b + pure cq + diff --git a/src/Hackport/Command/Update.hs b/src/Hackport/Command/Update.hs --- a/src/Hackport/Command/Update.hs +++ b/src/Hackport/Command/Update.hs @@ -2,6 +2,8 @@ ( updateAction ) where +import System.Directory (removeFile) + import qualified Distribution.Client.CmdUpdate as CabalInstall import Distribution.Client.Compat.Prelude (Verbosity) @@ -9,16 +11,18 @@ (NixStyleFlags(configFlags, projectFlags), defaultNixStyleFlags) import Distribution.Client.ProjectFlags (ProjectFlags(flagIgnoreProject)) import Distribution.Client.Setup (ConfigFlags(configVerbosity), GlobalFlags(globalRemoteRepos)) +import Distribution.Compat.Parsing (skipOptional) import Distribution.Simple.Flag (Flag(Flag)) import Distribution.Utils.NubList (toNubList) +import Hackport.Completion (trieFile) import Hackport.Util (withHackportContext) import Hackport.Env updateAction :: Env env () updateAction = askGlobalEnv >>= \(GlobalEnv verbosity _ _) -> withHackportContext $ \globalFlags _repoContext -> do - let nixFlags = ignoreProjectInNixFlags + let nixFlags = ignoreProjectInNixFlags $ addVerbosityToNixFlags verbosity (defaultNixStyleFlags ()) -- We need to unset the globalRemoteRepos set in 'withHackportContext' or @@ -26,8 +30,12 @@ -- TODO: The cabal-install code needs to be examined further to see if -- there is a better way to do this (starting with Distribution.Client.CmdUpdate) let globalFlags' = globalFlags { globalRemoteRepos = toNubList [] } + f <- trieFile - liftIO $ CabalInstall.updateAction nixFlags [] globalFlags' + liftIO $ do + -- Remove the file but ignore any errors + skipOptional $ removeFile f + CabalInstall.updateAction nixFlags [] globalFlags' -- | There is no verbosity argument for 'CabalInstall.updateAction'. It expects -- the verbosity to be passed in via 'NixStyleFlags'. diff --git a/src/Hackport/Completion.hs b/src/Hackport/Completion.hs new file mode 100644 --- /dev/null +++ b/src/Hackport/Completion.hs @@ -0,0 +1,150 @@ +{-# LANGUAGE TupleSections #-} + +module Hackport.Completion + ( categoryCompleter + , cabalPackageCompleter + , trieFile + ) where + +import Control.Applicative +import Control.Monad.Trans.Maybe +import Data.Binary +import qualified Data.List as L +import Data.Maybe (catMaybes) +import qualified Data.Set as Set +import Data.Set (Set) +import GHC.Compact +import qualified Options.Applicative as Opt +import System.Exit (ExitCode(..)) +import System.FilePath +import System.IO.Error (tryIOError) +import System.Process hiding (env) +import Text.PrettyPrint (render) + +import qualified Data.Trie as Trie +import Data.Trie (Trie) +import Hackport.Env +import Hackport.Util (withHackportContext, hackportDir) +import Util + +import Distribution.Client.GlobalFlags (RepoContext(..)) +import Distribution.Client.IndexUtils (getSourcePackages) +import Distribution.Client.Types (packageIndex) +import Distribution.Compat.Parsing (choice) +import Distribution.Pretty (Pretty, pretty) +import Distribution.Solver.Types.PackageIndex (allPackages) +import Distribution.Solver.Types.SourcePackage (SourcePackage(..)) +import qualified Distribution.Verbosity as V + +-- | Read the @profiles/category@ file from: +-- +-- * @gentoo@ (determined by portageq) +-- +-- The following might be read from in the future but it probably isn't +-- worth it for the extra time taken -- there most likely won't be any +-- extra categories that don't exist in @::gentoo@: +-- +-- * @haskell@ (determined by portageq) +-- * The repository reported by 'getOverlayPath' +-- +-- This is used exclusively for shell completion for the @make-ebuild@ +-- subcommand. +categoryCompleter :: Opt.Completer +categoryCompleter = Opt.mkCompleter $ \s -> do + let env = GlobalEnv V.silent Nothing Nothing + gentoo <- runEnv gentooOverlay () env + + let repos = catMaybes [gentoo] + + sets <- traverse repoCategories repos + pure $ Set.toAscList $ Set.filter (s `L.isPrefixOf`) $ Set.unions sets + + where + gentooOverlay :: Env () (Maybe FilePath) + gentooOverlay = getRepoPath "gentoo" + + getRepoPath :: String -> Env () (Maybe FilePath) + getRepoPath repo = + runOrDie + "/usr/bin/portageq" + ["get_repo_path", "/", repo] + $ \out -> case out of + [p] -> Just p + _ -> Nothing + + repoCategories :: FilePath -> IO (Set String) + repoCategories repoPath = do + let catsFile = repoPath "profiles" "categories" + foldMap (Set.fromList . filter (not . null) . lines) + -- Returns a Nothing (wrapped in IO) if `readFile` fails + <$> optional (readFile catsFile) + +-- | Read a list of package names/verisons on Hackage. This requires the user +-- to have run @hackport update@ at least once. +-- +-- Internally, this creates a 'Trie' which is cached in +-- @~/.hackport/packages.cache@. The cache is removed when @hackport update@ +-- is called, which causes the cache file to be regenerated. +-- +-- This is used exclusively for shell completion for the @merge@ +-- subcommand. +cabalPackageCompleter :: Opt.Completer +cabalPackageCompleter = Opt.mkCompleter $ \s -> + runEnv (go s) () $ GlobalEnv V.silent Nothing Nothing + where + go s = withHackportContext $ \_ repoContext -> do + Just trie <- runMaybeT $ choice + [ -- Check to see if there is an existing cache. + readTrie + -- Otherwise, create a new trie from the Hackage database + , lift $ createTrie repoContext + ] + + let endings = map fst $ maybe [] Trie.toList + $ Trie.lookup (getCompact trie) s + + pure $ map (s ++) endings + + -- A (Trie Char ()) is useful for storing/searching a list of strings + createTrie repoContext = do + pkgs <- allPV repoContext + trie <- Trie.buildCompact (,()) pkgs + writeTrie (getCompact trie) + pure trie + + readTrie :: MonadIO m + => MaybeT m (Compact (Trie Char ())) + readTrie = MaybeT $ liftIO $ optional + $ trieFile >>= decodeFile >>= compact + + writeTrie :: MonadIO m => Trie Char () -> m () + writeTrie t = do + f <- trieFile + liftIO $ encodeFile f t + + allPV :: MonadIO m => RepoContext -> m [String] + allPV repoContext = do + index <- liftIO $ packageIndex <$> getSourcePackages V.silent repoContext + let allP = allPackages index + pure $ (\(SourcePackage i _ _ _) -> showPretty i) <$> allP + +trieFile :: MonadIO m => m FilePath +trieFile = do + d <- hackportDir + pure $ d "packages" <.> "cache" + +runOrDie :: FilePath -> [String] -> ([String] -> Maybe a) -> Env env (Maybe a) +runOrDie p ss f = do + r <- liftIO + $ tryIOError + $ readProcessWithExitCode p ss "" + case r of + Left e -> die (show e) + Right (ec, out, err) -> do + case ec of + ExitSuccess -> + pure $ f $ filter (not . null) $ lines $ out + _ -> die $ unwords [out, err] + +showPretty :: Pretty a => a -> String +showPretty = render . pretty diff --git a/src/Hackport/Util.hs b/src/Hackport/Util.hs --- a/src/Hackport/Util.hs +++ b/src/Hackport/Util.hs @@ -2,12 +2,17 @@ ( getPortageDir , withHackportContext , defaultRemoteRepo + , hackportDir ) where import Control.Monad.Trans.Control import Data.Maybe (fromJust) import qualified Network.URI as NU -import System.Directory ( doesDirectoryExist ) +import System.Directory + ( doesDirectoryExist + , getHomeDirectory + , createDirectoryIfMissing + ) import System.FilePath ( () ) import Distribution.Simple.Utils (warn) @@ -54,3 +59,11 @@ where uri = fromJust $ NU.parseURI "https://hackage.haskell.org/" name = "hackage.haskell.org" + +-- | Return the path to @~/.hackport/@ and create it if it doesn't exist. +hackportDir :: MonadIO m => m FilePath +hackportDir = do + h <- liftIO $ getHomeDirectory + let d = h ".hackport" + liftIO $ createDirectoryIfMissing True d + pure d diff --git a/src/Merge.hs b/src/Merge.hs --- a/src/Merge.hs +++ b/src/Merge.hs @@ -548,16 +548,19 @@ liftIO $ createDirectoryIfMissing True edir now <- liftIO $ TC.getCurrentTime - let existing_license = EM.license existing_meta + let (existing_keywords, existing_license) = (EM.keywords existing_meta, EM.license existing_meta) + new_keywords = maybe (E.keywords ebuild) (map Merge.to_unstable) existing_keywords new_license = either (\err -> maybe (Left err) Right existing_license) Right (E.license ebuild) - ebuild' = ebuild { E.license = new_license + ebuild' = ebuild { E.keywords = new_keywords + , E.license = new_license } s_ebuild' = E.showEBuild now ebuild' + notice $ "Current keywords: " ++ show existing_keywords ++ " -> " ++ show new_keywords notice $ "Current license: " ++ show existing_license ++ " -> " ++ show new_license notice $ "Writing " ++ elocal diff --git a/src/Merge/Dependencies.hs b/src/Merge/Dependencies.hs --- a/src/Merge/Dependencies.hs +++ b/src/Merge/Dependencies.hs @@ -125,7 +125,7 @@ cabal_dep :: Portage.Dependency cabal_dep = cabalDependency overlay (packageDescription pkg) compiler_info ghc_dep :: Portage.Dependency - ghc_dep = add_profile $ compilerInfoToDependency compiler_info + ghc_dep = compilerInfoToDependency compiler_info extra_libs :: Portage.Dependency extra_libs = Portage.DependAllOf $ findCLibs (packageDescription pkg) pkg_config_libs :: [Portage.Dependency]