From d141266d9152356ef47ed43eb8759deb86a4b553 Mon Sep 17 00:00:00 2001
From: "Edward Z. Yang" <ezyang@cs.stanford.edu>
Date: Wed, 3 Aug 2016 02:51:37 -0700
Subject: [PATCH] Refactor showBuildTarget to not require QualLevel, making it
 total.

Signed-off-by: Edward Z. Yang <ezyang@cs.stanford.edu>
---
 Cabal/Distribution/Simple/BuildTarget.hs      | 15 +++++++++++++--
 .../Distribution/Client/BuildTarget.hs        |  2 ++
 .../Distribution/Client/ProjectPlanning.hs    | 19 -------------------
 .../Client/ProjectPlanning/Types.hs           | 16 ++++++++++++++++
 4 files changed, 31 insertions(+), 21 deletions(-)

diff --git a/Cabal/Distribution/Simple/BuildTarget.hs b/Cabal/Distribution/Simple/BuildTarget.hs
index 4b89bbfb3c3..0a8ffa2b6bc 100644
--- a/Cabal/Distribution/Simple/BuildTarget.hs
+++ b/Cabal/Distribution/Simple/BuildTarget.hs
@@ -233,10 +233,21 @@ showUserBuildTarget = intercalate ":" . getComponents
     getComponents (UserBuildTargetDouble s1 s2)    = [s1,s2]
     getComponents (UserBuildTargetTriple s1 s2 s3) = [s1,s2,s3]
 
-showBuildTarget :: QualLevel -> PackageId -> BuildTarget -> String
-showBuildTarget ql pkgid bt =
+-- | Unless you use 'QL1', this function is PARTIAL;
+-- use 'showBuildTarget' instead.
+showBuildTarget' :: QualLevel -> PackageId -> BuildTarget -> String
+showBuildTarget' ql pkgid bt =
     showUserBuildTarget (renderBuildTarget ql bt pkgid)
 
+-- | Unambiguously render a 'BuildTarget', so that it can
+-- be parsed in all situations.
+showBuildTarget :: PackageId -> BuildTarget -> String
+showBuildTarget pkgid t =
+    showBuildTarget' (qlBuildTarget t) pkgid t
+  where
+    qlBuildTarget BuildTargetComponent{} = QL2
+    qlBuildTarget _                      = QL3
+
 
 -- ------------------------------------------------------------
 -- * Resolving user targets to build targets
diff --git a/cabal-install/Distribution/Client/BuildTarget.hs b/cabal-install/Distribution/Client/BuildTarget.hs
index 537b743f9ff..e21d4b58b01 100644
--- a/cabal-install/Distribution/Client/BuildTarget.hs
+++ b/cabal-install/Distribution/Client/BuildTarget.hs
@@ -13,6 +13,8 @@ module Distribution.Client.BuildTarget (
 
     -- * Build targets
     BuildTarget(..),
+    -- Don't export me: it's partial (if you try to qualify too
+    -- much you will error.)
     --showBuildTarget,
     QualLevel(..),
     buildTargetPackage,
diff --git a/cabal-install/Distribution/Client/ProjectPlanning.hs b/cabal-install/Distribution/Client/ProjectPlanning.hs
index 2df114b18b7..b9a01e82e78 100644
--- a/cabal-install/Distribution/Client/ProjectPlanning.hs
+++ b/cabal-install/Distribution/Client/ProjectPlanning.hs
@@ -103,7 +103,6 @@ import qualified Distribution.Simple.LocalBuildInfo as Cabal
 import           Distribution.Simple.LocalBuildInfo (ComponentName(..))
 import qualified Distribution.Simple.Register as Cabal
 import qualified Distribution.Simple.InstallDirs as InstallDirs
-import qualified Distribution.Simple.BuildTarget as Cabal
 
 import           Distribution.Simple.Utils hiding (matchFileGlob)
 import           Distribution.Version
@@ -2202,24 +2201,6 @@ setupHsBuildArgs (ElabPackage pkg) = map (showComponentTarget (packageId pkg)) (
 setupHsBuildArgs (ElabComponent _comp) = []
 
 
-showComponentTarget :: PackageId -> ComponentTarget -> String
-showComponentTarget pkgid =
-    showBuildTarget . toBuildTarget
-  where
-    showBuildTarget t =
-      Cabal.showBuildTarget (qlBuildTarget t) pkgid t
-
-    qlBuildTarget Cabal.BuildTargetComponent{} = Cabal.QL2
-    qlBuildTarget _                            = Cabal.QL3
-
-    toBuildTarget :: ComponentTarget -> Cabal.BuildTarget
-    toBuildTarget (ComponentTarget cname subtarget) =
-      case subtarget of
-        WholeComponent     -> Cabal.BuildTargetComponent cname
-        ModuleTarget mname -> Cabal.BuildTargetModule    cname mname
-        FileTarget   fname -> Cabal.BuildTargetFile      cname fname
-
-
 setupHsReplFlags :: ElaboratedConfiguredPackage
                  -> ElaboratedSharedConfig
                  -> Verbosity
diff --git a/cabal-install/Distribution/Client/ProjectPlanning/Types.hs b/cabal-install/Distribution/Client/ProjectPlanning/Types.hs
index 7e221f0f7ce..7ddd2c1aef3 100644
--- a/cabal-install/Distribution/Client/ProjectPlanning/Types.hs
+++ b/cabal-install/Distribution/Client/ProjectPlanning/Types.hs
@@ -32,6 +32,7 @@ module Distribution.Client.ProjectPlanning.Types (
     -- * Build targets
     PackageTarget(..),
     ComponentTarget(..),
+    showComponentTarget,
     SubComponentTarget(..),
 
     -- * Setup script
@@ -54,6 +55,7 @@ import           Distribution.System
 import qualified Distribution.PackageDescription as Cabal
 import           Distribution.InstalledPackageInfo (InstalledPackageInfo)
 import           Distribution.Simple.Compiler
+import qualified Distribution.Simple.BuildTarget as Cabal
 import           Distribution.Simple.Program.Db
 import           Distribution.ModuleName (ModuleName)
 import           Distribution.Simple.LocalBuildInfo (ComponentName(..))
@@ -465,6 +467,20 @@ instance Binary PackageTarget
 instance Binary ComponentTarget
 instance Binary SubComponentTarget
 
+-- | Unambiguously render a 'ComponentTarget', e.g., to pass
+-- to a Cabal Setup script.
+showComponentTarget :: PackageId -> ComponentTarget -> String
+showComponentTarget pkgid =
+    Cabal.showBuildTarget pkgid . toBuildTarget
+  where
+    toBuildTarget :: ComponentTarget -> Cabal.BuildTarget
+    toBuildTarget (ComponentTarget cname subtarget) =
+      case subtarget of
+        WholeComponent     -> Cabal.BuildTargetComponent cname
+        ModuleTarget mname -> Cabal.BuildTargetModule    cname mname
+        FileTarget   fname -> Cabal.BuildTargetFile      cname fname
+
+
 
 ---------------------------
 -- Setup.hs script policy