Merge pull request commercialhaskell#2482 from commercialhaskell/2457…

…-fix-win-build

Fix Windows build

src/Path/Extra.hs

@@ -9,8 +9,15 @@ module Path.Extra
   ,parseCollapsedAbsFile
   ,rejectMissingFile
   ,rejectMissingDir
+  ,pathToByteString
+  ,pathToLazyByteString
+  ,pathToText
   ) where
 
+import qualified Data.ByteString.Lazy.Char8 as BSL
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
 import           Control.Monad (liftM)
 import           Control.Monad.Catch
 import           Control.Monad.IO.Class
@@ -94,3 +101,14 @@ rejectMissingDir :: MonadIO m
   -> m (Maybe (Path Abs Dir))
 rejectMissingDir Nothing = return Nothing
 rejectMissingDir (Just p) = bool Nothing (Just p) `liftM` doesDirExist p
+
+-- | Convert to a lazy ByteString using toFilePath and UTF8.
+pathToLazyByteString :: Path b t -> BSL.ByteString
+pathToLazyByteString = BSL.fromStrict . pathToByteString
+
+-- | Convert to a ByteString using toFilePath and UTF8.
+pathToByteString :: Path b t -> BS.ByteString
+pathToByteString = T.encodeUtf8 . pathToText
+
+pathToText :: Path b t -> T.Text
+pathToText = T.pack . toFilePath

src/test/Stack/Ghci/PortableFakePaths.hs

@@ -0,0 +1,12 @@
+{-# LANGUAGE CPP #-}
+
+-- | Helpers for writing fake paths for test suite for the GhciScript DSL.
+-- This must be a separate module because it is used in Teplate Haskell splices.
+module Stack.Ghci.PortableFakePaths where
+
+defaultDrive :: FilePath
+#ifdef WINDOWS
+defaultDrive = "C:\\"
+#else
+defaultDrive = "/"
+#endif

src/test/Stack/Ghci/ScriptSpec.hs

@@ -9,7 +9,10 @@ import           Data.Monoid
 import qualified Data.Set as S
 import           Distribution.ModuleName
 import           Test.Hspec
+import qualified System.FilePath as FP
+import           Stack.Ghci.PortableFakePaths
 import           Path
+import           Path.Extra (pathToLazyByteString)
 
 import           Stack.Ghci.Script
 
@@ -20,10 +23,11 @@ spec = do
 
       describe "script" $ do
         it "should seperate commands with a newline" $ do
-          let script = cmdCdGhc $(mkAbsDir "/src/package-a")
+          let dir = $(mkAbsDir $ defaultDrive FP.</> "src" FP.</> "package-a")
+              script = cmdCdGhc dir
                     <> cmdAdd [fromString "Lib.A"]
           scriptToLazyByteString script `shouldBe`
-            ":cd-ghc /src/package-a/\n:add Lib.A\n"
+            ":cd-ghc " <> pathToLazyByteString dir <> "\n:add Lib.A\n"
 
       describe ":add" $ do
         it "should not render empty add commands" $ do
@@ -36,15 +40,17 @@ spec = do
 
       describe ":add (by file)" $ do
         it "should render a full file path" $ do
-          let script = cmdAddFile $(mkAbsFile "/Users/someone/src/project/package-a/src/Main.hs")
+          let file = $(mkAbsFile $ defaultDrive FP.</> "Users" FP.</> "someone" FP.</> "src" FP.</> "project" FP.</> "package-a" FP.</> "src" FP.</> "Main.hs")
+              script = cmdAddFile file
           scriptToLazyByteString script `shouldBe`
-            ":add /Users/someone/src/project/package-a/src/Main.hs\n"
+            ":add " <> pathToLazyByteString file <> "\n"
 
       describe ":cd-ghc" $ do
         it "should render a full absolute path" $ do
-          let script = cmdCdGhc $(mkAbsDir "/Users/someone/src/project/package-a")
+          let dir = $(mkAbsDir $ defaultDrive FP.</> "Users" FP.</> "someone" FP.</> "src" FP.</> "project" FP.</> "package-a")
+              script = cmdCdGhc dir
           scriptToLazyByteString script `shouldBe`
-            ":cd-ghc /Users/someone/src/project/package-a/\n"
+            ":cd-ghc " <> pathToLazyByteString dir <> "\n"
 
       describe ":module" $ do
         it "should render empty module as ':module +'" $ do

src/test/Stack/GhciSpec.hs

@@ -9,6 +9,7 @@ import qualified Data.ByteString.Lazy as LBS
 import qualified Data.Map as M
 import qualified Data.Set as S
 import           Data.Text (Text)
+import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 import           Distribution.ModuleName
 import           Stack.Types.Package
@@ -17,9 +18,38 @@ import           Stack.Types.Version
 import           Test.Hspec
 import           NeatInterpolation
 import           Path
+import           Path.Extra (pathToText)
+import qualified System.FilePath as FP
 
 import           Stack.Ghci
 import           Stack.Ghci.Script (scriptToLazyByteString)
+import           Stack.Ghci.PortableFakePaths
+
+textToLazy :: Text -> LBS.ByteString
+textToLazy = LBS.fromStrict . T.encodeUtf8
+
+-- | Matches two strings, after converting line-ends in the second to Unix ones
+-- (in a hacky way) and converting both to the same type. Workaround for
+-- https://github.com/nikita-volkov/neat-interpolation/issues/14.
+shouldBeLE :: LBS.ByteString -> Text -> Expectation
+shouldBeLE actual expected = shouldBe actual (textToLazy $ T.filter (/= '\r') expected)
+
+baseProjDir, projDirA, projDirB :: Path Abs Dir
+baseProjDir = $(mkAbsDir $ defaultDrive FP.</> "Users" FP.</> "someone" FP.</> "src")
+projDirA = baseProjDir </> $(mkRelDir "project-a")
+projDirB = baseProjDir </> $(mkRelDir "project-b")
+
+relFile :: Path Rel File
+relFile = $(mkRelFile $ "exe" FP.</> "Main.hs")
+
+absFile :: Path Abs File
+absFile = projDirA </> relFile
+
+projDirAT, projDirBT, relFileT, absFileT :: Text
+projDirAT = pathToText projDirA
+projDirBT = pathToText projDirB
+relFileT = pathToText relFile
+absFileT = pathToText absFile
 
 spec :: Spec
 spec = do
@@ -28,76 +58,76 @@ spec = do
       describe "should render GHCi scripts" $ do
         it "with one library package" $ do
           let res = scriptToLazyByteString $ renderScriptGhci packages_singlePackage Nothing
-          res `shouldBe` (LBS.fromStrict $ T.encodeUtf8 ghciScript_projectWithLib)
+          res `shouldBeLE` ghciScript_projectWithLib
 
         it "with one main package" $ do
           let res = scriptToLazyByteString $ renderScriptGhci []
-                                                              (Just $(mkAbsFile "/Users/someone/src/project-a/exe/Main.hs"))
-          res `shouldBe` (LBS.fromStrict $ T.encodeUtf8 ghciScript_projectWithMain)
+                                                              (Just absFile)
+          res `shouldBeLE` ghciScript_projectWithMain
 
         it "with one library and main package" $ do
           let res = scriptToLazyByteString $ renderScriptGhci packages_singlePackage
-                                                              (Just $(mkAbsFile "/Users/someone/src/project-a/exe/Main.hs"))
-          res `shouldBe` (LBS.fromStrict $ T.encodeUtf8 ghciScript_projectWithLibAndMain)
+                                                              (Just absFile)
+          res `shouldBeLE` ghciScript_projectWithLibAndMain
 
         it "with multiple library packages" $ do
           let res = scriptToLazyByteString $ renderScriptGhci packages_multiplePackages Nothing
-          res `shouldBe` (LBS.fromStrict $ T.encodeUtf8 ghciScript_multipleProjectsWithLib)
+          res `shouldBeLE` ghciScript_multipleProjectsWithLib
 
       describe "should render intero scripts" $ do
         it "with one library package" $ do
           let res = scriptToLazyByteString $ renderScriptIntero packages_singlePackage Nothing
-          res `shouldBe` (LBS.fromStrict $ T.encodeUtf8 interoScript_projectWithLib)
+          res `shouldBeLE` interoScript_projectWithLib
 
         it "with one main package" $ do
           let res = scriptToLazyByteString $ renderScriptIntero packages_singlePackage
-                                                              (Just $(mkAbsFile "/Users/someone/src/project-a/exe/Main.hs"))
-          res `shouldBe` (LBS.fromStrict $ T.encodeUtf8 interoScript_projectWithMain)
+                                                              (Just absFile)
+          res `shouldBeLE` interoScript_projectWithMain
 
         it "with one library and main package" $ do
           let res = scriptToLazyByteString $ renderScriptIntero packages_singlePackage
-                                                              (Just $(mkAbsFile "/Users/someone/src/project-a/exe/Main.hs"))
-          res `shouldBe` (LBS.fromStrict $ T.encodeUtf8 interoScript_projectWithLibAndMain)
+                                                              (Just absFile)
+          res `shouldBeLE` interoScript_projectWithLibAndMain
 
         it "with multiple library packages" $ do
           let res = scriptToLazyByteString $ renderScriptIntero packages_multiplePackages Nothing
-          res `shouldBe` (LBS.fromStrict $ T.encodeUtf8 interoScript_multipleProjectsWithLib)
+          res `shouldBeLE` interoScript_multipleProjectsWithLib
 
 -- Exptected Intero scripts
 
 interoScript_projectWithLib :: Text
 interoScript_projectWithLib = [text|
-:cd-ghc /Users/someone/src/project-a/
+:cd-ghc $projDirAT
 :add Lib.A
 :module + Lib.A
 
 |]
 
 interoScript_projectWithMain :: Text
 interoScript_projectWithMain = [text|
-:cd-ghc /Users/someone/src/project-a/
+:cd-ghc $projDirAT
 :add Lib.A
-:cd-ghc /Users/someone/src/project-a/
-:add /Users/someone/src/project-a/exe/Main.hs
+:cd-ghc $projDirAT
+:add $absFileT
 :module + Lib.A
 
 |]
 
 interoScript_projectWithLibAndMain :: Text
 interoScript_projectWithLibAndMain = [text|
-:cd-ghc /Users/someone/src/project-a/
+:cd-ghc $projDirAT
 :add Lib.A
-:cd-ghc /Users/someone/src/project-a/
-:add /Users/someone/src/project-a/exe/Main.hs
+:cd-ghc $projDirAT
+:add $absFileT
 :module + Lib.A
 
 |]
 
 interoScript_multipleProjectsWithLib :: Text
 interoScript_multipleProjectsWithLib = [text|
-:cd-ghc /Users/someone/src/project-a/
+:cd-ghc $projDirAT
 :add Lib.A
-:cd-ghc /Users/someone/src/project-b/
+:cd-ghc $projDirBT
 :add Lib.B
 :module + Lib.A Lib.B
 
@@ -114,15 +144,15 @@ ghciScript_projectWithLib = [text|
 
 ghciScript_projectWithMain :: Text
 ghciScript_projectWithMain = [text|
-:add /Users/someone/src/project-a/exe/Main.hs
+:add $absFileT
 :module +
 
 |]
 
 ghciScript_projectWithLibAndMain :: Text
 ghciScript_projectWithLibAndMain = [text|
 :add Lib.A
-:add /Users/someone/src/project-a/exe/Main.hs
+:add $absFileT
 :module + Lib.A
 
 |]
@@ -140,14 +170,14 @@ ghciScript_multipleProjectsWithLib = [text|
 ghciLegacyScript_projectWithMain :: Text
 ghciLegacyScript_projectWithMain = [text|
 :add
-:add /Users/someone/src/project-a/exe/Main.hs
+:add $absFileT
 :module +
 |]
 
 ghciLegacyScript_projectWithLibAndMain :: Text
 ghciLegacyScript_projectWithLibAndMain = [text|
 :add Lib.A
-:add /Users/someone/src/project-a/exe/Main.hs
+:add $absFileT
 :module + Lib.A
 |]
 
@@ -164,7 +194,7 @@ packages_singlePackage :: [GhciPkgInfo]
 packages_singlePackage =
   [ GhciPkgInfo
     { ghciPkgModules = S.fromList [fromString "Lib.A"]
-    , ghciPkgDir = $(mkAbsDir "/Users/someone/src/project-a")
+    , ghciPkgDir = projDirA
     , ghciPkgName = $(mkPackageName "package-a")
     , ghciPkgOpts = []
     , ghciPkgModFiles = S.empty
@@ -196,7 +226,7 @@ packages_multiplePackages :: [GhciPkgInfo]
 packages_multiplePackages =
   [ GhciPkgInfo
     { ghciPkgModules = S.fromList [fromString "Lib.A"]
-    , ghciPkgDir = $(mkAbsDir "/Users/someone/src/project-a")
+    , ghciPkgDir = projDirA
     , ghciPkgName = $(mkPackageName "package-a")
     , ghciPkgOpts = []
     , ghciPkgModFiles = S.empty
@@ -224,7 +254,7 @@ packages_multiplePackages =
     }
   , GhciPkgInfo
     { ghciPkgModules = S.fromList [fromString "Lib.B"]
-    , ghciPkgDir = $(mkAbsDir "/Users/someone/src/project-b")
+    , ghciPkgDir = projDirB
     , ghciPkgName = $(mkPackageName "package-b")
     , ghciPkgOpts = []
     , ghciPkgModFiles = S.empty

stack.cabal

@@ -300,6 +300,7 @@ test-suite stack-test
                 , Stack.DotSpec
                 , Stack.GhciSpec
                 , Stack.Ghci.ScriptSpec
+                , Stack.Ghci.PortableFakePaths
                 , Stack.PackageDumpSpec
                 , Stack.ArgsSpec
                 , Stack.NixSpec
@@ -339,6 +340,8 @@ test-suite stack-test
                 , vector
                 , template-haskell
   default-language:    Haskell2010
+  if os(windows)
+    cpp-options:     -DWINDOWS
 
 test-suite stack-integration-test
   type:           exitcode-stdio-1.0