Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Workaround #2491 at all call sites #2492

Merged
merged 2 commits into from
Aug 16, 2016
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
27 changes: 27 additions & 0 deletions src/Data/Yaml/Extra.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,27 @@
{-# LANGUAGE ScopedTypeVariables #-}
-- | Wrappers for Yaml functions to workaround
-- https://github.com/commercialhaskell/stack/issues/2491.
-- Import Data.Yaml.Extra in place of Data.Yaml to use this workaround.
-- Beware these functions construct/deconstruct the entire file at once!
module Data.Yaml.Extra (decodeFileEither, encodeFile, module Data.Yaml) where

import Control.Exception
Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Please double-check this — I think it's OK (this is a straightforward synchronous exception, handled in the IO monad) but I'm not yet fluent with Haskell exceptions.

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I don't have much experience with Haskell exceptions either. Pinging @mgsloan.

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Since he seems busy, I'll trust my (more educated) judgement, assume this is fine, and merge this. Details below but feel free to skip.

Based on https://github.com/commercialhaskell/haskelldocumentation/blob/master/content/exceptions-best-practices.md, having read some more docs (including for MonadCatch, which doesn't apply here), having read the papers on Haskell exceptions (including async ones, also not applying here*), I think this is fine.

*We risk catching any async IOException, and I understand that's bad. But IOException shouldn't be used for asynchronous exceptions, and even safe-exceptions won't help there.
https://www.fpcomplete.com/blog/2016/06/announce-safe-exceptions

import Data.Yaml hiding (decodeFileEither, encodeFile)
import qualified Data.ByteString as B
import System.IO

-- Note: we refrain from using 'B.readFile' and 'B.writeFile', as they open
-- the file in binary mode rather than text mode.
decodeFileEither :: FromJSON a => FilePath -> IO (Either ParseException a)
decodeFileEither path =
handle (\(e :: IOException) -> return . Left . OtherParseException . SomeException $ e) $
withFile path ReadMode $
\hnd -> do
fileContent <- B.hGetContents hnd
return $ decodeEither' fileContent

encodeFile :: ToJSON a => FilePath -> a -> IO ()
encodeFile path v = withFile path WriteMode $
\hnd -> do
let fileContent = encode v
B.hPut hnd fileContent
2 changes: 1 addition & 1 deletion src/Stack/BuildPlan.hs
Original file line number Diff line number Diff line change
Expand Up @@ -66,7 +66,7 @@ import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import qualified Data.Traversable as Tr
import Data.Typeable (Typeable)
import Data.Yaml (decodeEither', decodeFileEither)
import Data.Yaml.Extra (decodeEither', decodeFileEither)
import qualified Distribution.Package as C
import Distribution.PackageDescription (GenericPackageDescription,
flagDefault, flagManual,
Expand Down
2 changes: 1 addition & 1 deletion src/Stack/Config.hs
Original file line number Diff line number Diff line change
Expand Up @@ -63,7 +63,7 @@ import Data.Monoid.Extra
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8, decodeUtf8, decodeUtf8With)
import Data.Text.Encoding.Error (lenientDecode)
import qualified Data.Yaml as Yaml
import qualified Data.Yaml.Extra as Yaml
import Distribution.System (OS (..), Platform (..), buildPlatform)
import qualified Distribution.Text
import Distribution.Version (simplifyVersionRange)
Expand Down
2 changes: 1 addition & 1 deletion src/Stack/ConfigCmd.hs
Original file line number Diff line number Diff line change
Expand Up @@ -17,7 +17,7 @@ import Control.Monad.Reader (MonadReader, asks)
import Control.Monad.Trans.Control (MonadBaseControl)
import qualified Data.ByteString as S
import qualified Data.HashMap.Strict as HMap
import qualified Data.Yaml as Yaml
import qualified Data.Yaml.Extra as Yaml
import Network.HTTP.Client.Conduit (HasHttpManager)
import Path
import Stack.BuildPlan
Expand Down
2 changes: 1 addition & 1 deletion src/Stack/Solver.hs
Original file line number Diff line number Diff line change
Expand Up @@ -53,7 +53,7 @@ import Data.Text.Encoding.Error (lenientDecode)
import qualified Data.Text.Lazy as LT
import Data.Text.Lazy.Encoding (decodeUtf8With)
import Data.Tuple (swap)
import qualified Data.Yaml as Yaml
import qualified Data.Yaml.Extra as Yaml
import qualified Distribution.Package as C
import qualified Distribution.PackageDescription as C
import qualified Distribution.Text as C
Expand Down
1 change: 1 addition & 0 deletions stack.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -66,6 +66,7 @@ library
Data.Maybe.Extra
Data.Monoid.Extra
Data.Store.VersionTagged
Data.Yaml.Extra
Distribution.Version.Extra
Network.HTTP.Download
Network.HTTP.Download.Verified
Expand Down