Merge pull request #2492 from commercialhaskell/2491-workaround-yaml-…

…intl-bug

Workaround #2491 at all call sites

src/Data/Yaml/Extra.hs

@@ -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
+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

src/Stack/BuildPlan.hs

@@ -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,

src/Stack/Config.hs

@@ -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)

src/Stack/ConfigCmd.hs

@@ -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

src/Stack/Solver.hs

@@ -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

stack.cabal

@@ -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