From a0c30b76d36ddb1735a89ec4a9355b716825f110 Mon Sep 17 00:00:00 2001
From: "Paolo G. Giarrusso" <p.giarrusso@gmail.com>
Date: Sun, 14 Aug 2016 17:50:05 +0200
Subject: [PATCH] Workaround #2491 at all call sites

---
 src/Data/Yaml/Extra.hs | 23 +++++++++++++++++++++++
 src/Stack/BuildPlan.hs |  2 +-
 src/Stack/Config.hs    |  2 +-
 src/Stack/ConfigCmd.hs |  2 +-
 src/Stack/Solver.hs    |  2 +-
 stack.cabal            |  1 +
 6 files changed, 28 insertions(+), 4 deletions(-)
 create mode 100644 src/Data/Yaml/Extra.hs

diff --git a/src/Data/Yaml/Extra.hs b/src/Data/Yaml/Extra.hs
new file mode 100644
index 0000000000..d667604dc4
--- /dev/null
+++ b/src/Data/Yaml/Extra.hs
@@ -0,0 +1,23 @@
+-- | 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           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 = 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
diff --git a/src/Stack/BuildPlan.hs b/src/Stack/BuildPlan.hs
index afa7c50b7b..331b61a8ac 100644
--- a/src/Stack/BuildPlan.hs
+++ b/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,
diff --git a/src/Stack/Config.hs b/src/Stack/Config.hs
index 0a4af9cd79..7cc1936585 100644
--- a/src/Stack/Config.hs
+++ b/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)
diff --git a/src/Stack/ConfigCmd.hs b/src/Stack/ConfigCmd.hs
index c5e16478f8..37097d3b7b 100644
--- a/src/Stack/ConfigCmd.hs
+++ b/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
diff --git a/src/Stack/Solver.hs b/src/Stack/Solver.hs
index 4aba9391a3..2e35796eb9 100644
--- a/src/Stack/Solver.hs
+++ b/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
diff --git a/stack.cabal b/stack.cabal
index 222b838592..ede4d7c0e0 100644
--- a/stack.cabal
+++ b/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