From 26ffffc9a0f04b1c373e91226ebf5f683635b55a Mon Sep 17 00:00:00 2001 From: "Paolo G. Giarrusso" Date: Fri, 12 Aug 2016 14:48:12 +0200 Subject: [PATCH 1/4] Add conversions from Path to various strings --- src/Path/Extra.hs | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/src/Path/Extra.hs b/src/Path/Extra.hs index a79caf6762..0e1479fddf 100644 --- a/src/Path/Extra.hs +++ b/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 From 81105cd4446b61c598b27a2f8d1633c0d5a0e563 Mon Sep 17 00:00:00 2001 From: "Paolo G. Giarrusso" Date: Fri, 12 Aug 2016 14:46:23 +0200 Subject: [PATCH 2/4] Reduce duplication in GhciSpec.hs Deduplicate code that I'll have to change to fix compilation on Windows (and maybe a few other things). --- src/test/Stack/GhciSpec.hs | 76 ++++++++++++++++++++++++-------------- 1 file changed, 48 insertions(+), 28 deletions(-) diff --git a/src/test/Stack/GhciSpec.hs b/src/test/Stack/GhciSpec.hs index 773e9eea57..dc9241315a 100644 --- a/src/test/Stack/GhciSpec.hs +++ b/src/test/Stack/GhciSpec.hs @@ -17,10 +17,30 @@ import Stack.Types.Version import Test.Hspec import NeatInterpolation import Path +import Path.Extra (pathToText) import Stack.Ghci import Stack.Ghci.Script (scriptToLazyByteString) +textToLazy :: Text -> LBS.ByteString +textToLazy = LBS.fromStrict . T.encodeUtf8 + +projDirA, projDirB :: Path Abs Dir +projDirA = $(mkAbsDir "/Users/someone/src/project-a") +projDirB = $(mkAbsDir "/Users/someone/src/project-b") + +relFile :: Path Rel File +relFile = $(mkRelFile "exe/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 describe "GHCi" $ do @@ -28,46 +48,46 @@ 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 `shouldBe` textToLazy 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 `shouldBe` textToLazy 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 `shouldBe` textToLazy ghciScript_projectWithLibAndMain it "with multiple library packages" $ do let res = scriptToLazyByteString $ renderScriptGhci packages_multiplePackages Nothing - res `shouldBe` (LBS.fromStrict $ T.encodeUtf8 ghciScript_multipleProjectsWithLib) + res `shouldBe` textToLazy 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 `shouldBe` textToLazy 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 `shouldBe` textToLazy 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 `shouldBe` textToLazy interoScript_projectWithLibAndMain it "with multiple library packages" $ do let res = scriptToLazyByteString $ renderScriptIntero packages_multiplePackages Nothing - res `shouldBe` (LBS.fromStrict $ T.encodeUtf8 interoScript_multipleProjectsWithLib) + res `shouldBe` textToLazy 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 @@ -75,29 +95,29 @@ interoScript_projectWithLib = [text| 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,7 +134,7 @@ ghciScript_projectWithLib = [text| ghciScript_projectWithMain :: Text ghciScript_projectWithMain = [text| -:add /Users/someone/src/project-a/exe/Main.hs +:add $absFileT :module + |] @@ -122,7 +142,7 @@ ghciScript_projectWithMain = [text| 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 +160,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 +184,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 +216,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 +244,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 From 3749765106815101c6eb4dc009a56b3383a40386 Mon Sep 17 00:00:00 2001 From: "Paolo G. Giarrusso" Date: Fri, 12 Aug 2016 13:57:28 +0200 Subject: [PATCH 3/4] Fix build on Windows (#2457) To this end, define WINDOWS also in testsuite. --- src/test/Stack/Ghci/PortableFakePaths.hs | 12 ++++++++++++ src/test/Stack/Ghci/ScriptSpec.hs | 18 ++++++++++++------ src/test/Stack/GhciSpec.hs | 11 +++++++---- stack.cabal | 3 +++ 4 files changed, 34 insertions(+), 10 deletions(-) create mode 100644 src/test/Stack/Ghci/PortableFakePaths.hs diff --git a/src/test/Stack/Ghci/PortableFakePaths.hs b/src/test/Stack/Ghci/PortableFakePaths.hs new file mode 100644 index 0000000000..62a1daf2bb --- /dev/null +++ b/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 diff --git a/src/test/Stack/Ghci/ScriptSpec.hs b/src/test/Stack/Ghci/ScriptSpec.hs index 43b9fbad8a..b80e6adbd9 100644 --- a/src/test/Stack/Ghci/ScriptSpec.hs +++ b/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 diff --git a/src/test/Stack/GhciSpec.hs b/src/test/Stack/GhciSpec.hs index dc9241315a..a87781bcce 100644 --- a/src/test/Stack/GhciSpec.hs +++ b/src/test/Stack/GhciSpec.hs @@ -18,19 +18,22 @@ 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 -projDirA, projDirB :: Path Abs Dir -projDirA = $(mkAbsDir "/Users/someone/src/project-a") -projDirB = $(mkAbsDir "/Users/someone/src/project-b") +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/Main.hs") +relFile = $(mkRelFile $ "exe" FP. "Main.hs") absFile :: Path Abs File absFile = projDirA relFile diff --git a/stack.cabal b/stack.cabal index 00a7baf183..222b838592 100644 --- a/stack.cabal +++ b/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 From 2a3ba2b0543da2ad5544e15867f037e0d2a06ac9 Mon Sep 17 00:00:00 2001 From: "Paolo G. Giarrusso" Date: Fri, 12 Aug 2016 15:49:37 +0200 Subject: [PATCH 4/4] Fix line ends mismatches in testsuite Note the issue is not triggered on AppVeyor, but it is triggered when checking files out on Windows using recommended Git settings (Windows newlines). Workaround for https://github.com/nikita-volkov/neat-interpolation/issues/14, no more necessary if that bug is fixed. This defines a variant of shouldBe; while at it, also integrate needed string type conversions. --- src/test/Stack/GhciSpec.hs | 23 +++++++++++++++-------- 1 file changed, 15 insertions(+), 8 deletions(-) diff --git a/src/test/Stack/GhciSpec.hs b/src/test/Stack/GhciSpec.hs index a87781bcce..b5cc741d2b 100644 --- a/src/test/Stack/GhciSpec.hs +++ b/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 @@ -27,6 +28,12 @@ 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") @@ -51,40 +58,40 @@ spec = do describe "should render GHCi scripts" $ do it "with one library package" $ do let res = scriptToLazyByteString $ renderScriptGhci packages_singlePackage Nothing - res `shouldBe` textToLazy ghciScript_projectWithLib + res `shouldBeLE` ghciScript_projectWithLib it "with one main package" $ do let res = scriptToLazyByteString $ renderScriptGhci [] (Just absFile) - res `shouldBe` textToLazy ghciScript_projectWithMain + res `shouldBeLE` ghciScript_projectWithMain it "with one library and main package" $ do let res = scriptToLazyByteString $ renderScriptGhci packages_singlePackage (Just absFile) - res `shouldBe` textToLazy ghciScript_projectWithLibAndMain + res `shouldBeLE` ghciScript_projectWithLibAndMain it "with multiple library packages" $ do let res = scriptToLazyByteString $ renderScriptGhci packages_multiplePackages Nothing - res `shouldBe` textToLazy 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` textToLazy interoScript_projectWithLib + res `shouldBeLE` interoScript_projectWithLib it "with one main package" $ do let res = scriptToLazyByteString $ renderScriptIntero packages_singlePackage (Just absFile) - res `shouldBe` textToLazy interoScript_projectWithMain + res `shouldBeLE` interoScript_projectWithMain it "with one library and main package" $ do let res = scriptToLazyByteString $ renderScriptIntero packages_singlePackage (Just absFile) - res `shouldBe` textToLazy interoScript_projectWithLibAndMain + res `shouldBeLE` interoScript_projectWithLibAndMain it "with multiple library packages" $ do let res = scriptToLazyByteString $ renderScriptIntero packages_multiplePackages Nothing - res `shouldBe` textToLazy interoScript_multipleProjectsWithLib + res `shouldBeLE` interoScript_multipleProjectsWithLib -- Exptected Intero scripts