Don't skip the target if it's a missing dependency

.github/workflows/ci.yml

@@ -11,8 +11,8 @@ jobs:
     runs-on: ${{ matrix.os }}
     strategy:
       matrix:
-        cabal: ["3.2.0.0", "3.4.0.0", "3.6.0.0"]
-        ghc: ["8.10.7", "9.0.2", "9.2.2"]
+        cabal: ["3.2.0.0", "3.4.0.0", "3.6.0.0", "3.8.0.0"]
+        ghc: ["8.10.7", "9.0.2", "9.2.2", "9.4.6"]
         os: [ubuntu-latest]
         exclude:
           - cabal: "3.2.0.0"

app/Main.hs

@@ -22,9 +22,9 @@ import qualified Data.Set as Set
 import qualified Data.Text as T
 import qualified Data.Text.IO as T
 import Distribution.ArchHs.Aur (Aur, aurToIO, isInAur)
-import Distribution.ArchHs.ExtraDB
 import Distribution.ArchHs.Core
 import Distribution.ArchHs.Exception
+import Distribution.ArchHs.ExtraDB
 import Distribution.ArchHs.FilesDB
 import Distribution.ArchHs.Hackage
 import Distribution.ArchHs.Internal.Prelude
@@ -44,7 +44,7 @@ import System.Exit (ExitCode (ExitFailure, ExitSuccess))
 import System.FilePath (takeFileName)
 
 app ::
-  Members '[Embed IO, State (Set.Set PackageName), KnownGHCVersion, ExtraEnv, HackageEnv, FlagAssignmentsEnv, DependencyRecord, Trace, Aur, WithMyErr] r =>
+  (Members '[Embed IO, State (Set.Set PackageName), KnownGHCVersion, ExtraEnv, HackageEnv, FlagAssignmentsEnv, DependencyRecord, Trace, Aur, WithMyErr] r) =>
   PackageName ->
   FilePath ->
   Bool ->
@@ -105,6 +105,12 @@ app target path aurSupport skip uusi force installDeps jsonPath noSkipMissing lo
       -- after filling extra
       toBePacked1 = filledByExtra ^.. each . filtered (not . isProvided)
 
+  -- always keep the target
+  when (target `elem` missingChildren) $
+    printWarn "Target is in package(s) above, but we won't skip it"
+  -- missingChildren should not appear after the next line
+  let missingChildrenExcludedTarget = filter (/= target) missingChildren
+
   (filledByBoth, toBePacked2) <- do
     when aurSupport $ printInfo "Start searching AUR..."
     aurProvideList <-
@@ -116,15 +122,12 @@ app target path aurSupport skip uusi force installDeps jsonPath noSkipMissing lo
         b = a ^.. each . filtered (not . isProvided)
     return (a, b)
 
-  when (null filledByBoth) $
-    throw $ TargetDisappearException target
-
   printInfo "Solved:"
   embed $ T.putStrLn . prettySolvedPkgs $ filledByBoth
 
   printInfo "Recommended package order:"
   -- remove missingChildren from the graph iff noSkipMissing is not enabled
-  let vertexesToBeRemoved = (if noSkipMissing then [] else missingChildren) <> filledByBoth ^.. each . filtered isProvided ^.. each . pkgName
+  let vertexesToBeRemoved = (if noSkipMissing then [] else missingChildrenExcludedTarget) <> filledByBoth ^.. each . filtered isProvided ^.. each . pkgName
       removeSelfCycle g = foldr (\n acc -> GL.removeEdge n n acc) g $ toBePacked2 ^.. each . pkgName
       newGraph = GL.induce (`notElem` vertexesToBeRemoved) deps
   flattened <- case G.topSort . GL.skeleton $ removeSelfCycle newGraph of
@@ -136,10 +139,12 @@ app target path aurSupport skip uusi force installDeps jsonPath noSkipMissing lo
   let toBePacked3 = filter (\x -> x ^. pkgName `elem` flattened) toBePacked2
 
   -- add sign for missing children if we have
-  embed . putDoc $ (prettyDeps . reverse $ map (\x -> (x, x `elem` missingChildren)) flattened) <> line <> line
+  embed . putDoc $ (prettyDeps . reverse $ map (\x -> (x, x `elem` missingChildrenExcludedTarget)) flattened) <> line <> line
 
-  unless (null missingChildren || not noSkipMissing) $
-    embed . putDoc $ annotate italicized $ yellowStarInParens <+> "indicates a missing package" <> line <> line
+  unless (null missingChildrenExcludedTarget || not noSkipMissing) $
+    embed . putDoc $
+      annotate italicized $
+        yellowStarInParens <+> "indicates a missing package" <> line <> line
 
   let sysDepsToBePacked = Map.filterWithKey (\k _ -> k `elem` flattened) sysDeps
 
@@ -206,7 +211,8 @@ app target path aurSupport skip uusi force installDeps jsonPath noSkipMissing lo
 
   when installDeps $ do
     let providedDepends pkg =
-          pkg ^. pkgDeps
+          pkg
+            ^. pkgDeps
             ^.. each
               . filtered (\x -> depNotMyself (pkg ^. pkgName) x && depNotInGHCLib x && x ^. depProvider == Just ByExtra)
         toStr = unArchLinuxName . toArchLinuxName . _depName
@@ -235,7 +241,7 @@ trySolve :: FilesDB -> EmergedSysDep -> EmergedSysDep
 trySolve db dep
   | (Unsolved x) <- dep,
     (pkg : _) <- lookupPkg x db =
-    Solved x pkg
+      Solved x pkg
   | otherwise = dep
 
 isAllSolved :: [EmergedSysDep] -> Bool
@@ -279,7 +285,7 @@ runApp hackage extra flags traceStdout tracePath ref manager =
     . runReader hackage
     . runReader extra
 
-runTrace :: Member (Embed IO) r => Bool -> FilePath -> Sem (Trace ': r) a -> Sem r a
+runTrace :: (Member (Embed IO) r) => Bool -> FilePath -> Sem (Trace ': r) a -> Sem r a
 runTrace stdout path = interpret $ \case
   Trace m -> do
     when stdout (embed $ putStrLn m)
@@ -322,7 +328,8 @@ main = printHandledIOException $
     optExtraCabal <- mapM findCabalFile optExtraCabalDirs
 
     unless isExtraEmpty $
-      printInfo $ "You added" <+> hsep (punctuate comma $ pretty . takeFileName <$> optExtraCabal) <+> "as extra cabal file(s), starting parsing right now"
+      printInfo $
+        "You added" <+> hsep (punctuate comma $ pretty . takeFileName <$> optExtraCabal) <+> "as extra cabal file(s), starting parsing right now"
 
     parsedExtra <- mapM parseCabalFile optExtraCabal
 

arch-hs.cabal

@@ -41,7 +41,7 @@ common common-options
     , arch-web                     ^>=0.2
     , base                         >=4.12     && <5
     , bytestring
-    , Cabal                        >=3.2      && <3.7
+    , Cabal                        >=3.2      && <3.9
     , conduit                      ^>=1.3.2
     , conduit-extra                ^>=1.3.5
     , containers
@@ -52,7 +52,7 @@ common common-options
     , hackage-db                   ^>=2.1.0
     , http-client
     , http-client-tls
-    , megaparsec                   ^>=9.0.0   || ^>=9.1.0  || ^>=9.2.0 || ^>=9.3.0
+    , megaparsec                   ^>=9.0.0   || ^>=9.1.0  || ^>=9.2.0  || ^>=9.3.0
     , microlens                    ^>=0.4.11
     , microlens-th                 ^>=0.4.3
     , neat-interpolation           ^>=0.5.1
@@ -63,7 +63,7 @@ common common-options
     , servant-client               >=0.18.2   && <0.20
     , split                        ^>=0.2.3
     , tar-conduit                  ^>=0.3.2   || ^>=0.4.0
-    , template-haskell             ^>=2.16.0  || ^>=2.17.0 || ^>=2.18.0
+    , template-haskell             ^>=2.16.0  || ^>=2.17.0 || ^>=2.18.0 || ^>=2.19.0
     , text
 
   ghc-options:
@@ -98,10 +98,10 @@ library
   autogen-modules: Paths_arch_hs
   exposed-modules:
     Distribution.ArchHs.Aur
-    Distribution.ArchHs.ExtraDB
     Distribution.ArchHs.Compat
     Distribution.ArchHs.Core
     Distribution.ArchHs.Exception
+    Distribution.ArchHs.ExtraDB
     Distribution.ArchHs.FilesDB
     Distribution.ArchHs.Hackage
     Distribution.ArchHs.Internal.Prelude

src/Distribution/ArchHs/Exception.hs

@@ -37,7 +37,6 @@ data MyException
   | TargetExist PackageName DependencyProvider
   | CyclicExist [PackageName]
   | NetworkException ClientError
-  | TargetDisappearException PackageName
   | VersionNoParse String
 
 instance Show MyException where
@@ -46,7 +45,6 @@ instance Show MyException where
   show (TargetExist name provider) = "Target \"" <> unPackageName name <> "\" has been provided by " <> show provider
   show (CyclicExist c) = "Graph contains a cycle \"" <> show (fmap unPackageName c) <> "\""
   show (NetworkException e) = show e
-  show (TargetDisappearException name) = "Target \"" <> unPackageName name <> "\" is discarded during the dependency resolving"
   show (VersionNoParse v) = "String \"" <> v <> "\" can not be parsed to Cabal version"
 
 -- | Catch 'CE.IOException' and print it.