cabal-plan 0.6.1.0 → 0.6.2.0
raw patch · 6 files changed
+125/−32 lines, 6 filesdep +asyncdep +processdep −process-extrasdep −semigroupsdep ~aesondep ~ansi-terminaldep ~basePVP ok
version bump matches the API change (PVP)
Dependencies added: async, process
Dependencies removed: process-extras, semigroups
Dependency ranges changed: aeson, ansi-terminal, base, base-compat, mtl, optics-core, parsec, semialign, singleton-bool, these, transformers
API changes (from Hackage documentation)
+ Cabal.Plan: findPlanJson :: SearchPlanJson -> IO FilePath
Files
- ChangeLog.md +10/−0
- cabal-plan.cabal +14/−16
- src-exe/Flag.hs +1/−1
- src-exe/ProcessLazyByteString.hs +73/−0
- src-exe/cabal-plan.hs +6/−5
- src/Cabal/Plan.hs +21/−10
ChangeLog.md view
@@ -1,5 +1,15 @@ # Revision history for `cabal-plan` +## 0.6.2.0++### `lib:cabal-plan` Library++* Add `findPlanJson` function++### `exe:cabal-plan` Executable++* Drop `process-extras` dependency+ ## 0.6.1.0 ### `lib:cabal-plan` Library
cabal-plan.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.2 name: cabal-plan-version: 0.6.1.0+version: 0.6.2.0 synopsis: Library and utility for processing cabal's plan.json file description: {@@ -95,31 +95,33 @@ hs-source-dirs: src-exe main-is: cabal-plan.hs- other-modules: Paths_cabal_plan LicenseReport Flag+ other-modules: Paths_cabal_plan LicenseReport Flag ProcessLazyByteString autogen-modules: Paths_cabal_plan if flag(exe) -- dependencies w/ inherited version ranges via 'cabal-plan' library+ -- Note: exe is installable only with GHC-8.0+ build-depends: cabal-plan- , base+ , base >=4.9 , text , containers , bytestring , directory -- dependencies which require version bounds- build-depends: mtl ^>= 2.2.1- , ansi-terminal ^>= 0.9 || ^>=0.10- , base-compat ^>= 0.10.5 || ^>=0.11- , optics-core ^>= 0.1+ build-depends: mtl ^>= 2.2.2+ , async ^>= 2.2.2+ , ansi-terminal ^>=0.10+ , base-compat ^>=0.11+ , optics-core ^>= 0.2 , optparse-applicative ^>= 0.15.0.0- , parsec ^>= 3.1.11- , process-extras ^>= 0.7.4- , semialign ^>= 1 || ^>=1.1- , singleton-bool ^>= 0.1.4+ , parsec ^>= 3.1.13+ , process ^>= 1.4.3.0 || ^>=1.6.3.0+ , semialign ^>= 1.1+ , singleton-bool ^>= 0.1.5 , these ^>= 1 , topograph ^>= 1- , transformers ^>= 0.3.0.0 || ^>= 0.4.2.0 || ^>= 0.5.2.0+ , transformers ^>= 0.5.2.0 , vector ^>= 0.12.0.1 if flag(license-report)@@ -127,10 +129,6 @@ , tar ^>= 0.5.1.0 , zlib ^>= 0.6.2 , filepath ^>= 1.4.1.1-- if !impl(ghc >= 8.0)- build-depends:- semigroups ^>= 0.18.3 || ^>=0.19 if flag(_) cpp-options: -DUNDERLINE_SUPPORT
src-exe/Flag.hs view
@@ -59,7 +59,7 @@ showHide :: HasDefault def t => t -> String -> String -> O.Parser (Flag t) showHide t n d =- O.flag' (toFlag t True) (O.long ("show-" ++ n) <> O.help d)+ O.flag' (toFlag t True) (O.long ("show-" ++ n) Data.Semigroup.<> O.help d) <|> O.flag' (toFlag t False) (O.long ("hide-" ++ n)) <|> pure (def t)
+ src-exe/ProcessLazyByteString.hs view
@@ -0,0 +1,73 @@+module ProcessLazyByteString (readProcessWithExitCode) where++import Control.Concurrent.Async (wait, withAsync)+import qualified Control.Exception as E+import Control.Monad (unless)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy.Internal as LBS (ByteString (..),+ defaultChunkSize)+import Foreign.C.Error (Errno (..), ePIPE)+import qualified GHC.IO.Exception as GHC+import System.Exit (ExitCode)+import System.IO (Handle, hClose)+import qualified System.Process as Proc++readProcessWithExitCode+ :: String -- ^ Command+ -> [String] -- ^ Arguments+ -> BS.ByteString -- ^ Stdin+ -> IO (ExitCode, LBS.ByteString, LBS.ByteString)+readProcessWithExitCode cmd args = readProcessImpl (Proc.proc cmd args)++readProcessImpl+ :: Proc.CreateProcess+ -> BS.ByteString+ -> IO (ExitCode, LBS.ByteString, LBS.ByteString)+readProcessImpl cp input =+ Proc.withCreateProcess cp' $ \mi mo me ph -> case (mi, mo, me) of+ (Just inh, Just outh, Just errh) ->+ -- spawn workers to read stdout and stderr+ withAsync (getLBSContents outh) $ \outA ->+ withAsync (getLBSContents errh) $ \errA -> do+ -- write the input+ unless (BS.null input) $ BS.hPutStr inh input+ ignoreSigPipe $ hClose inh++ -- wait for the output+ out <- wait outA+ err <- wait errA++ -- wait for the process+ ec <- Proc.waitForProcess ph++ return (ec, out, err)++ (Nothing,_,_) -> fail "readProcessWithExitCode: Failed to get a stdin handle."+ (_,Nothing,_) -> fail "readProcessWithExitCode: Failed to get a stdout handle."+ (_,_,Nothing) -> fail "readProcessWithExitCode: Failed to get a stderr handle."++ where+ cp' :: Proc.CreateProcess+ cp' = cp+ { Proc.std_in = Proc.CreatePipe+ , Proc.std_out = Proc.CreatePipe+ , Proc.std_err = Proc.CreatePipe+ }++ignoreSigPipe :: IO () -> IO ()+ignoreSigPipe = E.handle $ \e -> case e of+ GHC.IOError { GHC.ioe_type = GHC.ResourceVanished, GHC.ioe_errno = Just ioe }+ | Errno ioe == ePIPE -> return ()+ _ -> E.throwIO e++getLBSContents :: Handle -> IO LBS.ByteString+getLBSContents = hGetContentsN LBS.defaultChunkSize++-- No unsafeInterleaveIO+hGetContentsN :: Int -> Handle -> IO LBS.ByteString+hGetContentsN k h = loop `E.finally` hClose h where+ loop = do+ c <- BS.hGetSome h k -- only blocks if there is no data available+ if BS.null c+ then return LBS.Empty+ else LBS.Chunk c <$> loop
src-exe/cabal-plan.hs view
@@ -18,6 +18,7 @@ import Data.Align (align) import Data.ByteString (ByteString) import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as LBS import Data.Char (isAlphaNum) import Data.Foldable (for_, toList) import qualified Data.Graph as G@@ -46,7 +47,7 @@ import System.Directory (getCurrentDirectory) import System.Exit (ExitCode (..), exitFailure) import System.IO (hPutStrLn, stderr, stdout)-import System.Process.ByteString (readProcessWithExitCode)+import ProcessLazyByteString (readProcessWithExitCode) import qualified Text.Parsec as P import qualified Text.Parsec.String as P import qualified Topograph as TG@@ -1068,19 +1069,19 @@ ] -- run dot- let readProcess :: FilePath -> [String] -> ByteString -> IO ByteString+ let readProcess :: FilePath -> [String] -> ByteString -> IO LBS.ByteString readProcess cmd args input = do (ec, out, err) <- readProcessWithExitCode cmd args input case ec of ExitSuccess -> return out ExitFailure _ -> do- BS.putStr err+ LBS.putStr err exitFailure contents' <- case mdot of Nothing -> return contents- Just PNG -> readProcess "dot" ["-Tpng"] contents- Just PDF -> readProcess "dot" ["-Tpdf"] contents+ Just PNG -> LBS.toStrict <$> readProcess "dot" ["-Tpng"] contents+ Just PDF -> LBS.toStrict <$> readProcess "dot" ["-Tpdf"] contents if output == "-" then BS.putStr contents'
src/Cabal/Plan.hs view
@@ -48,6 +48,7 @@ -- * Convenience functions , SearchPlanJson(..) , findAndDecodePlanJson+ , findPlanJson , findProjectRoot , decodePlanJson ) where@@ -417,14 +418,23 @@ | ExactPath FilePath -- ^ Exact location of plan.json deriving (Eq, Show, Read) --- | Locates the project root for cabal project relative to specified--- directory.+-- | Find and decode @plan.json@. --+-- See 'findPlanJson' and 'decodePlanJson'.+--+findAndDecodePlanJson+ :: SearchPlanJson+ -> IO PlanJson+findAndDecodePlanJson searchLoc = findPlanJson searchLoc >>= decodePlanJson++-- | Find @plan.json@.+--+-- When 'ProjectRelativeToDir' is passed locates the project root for cabal+-- project relative to specified directory.+-- -- @plan.json@ is located from either the optional build dir argument, or in -- the default directory (@dist-newstyle@) relative to the project root. ----- The folder assumed to be the project-root is returned as well.--- -- This function determines the project root in a slightly more liberal manner -- than cabal-install. If no cabal.project is found, cabal-install assumes an -- implicit cabal.project if the current directory contains any *.cabal files.@@ -435,10 +445,12 @@ -- -- Throws 'IO' exceptions on errors. ---findAndDecodePlanJson+-- @since 0.6.2.0+--+findPlanJson :: SearchPlanJson- -> IO PlanJson-findAndDecodePlanJson searchLoc = do+ -> IO FilePath+findPlanJson searchLoc = do planJsonFn <- case searchLoc of ExactPath fp -> pure fp InBuildDir builddir -> fromBuilddir builddir@@ -446,14 +458,14 @@ mRoot <- findProjectRoot fp case mRoot of Nothing -> fail ("missing project root relative to: " ++ fp)- Just dir -> fromBuilddir$ dir </> "dist-newstyle"+ Just dir -> fromBuilddir $ dir </> "dist-newstyle" havePlanJson <- Dir.doesFileExist planJsonFn unless havePlanJson $ fail "missing 'plan.json' file; do you need to run 'cabal new-build'?" - decodePlanJson planJsonFn+ return planJsonFn where fromBuilddir distFolder = do haveDistFolder <- Dir.doesDirectoryExist distFolder@@ -462,7 +474,6 @@ fail ("missing " ++ show distFolder ++ " folder; do you need to run 'cabal new-build'?") return $ distFolder </> "cache" </> "plan.json"- -- | Decodes @plan.json@ file location provided as 'FilePath' --