Refactor showBuildTarget to not require QualLevel, making it total.

Signed-off-by: Edward Z. Yang <[email protected]>
ezyang · Aug 11, 2016 · d141266 · d141266
1 parent aee9862
commit d141266
Show file tree

Hide file tree

Showing 4 changed files with 31 additions and 21 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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