Skip to content

Commit

Permalink
Add verbose output marker for show-build-info
Browse files Browse the repository at this point in the history
Simplifies writing tests for show-build-info

Add trailing path separator to make testing simpler.
  • Loading branch information
fendor committed Jul 14, 2021
1 parent 8bd4431 commit 8ce27f2
Show file tree
Hide file tree
Showing 2 changed files with 6 additions and 4 deletions.
4 changes: 3 additions & 1 deletion Cabal/src/Distribution/Simple/ShowBuildInfo.hs
Original file line number Diff line number Diff line change
Expand Up @@ -80,6 +80,8 @@ import Distribution.Types.TargetInfo
import Distribution.Text
import Distribution.Pretty

import System.FilePath (addTrailingPathSeparator)

-- | Construct a JSON document describing the build information for a
-- package.
mkBuildInfo
Expand Down Expand Up @@ -133,7 +135,7 @@ mkComponentInfo wdir pkg_descr lbi clbi = JsonObject $
, "modules" .= JsonArray (map (JsonString . T.pack . display) modules)
, "src-files" .= JsonArray (map (JsonString . T.pack) sourceFiles)
, "hs-src-dirs" .= JsonArray (map (JsonString . T.pack . prettyShow) $ hsSourceDirs bi)
, "src-dir" .= JsonString (T.pack wdir)
, "src-dir" .= JsonString (T.pack $ addTrailingPathSeparator wdir)
] <> cabalFile
where
name = componentLocalName clbi
Expand Down
6 changes: 3 additions & 3 deletions cabal-install/src/Distribution/Client/CmdShowBuildInfo.hs
Original file line number Diff line number Diff line change
Expand Up @@ -23,7 +23,7 @@ import Distribution.Simple.Command
import Distribution.Verbosity
( Verbosity, silent )
import Distribution.Simple.Utils
( wrapText )
( wrapText, withOutputMarker )

import qualified Data.Map as Map
import Distribution.Client.ProjectPlanning.Types
Expand Down Expand Up @@ -122,12 +122,12 @@ showBuildInfoAction flags@NixStyleFlags { extraFlags = (ShowBuildInfoFlags fileO
components = map JsonRaw componentBuildInfos
fields = mkBuildInfo' compilerInfo components
json = JsonObject $ fields <>
[ ("project-root", JsonString (T.pack (distProjectRootDirectory (distDirLayout baseCtx))))
[ ("project-root", JsonString (T.pack (addTrailingPathSeparator $ distProjectRootDirectory (distDirLayout baseCtx))))
]
res = renderJson json ""

case fileOutput of
Nothing -> T.putStrLn res
Nothing -> T.putStrLn $ T.pack $ withOutputMarker verbosity (T.unpack res)
Just fp -> T.writeFile fp res

where
Expand Down

0 comments on commit 8ce27f2

Please sign in to comment.