From c275b0a6f3c458c26842b0c75d98e8863ebfa7a1 Mon Sep 17 00:00:00 2001
From: unknown <power.walross@gmail.com>
Date: Mon, 13 Apr 2020 17:12:21 +0200
Subject: [PATCH] Improve CLI parsing with explicit error handling

---
 src-exe/cabal-plan.hs | 31 +++++++++++++++++++++++++++++--
 1 file changed, 29 insertions(+), 2 deletions(-)

diff --git a/src-exe/cabal-plan.hs b/src-exe/cabal-plan.hs
index f0255ad..e0e9163 100644
--- a/src-exe/cabal-plan.hs
+++ b/src-exe/cabal-plan.hs
@@ -146,6 +146,21 @@ parsePattern = either (Left . show) Right . P.runParser (patternP <* P.eof) () "
     toCompType "test"  = return $ CompTypeTest
     toCompType t       = fail $ "Unknown component type: " ++ show t
 
+prettyPattern :: Pattern -> T.Text
+prettyPattern (Pattern pkg kind cname) = 
+    maybe "" (<> ":") pkg 
+    <> maybe "" ((<> ":") . prettyCompType) kind
+    <> fromMaybe "" cname 
+
+prettyCompType :: CompType -> T.Text
+prettyCompType compType = case compType of 
+    CompTypeBench -> "bench"
+    CompTypeExe   -> "exe"
+    CompTypeLib   -> "lib"
+    CompTypeFLib  -> "flib"
+    CompTypeSetup -> "setup"
+    CompTypeTest  -> "test"
+
 patternCompleter :: Bool -> Completer
 patternCompleter onlyWithExes = mkCompleter $ \pfx -> do
     plan <- getCurrentDirectory >>= findAndDecodePlanJson . ProjectRelativeToDir
@@ -312,10 +327,22 @@ main = do
       LicenseReport mfp pat -> doLicenseReport mfp pat
       WhyDependsCommand s compPat depPat -> do
           (_, plan) <- findPlan s
-          let [(_, compId, _)] = findUnit plan compPat
-          let [(_, depId, _)] = findUnit plan depPat
+          compId <- findUniqueUnitOrExit plan compPat
+          depId <- findUniqueUnitOrExit plan depPat
           doWhyDepends optsUseColors plan compId depId
   where
+    findUniqueUnitOrExit :: PlanJson -> Pattern -> IO UnitId 
+    findUniqueUnitOrExit p pat = 
+        case findUnit p pat of 
+            [(_, uid, _)] -> pure uid
+            [] -> do 
+                hPutStrLn stderr $ "Could not find any unit with pattern: " ++ show (prettyPattern pat)
+                exitFailure
+            xs -> do
+                hPutStrLn stderr $ "Ambiguous target \"" ++ T.unpack (prettyPattern pat) ++ "\". Found the following targets:"
+                for_ xs $ \(t, _, _) -> hPutStrLn stderr $ "  " ++ T.unpack t
+                exitFailure
+
     findPlan search = do
         cwd <- getCurrentDirectory
         (searchMethod, mProjRoot) <- case search of