Workaround commercialhaskell#2491 at all call sites

Blaisorblade · Blaisorblade · commit a0c30b76d36d · 2016-08-14T23:14:54.000+02:00
diff --git a/src/Data/Yaml/Extra.hs 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
