Skip to content

Commit

Permalink
Gracefully handle invalid paths in error/warning messages (#1561)
Browse files Browse the repository at this point in the history
  • Loading branch information
borsboom committed Dec 30, 2015
1 parent 0a52a85 commit fe235d4
Show file tree
Hide file tree
Showing 2 changed files with 7 additions and 10 deletions.
3 changes: 2 additions & 1 deletion ChangeLog.md
Original file line number Diff line number Diff line change
Expand Up @@ -17,7 +17,8 @@ Bug fixes:
[#1551](https://github.com/commercialhaskell/stack/issues/1551)
- Properly redownload corrupted downloads with the correct file size.
[Mailing list discussion](https://groups.google.com/d/msg/haskell-stack/iVGDG5OHYxs/FjUrR5JsDQAJ)

- Gracefully handle invalid paths in error/warning messages
[#1561](https://github.com/commercialhaskell/stack/issues/1561)

## 1.0.0

Expand Down
14 changes: 5 additions & 9 deletions src/Stack/Build/Execute.hs
Original file line number Diff line number Diff line change
Expand Up @@ -22,7 +22,7 @@ import Control.Concurrent.Async (withAsync, wait)
import Control.Concurrent.Execute
import Control.Concurrent.MVar.Lifted
import Control.Concurrent.STM
import Control.Exception.Enclosed (catchIO, tryIO)
import Control.Exception.Enclosed (catchIO)
import Control.Exception.Lifted
import Control.Monad (liftM, when, unless, void, join, filterM, (<=<))
import Control.Monad.Catch (MonadCatch, MonadMask)
Expand Down Expand Up @@ -1338,7 +1338,7 @@ printBuildOutput excludeTHLoading makeAbsolute pkgDir level outH = void $
=$ CL.mapM_ (monadLoggerLog $(TH.location >>= liftLoc) "" level)

-- | Strip Template Haskell "Loading package" lines and making paths absolute.
mungeBuildOutput :: MonadIO m
mungeBuildOutput :: (MonadIO m, MonadThrow m)
=> Bool -- ^ exclude TH loading?
-> Bool -- ^ convert paths to absolute?
-> Path Abs Dir -- ^ package's root directory
Expand All @@ -1363,21 +1363,17 @@ mungeBuildOutput excludeTHLoading makeAbsolute pkgDir = void $
let (x, y) = T.break (== ':') bs
mabs <-
if isValidSuffix y
then do
efp <- liftIO $ tryIO $ resolveFile pkgDir (T.unpack x)
case efp of
Left _ -> return Nothing
Right fp -> return $ Just $ T.pack (toFilePath fp)
then fmap (T.pack . toFilePath) <$> resolveFileMaybe pkgDir (T.unpack $ T.strip x)
else return Nothing
case mabs of
Nothing -> return bs
Just fp -> return $ fp `T.append` y

-- | Match the line:column format at the end of lines
isValidSuffix = isRight . parseOnly (lineCol <* endOfInput)
isValidSuffix = isRight . parseOnly lineCol
lineCol = char ':' >> (decimal :: Parser Int)
>> char ':' >> (decimal :: Parser Int)
>> (string ":" <|> string ": Warning:")
>> char ':'
>> return ()

-- | Strip @\r@ characters from the byte vector. Used because Windows.
Expand Down

0 comments on commit fe235d4

Please sign in to comment.