diff --git a/.gitignore b/.gitignore index 150b05c88..d72d73737 100644 --- a/.gitignore +++ b/.gitignore @@ -1,7 +1,7 @@ dist/ dist-newstyle/ .stack-work/ -stack.yaml -stack.yaml.lock +tests/projects/**/stack*.yaml +tests/projects/**/stack*.yaml.lock cabal.project.local* .vscode/ diff --git a/README.md b/README.md index 741565879..1a6ed7d6f 100644 --- a/README.md +++ b/README.md @@ -73,6 +73,16 @@ cradle: This configuration suffices if your whole project can be loaded by the command `stack repl`. As a rule of thumb, this works if the project consists of only one executable, one library and one test-suite. +Some projects have multiple `stack-*.yaml` files for multiple versions of ghc/resolvers. In this case you +can specify an alternate relative file to use by using the `stackYaml` option. The path is relative to the +configuration file. + +```yaml +cradle: + stack: + stackYaml: "./stack-8.8.3.yaml" +``` + If your project is more complicated, you need to specify which [components](https://docs.haskellstack.org/en/stable/build_command/#components) you want to load. A component is, roughly speaking, a library/executable/test-suite or benchmark in `stack`. You can view the components/targets of a stack project by executing the command: ``` sh $ stack ide targets @@ -126,6 +136,26 @@ Here you can see two important features: This way we specified which component needs to be compiled given a source file for our whole project. +If you use both, multiple components and an alternate `stack.yaml` file, there is a way to specify defaults +for the path-specific configurations. + +```yaml +cradle: + stack: + stackYaml: "stack-8.3.3.yaml" + components: + - path: "./src" + component: "hie-bios:lib" + - path: "./exe" + component: "hie-bios:exe:hie-bios" + - path: "./tests/BiosTests.hs" + component: "hie-bios:test:hie-bios" + - path: "./tests/ParserTests.hs" + component: "hie-bios:test:parser-tests" +``` + +A word of warning: Due to current restrictions in the language server, as mentioned in [this bug report](https://github.com/haskell/haskell-language-server/issues/268#issuecomment-667640809) all referenced stack.yaml files must specify the same version of GHC, as only one version of ghcide is loaded at a time per workspace root. This restriction might be lifted in the future. + #### Debugging a `stack` cradle If you find that `hie-bios` can't load a certain component or file, run `stack repl` and `stack repl ` to see if `stack` succeeds in building your project. Chances are that there is a problem in your project and if you fix that, `hie-bios` will succeed to load it. @@ -267,6 +297,25 @@ Here you can see two important features: * The filepath can be a file. * This is convenient if components are overlapping. +Similarly to `multi-stack` configurations, you can also specify multiple components using a `components` subkey. +While this is currently not used for anything, this syntax gives you a place to put defaults, directly under +the `cabal` entry. + +```yaml +cradle: + cabal: + # Reserved for future default options + components: + - path: "./src" + component: "lib:hie-bios" + - path: "./exe" + component: "exe:hie-bios" + - path: "./tests/BiosTests.hs" + component: "test:hie-bios" + - path: "./tests/ParserTests.hs" + component: "test:parser-tests" +``` + This way we specified which component needs to be compiled given a certain source file for our whole project. #### Debugging a `cabal` cradle diff --git a/hie-bios.cabal b/hie-bios.cabal index f632df98d..c1b279716 100644 --- a/hie-bios.cabal +++ b/hie-bios.cabal @@ -31,12 +31,16 @@ Extra-Source-Files: ChangeLog.md tests/configs/direct.yaml tests/configs/multi.yaml tests/configs/multi-ch.yaml + tests/configs/multi-stack-with-yaml.yaml + tests/configs/keys-not-unique-fails.yaml tests/configs/nested-cabal-multi.yaml tests/configs/nested-stack-multi.yaml tests/configs/none.yaml tests/configs/obelisk.yaml tests/configs/stack-config.yaml tests/configs/stack-multi.yaml + tests/configs/stack-with-both.yaml + tests/configs/stack-with-yaml.yaml tests/projects/symlink-test/a/A.hs tests/projects/symlink-test/hie.yaml tests/projects/multi-direct/A.hs @@ -145,7 +149,18 @@ Extra-Source-Files: ChangeLog.md tests/projects/implicit-stack-multi/other-package/Setup.hs tests/projects/implicit-stack-multi/other-package/other-package.cabal tests/projects/implicit-stack-multi/other-package/Main.hs - + tests/projects/multi-stack-with-yaml/appA/Setup.hs + tests/projects/multi-stack-with-yaml/appA/appA.cabal + tests/projects/multi-stack-with-yaml/appA/src/Lib.hs + tests/projects/multi-stack-with-yaml/appB/Setup.hs + tests/projects/multi-stack-with-yaml/appB/appB.cabal + tests/projects/multi-stack-with-yaml/appB/src/Lib.hs + tests/projects/multi-stack-with-yaml/hie.yaml + tests/projects/stack-with-yaml/Setup.hs + tests/projects/stack-with-yaml/app/Main.hs + tests/projects/stack-with-yaml/hie.yaml + tests/projects/stack-with-yaml/stack-with-yaml.cabal + tests/projects/stack-with-yaml/src/Lib.hs tested-with: GHC==8.10.1, GHC==8.8.3, GHC==8.6.5, GHC==8.4.4 @@ -216,6 +231,7 @@ test-suite parser-tests base, filepath, hie-bios, + hspec-expectations, tasty, tasty-hunit, text, diff --git a/src/HIE/Bios/Config.hs b/src/HIE/Bios/Config.hs index 84c6e8e3a..995d7b6d6 100644 --- a/src/HIE/Bios/Config.hs +++ b/src/HIE/Bios/Config.hs @@ -2,20 +2,46 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE LambdaCase #-} -- | Logic and datatypes for parsing @hie.yaml@ files. module HIE.Bios.Config( readConfig, Config(..), CradleConfig(..), + CabalType, + pattern CabalType, + cabalComponent, + StackType, + pattern StackType, + stackComponent, + stackYaml, CradleType(..), Callable(..) ) where +import Control.Exception import qualified Data.Text as T import qualified Data.Vector as V import qualified Data.HashMap.Strict as Map +import Data.Maybe (mapMaybe) +import Data.Semigroup import Data.Foldable (foldrM) +import Data.Aeson (JSONPath) import Data.Yaml +import Data.Yaml.Internal (Warning(..)) + +type MLast a = Maybe (Last a) + +viewLast :: MLast a -> Maybe a +viewLast (Just l) = Just $ getLast l +viewLast Nothing = Nothing + +pattern MLast :: Maybe a -> MLast a +pattern MLast m <- (viewLast -> m) where + MLast (Just l) = Just $ Last l + MLast Nothing = Nothing -- | Configuration that can be used to load a 'Cradle'. -- A configuration has roughly the following form: @@ -43,11 +69,45 @@ data CradleConfig a = data Callable = Program FilePath | Command String deriving (Show, Eq) +data CabalType + = CabalType_ { _cabalComponent :: !(MLast String) } + deriving (Eq) + +instance Semigroup CabalType where + CabalType_ cr <> CabalType_ cl = CabalType_ (cr <> cl) + +instance Monoid CabalType where + mempty = CabalType_ mempty + +pattern CabalType :: Maybe String -> CabalType +pattern CabalType { cabalComponent } = CabalType_ (MLast cabalComponent) +{-# COMPLETE CabalType #-} + +instance Show CabalType where + show = show . Cabal + +data StackType + = StackType_ { _stackComponent :: !(MLast String) , _stackYaml :: !(MLast String) } + deriving (Eq) + +instance Semigroup StackType where + StackType_ cr yr <> StackType_ cl yl = StackType_ (cr <> cl) (yr <> yl) + +instance Monoid StackType where + mempty = StackType_ mempty mempty + +pattern StackType :: Maybe String -> Maybe String -> StackType +pattern StackType { stackComponent, stackYaml } = StackType_ (MLast stackComponent) (MLast stackYaml) +{-# COMPLETE StackType #-} + +instance Show StackType where + show = show . Stack + data CradleType a - = Cabal { component :: Maybe String } - | CabalMulti [ (FilePath, String) ] - | Stack { component :: Maybe String } - | StackMulti [ (FilePath, String) ] + = Cabal { cabalType :: !CabalType } + | CabalMulti { defaultCabal :: !CabalType, subCabalComponents :: [ (FilePath, CabalType) ] } + | Stack { stackType :: !StackType } + | StackMulti { defaultStack :: !StackType, subStackComponents :: [ (FilePath, StackType) ] } -- Bazel and Obelisk used to be supported but bit-rotted and no users have complained. -- They can be added back if a user -- | Bazel @@ -73,10 +133,10 @@ instance FromJSON a => FromJSON (CradleType a) where parseJSON _ = fail "Not a known cradle type. Possible are: cabal, stack, bios, direct, default, none, multi" instance Show (CradleType a) where - show (Cabal comp) = "Cabal {component = " ++ show comp ++ "}" - show (CabalMulti a) = "CabalMulti " ++ show a - show (Stack comp) = "Stack {component = " ++ show comp ++ "}" - show (StackMulti a) = "StackMulti " ++ show a + show (Cabal comp) = "Cabal {component = " ++ show (cabalComponent comp) ++ "}" + show (CabalMulti d a) = "CabalMulti {defaultCabal = " ++ show d ++ ", subCabalComponents = " ++ show a ++ "}" + show (Stack comp) = "Stack {component = " ++ show (stackComponent comp) ++ ", stackYaml = " ++ show (stackYaml comp) ++ "}" + show (StackMulti d a) = "StackMulti {defaultStack = " ++ show d ++ ", subStackComponents = " ++ show a ++ "}" show Bios { call, depsCall } = "Bios {call = " ++ show call ++ ", depsCall = " ++ show depsCall ++ "}" show (Direct args) = "Direct {arguments = " ++ show args ++ "}" show None = "None" @@ -96,38 +156,61 @@ parseCradleType o | Just val <- Map.lookup "other" o = Other <$> parseJSON val <*> pure val parseCradleType o = fail $ "Unknown cradle type: " ++ show o -parseStackOrCabal - :: (Maybe String -> CradleType a) - -> ([(FilePath, String)] -> CradleType a) +parseSingleOrMultiple + :: Monoid x + => (x -> CradleType a) + -> (x -> [(FilePath, x)] -> CradleType a) + -> (Map.HashMap T.Text Value -> Parser x) -> Value -> Parser (CradleType a) -parseStackOrCabal singleConstructor _ (Object x) - | Map.size x == 1, Just (String stackComponent) <- Map.lookup "component" x - = return $ singleConstructor $ Just $ T.unpack stackComponent - | Map.null x - = return $ singleConstructor Nothing - | otherwise - = fail "Not a valid Configuration type, following keys are allowed: component" -parseStackOrCabal _ multiConstructor (Array x) = do - let parseOne e +parseSingleOrMultiple single multiple parse = doParse where + parseOne e | Object v <- e , Just (String prefix) <- Map.lookup "path" v - , Just (String comp) <- Map.lookup "component" v - , Map.size v == 2 - = return (T.unpack prefix, T.unpack comp) + = (T.unpack prefix,) <$> parse (Map.delete "path" v) | otherwise - = fail "Expected an object with path and component keys" - - xs <- foldrM (\v cs -> (: cs) <$> parseOne v) [] x - return $ multiConstructor xs -parseStackOrCabal singleConstructor _ Null = return $ singleConstructor Nothing -parseStackOrCabal _ _ _ = fail "Configuration is expected to be an object." + = fail "Expected an object with a path key" + parseArray = foldrM (\v cs -> (: cs) <$> parseOne v) [] + doParse (Object v) + | Just (Array x) <- Map.lookup "components" v + = do + d <- parse (Map.delete "components" v) + xs <- parseArray x + return $ multiple d xs + | Just _ <- Map.lookup "components" v + = fail "Expected components to be an array of subcomponents" + | Nothing <- Map.lookup "components" v + = single <$> parse v + doParse (Array x) + = do + xs <- parseArray x + return $ multiple mempty xs + doParse Null = single <$> parse Map.empty + doParse _ = fail "Configuration is expected to be an object or an array of objects." parseStack :: Value -> Parser (CradleType a) -parseStack = parseStackOrCabal Stack StackMulti +parseStack = parseSingleOrMultiple Stack StackMulti $ + \case x | Map.size x == 2 + , Just (String component) <- Map.lookup "component" x + , Just (String syaml) <- Map.lookup "stackYaml" x + -> return $ StackType (Just $ T.unpack component) (Just $ T.unpack syaml) + | Map.size x == 1, Just (String component) <- Map.lookup "component" x + -> return $ StackType (Just $ T.unpack component) Nothing + | Map.size x == 1, Just (String syaml) <- Map.lookup "stackYaml" x + -> return $ StackType Nothing (Just $ T.unpack syaml) + | Map.null x + -> return $ StackType Nothing Nothing + | otherwise + -> fail "Not a valid Stack configuration, following keys are allowed: component, stackYaml" parseCabal :: Value -> Parser (CradleType a) -parseCabal = parseStackOrCabal Cabal CabalMulti +parseCabal = parseSingleOrMultiple Cabal CabalMulti $ + \case x | Map.size x == 1, Just (String component) <- Map.lookup "component" x + -> return $ CabalType (Just $ T.unpack component) + | Map.null x + -> return $ CabalType Nothing + | otherwise + -> fail "Not a valid Cabal configuration, following keys are allowed: component" parseBios :: Value -> Parser (CradleType a) parseBios (Object x) = @@ -206,4 +289,17 @@ instance FromJSON a => FromJSON (Config a) where -- If the contents of the file is not a valid 'Config a', -- an 'Control.Exception.IOException' is thrown. readConfig :: FromJSON a => FilePath -> IO (Config a) -readConfig = decodeFileThrow \ No newline at end of file +readConfig fp = do + result <- decodeFileWithWarnings fp + either throwIO failOnAnyDuplicate result + where + failOnAnyDuplicate :: ([Warning], Config a) -> IO (Config a) + failOnAnyDuplicate (warnings, config) = do + _ <- case mapMaybe failOnDuplicate warnings of + dups@(_:_) -> throwIO $ InvalidYaml $ Just $ YamlException + $ "Duplicate keys are not allowed, found: " ++ show dups + _ -> return () + return config + -- future proofing in case more warnings are added + failOnDuplicate :: Warning -> Maybe JSONPath + failOnDuplicate (DuplicateKey a) = Just a diff --git a/src/HIE/Bios/Cradle.hs b/src/HIE/Bios/Cradle.hs index b6558a0a6..ff9bee5f5 100644 --- a/src/HIE/Bios/Cradle.hs +++ b/src/HIE/Bios/Cradle.hs @@ -55,6 +55,7 @@ import qualified Data.Conduit.Combinators as C import qualified Data.Conduit as C import qualified Data.Conduit.Text as C import qualified Data.Text as T +import qualified Data.HashMap.Strict as Map import Data.Maybe (fromMaybe, maybeToList) import GHC.Fingerprint (fingerprintString) @@ -93,17 +94,17 @@ loadCradleWithOpts _copts buildCustomCradle wfile = do getCradle :: (b -> Cradle a) -> (CradleConfig b, FilePath) -> Cradle a getCradle buildCustomCradle (cc, wdir) = addCradleDeps cradleDeps $ case cradleType cc of - Cabal mc -> cabalCradle wdir mc - CabalMulti ms -> + Cabal CabalType{ cabalComponent = mc } -> cabalCradle wdir mc + CabalMulti dc ms -> getCradle buildCustomCradle $ (CradleConfig cradleDeps - (Multi [(p, CradleConfig [] (Cabal (Just c))) | (p, c) <- ms]) + (Multi [(p, CradleConfig [] (Cabal $ dc <> c)) | (p, c) <- ms]) , wdir) - Stack mc -> stackCradle wdir mc - StackMulti ms -> + Stack StackType{ stackComponent = mc, stackYaml = syaml} -> stackCradle wdir mc (fromMaybe "stack.yaml" syaml) + StackMulti ds ms -> getCradle buildCustomCradle $ (CradleConfig cradleDeps - (Multi [(p, CradleConfig [] (Stack (Just c))) | (p, c) <- ms]) + (Multi [(p, CradleConfig [] (Stack $ ds <> c)) | (p, c) <- ms]) , wdir) -- Bazel -> rulesHaskellCradle wdir -- Obelisk -> obeliskCradle wdir @@ -143,8 +144,8 @@ implicitConfig' fp = (\wdir -> (Bios (Program $ wdir ".hie-bios") Nothing Nothing, wdir)) <$> biosWorkDir fp -- <|> (Obelisk,) <$> obeliskWorkDir fp -- <|> (Bazel,) <$> rulesHaskellWorkDir fp - <|> (stackExecutable >> (Stack Nothing,) <$> stackWorkDir fp) - <|> ((Cabal Nothing,) <$> cabalWorkDir fp) + <|> (stackExecutable >> (Stack $ StackType Nothing Nothing,) <$> stackWorkDir fp) + <|> ((Cabal $ CabalType Nothing,) <$> cabalWorkDir fp) yamlConfig :: FilePath -> MaybeT IO FilePath @@ -553,16 +554,16 @@ cabalWorkDir wdir = ------------------------------------------------------------------------ -- | Stack Cradle -- Works for by invoking `stack repl` with a wrapper script -stackCradle :: FilePath -> Maybe String -> Cradle a -stackCradle wdir mc = +stackCradle :: FilePath -> Maybe String -> FilePath -> Cradle a +stackCradle wdir mc syaml = Cradle { cradleRootDir = wdir , cradleOptsProg = CradleAction { actionName = Types.Stack - , runCradle = stackAction wdir mc + , runCradle = stackAction wdir mc syaml , runGhcCmd = \args -> readProcessWithCwd - wdir "stack" (["exec", "--silent", "ghc", "--"] <> args) "" + wdir "stack" (["--stack-yaml", syaml, "exec", "--silent", "ghc", "--"] <> args) "" } } @@ -575,32 +576,32 @@ stackCradle wdir mc = -- a '.cabal' file. -- -- Found dependencies are relative to 'rootDir'. -stackCradleDependencies :: FilePath -> FilePath -> IO [FilePath] -stackCradleDependencies wdir componentDir = do +stackCradleDependencies :: FilePath -> FilePath -> FilePath -> IO [FilePath] +stackCradleDependencies wdir componentDir syaml = do let relFp = makeRelative wdir componentDir cabalFiles' <- findCabalFiles componentDir let cabalFiles = map (relFp ) cabalFiles' - return $ map normalise $ cabalFiles ++ [relFp "package.yaml", "stack.yaml"] + return $ map normalise $ cabalFiles ++ [relFp "package.yaml", syaml] -stackAction :: FilePath -> Maybe String -> LoggingFunction -> FilePath -> IO (CradleLoadResult ComponentOptions) -stackAction work_dir mc l _fp = do - let ghcProcArgs = ("stack", ["exec", "ghc", "--"]) +stackAction :: FilePath -> Maybe String -> FilePath -> LoggingFunction -> FilePath -> IO (CradleLoadResult ComponentOptions) +stackAction work_dir mc syaml l _fp = do + let ghcProcArgs = ("stack", ["--stack-yaml", syaml, "exec", "ghc", "--"]) -- Same wrapper works as with cabal withCabalWrapperTool ghcProcArgs work_dir $ \wrapper_fp -> do (ex1, _stdo, stde, args) <- readProcessWithOutputFile l work_dir $ - proc "stack" $ ["repl", "--no-nix-pure", "--with-ghc", wrapper_fp] + proc "stack" $ ["--stack-yaml", syaml, "repl", "--no-nix-pure", "--with-ghc", wrapper_fp] ++ [ comp | Just comp <- [mc] ] (ex2, pkg_args, stdr, _) <- readProcessWithOutputFile l work_dir $ - proc "stack" ["path", "--ghc-package-path"] + proc "stack" ["--stack-yaml", syaml, "path", "--ghc-package-path"] let split_pkgs = concatMap splitSearchPath pkg_args pkg_ghc_args = concatMap (\p -> ["-package-db", p] ) split_pkgs case processCabalWrapperArgs args of Nothing -> do -- Best effort. Assume the working directory is the -- the root of the component, so we are right in trivial cases at least. - deps <- stackCradleDependencies work_dir work_dir + deps <- stackCradleDependencies work_dir work_dir syaml pure $ CradleFail (CradleError deps ex1 $ [ "Failed to parse result of calling stack" ] @@ -609,7 +610,7 @@ stackAction work_dir mc l _fp = do ) Just (componentDir, ghc_args) -> do - deps <- stackCradleDependencies work_dir componentDir + deps <- stackCradleDependencies work_dir componentDir syaml pure $ makeCradleResult ( combineExitCodes [ex1, ex2] , stde ++ stdr, componentDir @@ -736,6 +737,14 @@ findFile p dir = do getFiles = filter p <$> getDirectoryContents dir doesPredFileExist file = doesFileExist $ dir file +-- Some environments (e.g. stack exec) include GHC_PACKAGE_PATH. +-- Cabal v2 *will* complain, even though or precisely because it ignores them +-- Unset them from the environment to sidestep this +getCleanEnvironment :: IO [(String, String)] +getCleanEnvironment = do + e <- getEnvironment + return $ Map.toList $ Map.delete "GHC_PACKAGE_PATH" $ Map.fromList e + -- | Call a given process. -- * A special file is created for the process to write to, the process can discover the name of -- the file by reading the @HIE_BIOS_OUTPUT@ environment variable. The contents of this file is @@ -749,7 +758,7 @@ readProcessWithOutputFile -> CreateProcess -- ^ Parameters for the process to be executed. -> IO (ExitCode, [String], [String], [String]) readProcessWithOutputFile l work_dir cp = do - old_env <- getEnvironment + old_env <- getCleanEnvironment withHieBiosOutput old_env $ \output_file -> do -- Pipe stdout directly into the logger @@ -797,7 +806,8 @@ runGhcCmdOnPath wdir args = readProcessWithCwd wdir "ghc" args "" -- | Wrapper around 'readCreateProcess' that sets the working directory readProcessWithCwd :: FilePath -> FilePath -> [String] -> String -> IO (CradleLoadResult String) readProcessWithCwd dir cmd args stdi = do - let createProc = (proc cmd args) { cwd = Just dir } + cleanEnv <- getCleanEnvironment + let createProc = (proc cmd args) { cwd = Just dir, env = Just cleanEnv } mResult <- optional $ readCreateProcessWithExitCode createProc stdi case mResult of Just (ExitSuccess, stdo, _) -> pure $ CradleSuccess stdo diff --git a/tests/BiosTests.hs b/tests/BiosTests.hs index 0e8093c71..99a53d6da 100644 --- a/tests/BiosTests.hs +++ b/tests/BiosTests.hs @@ -144,6 +144,12 @@ main = do , testCaseSteps "nested-stack2" $ testLoadCradleDependencies isStackCradle "./tests/projects/nested-stack" "MyLib.hs" (\deps -> deps `shouldMatchList` ["nested-stack.cabal", "package.yaml", "stack.yaml"] ) + , testCaseSteps "stack-with-yaml" {- tests if both components can be loaded -} + $ testDirectory isStackCradle "./tests/projects/stack-with-yaml" "app/Main.hs" + >> testDirectory isStackCradle "./tests/projects/stack-with-yaml" "src/Lib.hs" + , testCaseSteps "multi-stack-with-yaml" {- tests if both components can be loaded -} + $ testDirectory isStackCradle "./tests/projects/multi-stack-with-yaml" "appA/src/Lib.hs" + >> testDirectory isStackCradle "./tests/projects/multi-stack-with-yaml" "appB/src/Lib.hs" , -- Test for special characters in the path for parsing of the ghci-scripts. -- Issue https://github.com/mpickering/hie-bios/issues/162 @@ -338,18 +344,21 @@ copyDir src dst = do writeStackYamlFiles :: IO () writeStackYamlFiles = - forM_ stackProjects $ \(proj, pkgs) -> - writeFile (proj "stack.yaml") (stackYaml stackYamlResolver pkgs) + forM_ stackProjects $ \(proj, syaml, pkgs) -> + writeFile (proj syaml) (stackYaml stackYamlResolver pkgs) -stackProjects :: [(FilePath, [FilePath])] +stackProjects :: [(FilePath, FilePath, [FilePath])] stackProjects = - [ ("tests" "projects" "multi-stack", ["."]) - , ("tests" "projects" "failing-stack", ["."]) - , ("tests" "projects" "simple-stack", ["."]) - , ("tests" "projects" "nested-stack", [".", "./sub-comp"]) - , ("tests" "projects" "space stack", ["."]) - , ("tests" "projects" "implicit-stack", ["."]) - , ("tests" "projects" "implicit-stack-multi", ["."]) + [ ("tests" "projects" "multi-stack", "stack.yaml", ["."]) + , ("tests" "projects" "failing-stack", "stack.yaml", ["."]) + , ("tests" "projects" "simple-stack", "stack.yaml", ["."]) + , ("tests" "projects" "nested-stack", "stack.yaml", [".", "./sub-comp"]) + , ("tests" "projects" "space stack", "stack.yaml", ["."]) + , ("tests" "projects" "implicit-stack", "stack.yaml", ["."]) + , ("tests" "projects" "implicit-stack-multi", "stack.yaml", ["."]) + , ("tests" "projects" "implicit-stack-multi", "stack.yaml", ["."]) + , ("tests" "projects" "multi-stack-with-yaml", "stack-alt.yaml", ["appA", "appB"]) + , ("tests" "projects" "stack-with-yaml", "stack-alt.yaml", ["."]) ] stackYaml :: String -> [FilePath] -> String diff --git a/tests/ParserTests.hs b/tests/ParserTests.hs index a31eac57c..f4f60f73d 100644 --- a/tests/ParserTests.hs +++ b/tests/ParserTests.hs @@ -1,6 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} module Main where +import Test.Hspec.Expectations import Test.Tasty import Test.Tasty.HUnit import HIE.Bios.Config @@ -10,6 +11,7 @@ import Data.Yaml import qualified Data.Text as T import System.FilePath import Control.Applicative ( (<|>) ) +import Control.Exception configDir :: FilePath configDir = "tests/configs" @@ -17,36 +19,48 @@ configDir = "tests/configs" main :: IO () main = defaultMain $ testCase "Parser Tests" $ do - assertParser "cabal-1.yaml" (noDeps (Cabal (Just "lib:hie-bios"))) - assertParser "stack-config.yaml" (noDeps (Stack Nothing)) + assertParser "cabal-1.yaml" (noDeps (Cabal $ CabalType (Just "lib:hie-bios"))) + assertParser "stack-config.yaml" (noDeps (Stack $ StackType Nothing Nothing)) --assertParser "bazel.yaml" (noDeps Bazel) assertParser "bios-1.yaml" (noDeps (Bios (Program "program") Nothing Nothing)) assertParser "bios-2.yaml" (noDeps (Bios (Program "program") (Just (Program "dep-program")) Nothing)) assertParser "bios-3.yaml" (noDeps (Bios (Command "shellcommand") Nothing Nothing)) assertParser "bios-4.yaml" (noDeps (Bios (Command "shellcommand") (Just (Command "dep-shellcommand")) Nothing)) assertParser "bios-5.yaml" (noDeps (Bios (Command "shellcommand") (Just (Program "dep-program")) Nothing)) - assertParser "dependencies.yaml" (Config (CradleConfig ["depFile"] (Cabal (Just "lib:hie-bios")))) + assertParser "dependencies.yaml" (Config (CradleConfig ["depFile"] (Cabal $ CabalType (Just "lib:hie-bios")))) assertParser "direct.yaml" (noDeps (Direct ["list", "of", "arguments"])) assertParser "none.yaml" (noDeps None) --assertParser "obelisk.yaml" (noDeps Obelisk) - assertParser "multi.yaml" (noDeps (Multi [("./src", CradleConfig [] (Cabal (Just "lib:hie-bios"))) - , ("./test", CradleConfig [] (Cabal (Just "test")) ) ])) + assertParser "multi.yaml" (noDeps (Multi [("./src", CradleConfig [] (Cabal $ CabalType (Just "lib:hie-bios"))) + ,("./test", CradleConfig [] (Cabal $ CabalType (Just "test")) ) ])) - assertParser "cabal-multi.yaml" (noDeps (CabalMulti [("./src", "lib:hie-bios") - ,("./", "lib:hie-bios")])) + assertParser "cabal-multi.yaml" (noDeps (CabalMulti (CabalType Nothing) + [("./src", CabalType $ Just "lib:hie-bios") + ,("./", CabalType $ Just "lib:hie-bios")])) - assertParser "stack-multi.yaml" (noDeps (StackMulti [("./src", "lib:hie-bios") - ,("./", "lib:hie-bios")])) + assertParser "stack-multi.yaml" (noDeps (StackMulti (StackType Nothing Nothing) + [("./src", StackType (Just "lib:hie-bios") Nothing) + ,("./", StackType (Just"lib:hie-bios") Nothing)])) assertParser "nested-cabal-multi.yaml" (noDeps (Multi [("./test/testdata", CradleConfig [] None) ,("./", CradleConfig [] ( - CabalMulti [("./src", "lib:hie-bios") - ,("./tests", "parser-tests")]))])) + CabalMulti (CabalType Nothing) + [("./src", CabalType $ Just "lib:hie-bios") + ,("./tests", CabalType $ Just "parser-tests")]))])) assertParser "nested-stack-multi.yaml" (noDeps (Multi [("./test/testdata", CradleConfig [] None) ,("./", CradleConfig [] ( - StackMulti [("./src", "lib:hie-bios") - ,("./tests", "parser-tests")]))])) + StackMulti (StackType Nothing Nothing) + [("./src", StackType (Just "lib:hie-bios") Nothing) + ,("./tests", StackType (Just "parser-tests") Nothing)]))])) + assertParser "stack-with-yaml.yaml" + (noDeps (Stack $ StackType Nothing (Just "stack-8.8.3.yaml"))) + assertParser "stack-with-both.yaml" + (noDeps (Stack $ StackType (Just "hie-bios:hie") (Just "stack-8.8.3.yaml"))) + assertParser "multi-stack-with-yaml.yaml" + (noDeps (StackMulti (StackType Nothing (Just "stack-8.8.3.yaml")) + [("./src", StackType (Just "lib:hie-bios") Nothing) + ,("./vendor", StackType (Just "parser-tests") Nothing)])) assertCustomParser "ch-cabal.yaml" (noDeps (Other CabalHelperCabal $ simpleCabalHelperYaml "cabal")) @@ -56,9 +70,10 @@ main = defaultMain $ (noDeps (Multi [ ("./src", CradleConfig [] (Other CabalHelperStack $ simpleCabalHelperYaml "stack")) , ("./input", CradleConfig [] (Other CabalHelperCabal $ simpleCabalHelperYaml "cabal")) - , ("./test", CradleConfig [] (Cabal (Just "test"))) + , ("./test", CradleConfig [] (Cabal $ CabalType (Just "test"))) , (".", CradleConfig [] None) ])) + assertParserFails "keys-not-unique-fails.yaml" invalidYamlException assertParser :: FilePath -> Config Void -> Assertion assertParser fp cc = do @@ -67,6 +82,13 @@ assertParser fp cc = do , "Expected: " ++ show cc , "Actual: " ++ show conf ]) +invalidYamlException :: Selector ParseException +invalidYamlException (InvalidYaml (Just _)) = True +invalidYamlException _ = False + +assertParserFails :: Exception e => FilePath -> Selector e -> Assertion +assertParserFails fp es = (readConfig (configDir fp) :: IO (Config Void)) `shouldThrow` es + assertCustomParser :: FilePath -> Config CabalHelper -> Assertion assertCustomParser fp cc = do conf <- readConfig (configDir fp) diff --git a/tests/configs/keys-not-unique-fails.yaml b/tests/configs/keys-not-unique-fails.yaml new file mode 100644 index 000000000..7a99aa23b --- /dev/null +++ b/tests/configs/keys-not-unique-fails.yaml @@ -0,0 +1,12 @@ +cradle: + cabal: + components: + - path: "./src" + component: "lib:hie-bios" + - path: "./" + component: "lib:hie-bios" + components: + - path: "./src" + component: "exe:hie-bios" + - path: "./" + component: "exe:hie-bios" diff --git a/tests/configs/multi-stack-with-yaml.yaml b/tests/configs/multi-stack-with-yaml.yaml new file mode 100644 index 000000000..8c83efbef --- /dev/null +++ b/tests/configs/multi-stack-with-yaml.yaml @@ -0,0 +1,8 @@ +cradle: + stack: + stackYaml: "stack-8.8.3.yaml" + components: + - path: "./src" + component: "lib:hie-bios" + - path: "./vendor" + component: "parser-tests" diff --git a/tests/configs/stack-with-both.yaml b/tests/configs/stack-with-both.yaml new file mode 100644 index 000000000..202d67661 --- /dev/null +++ b/tests/configs/stack-with-both.yaml @@ -0,0 +1,4 @@ +cradle: + stack: + stackYaml: "stack-8.8.3.yaml" + component: "hie-bios:hie" diff --git a/tests/configs/stack-with-yaml.yaml b/tests/configs/stack-with-yaml.yaml new file mode 100644 index 000000000..8155c9fa3 --- /dev/null +++ b/tests/configs/stack-with-yaml.yaml @@ -0,0 +1,3 @@ +cradle: + stack: + stackYaml: "stack-8.8.3.yaml" diff --git a/tests/projects/multi-stack-with-yaml/appA/Setup.hs b/tests/projects/multi-stack-with-yaml/appA/Setup.hs new file mode 100644 index 000000000..9a994af67 --- /dev/null +++ b/tests/projects/multi-stack-with-yaml/appA/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/tests/projects/multi-stack-with-yaml/appA/appA.cabal b/tests/projects/multi-stack-with-yaml/appA/appA.cabal new file mode 100644 index 000000000..edc2ea3bf --- /dev/null +++ b/tests/projects/multi-stack-with-yaml/appA/appA.cabal @@ -0,0 +1,12 @@ +cabal-version: >=2.0 +name: appA +version: 0.1.0.0 +build-type: Simple + +library + exposed-modules: Lib + -- other-modules: + -- other-extensions: + build-depends: base >=4.10 && < 5, filepath + hs-source-dirs: src + default-language: Haskell2010 diff --git a/tests/projects/multi-stack-with-yaml/appA/src/Lib.hs b/tests/projects/multi-stack-with-yaml/appA/src/Lib.hs new file mode 100644 index 000000000..6d85a26fe --- /dev/null +++ b/tests/projects/multi-stack-with-yaml/appA/src/Lib.hs @@ -0,0 +1 @@ +module Lib where diff --git a/tests/projects/multi-stack-with-yaml/appB/Setup.hs b/tests/projects/multi-stack-with-yaml/appB/Setup.hs new file mode 100644 index 000000000..9a994af67 --- /dev/null +++ b/tests/projects/multi-stack-with-yaml/appB/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/tests/projects/multi-stack-with-yaml/appB/appB.cabal b/tests/projects/multi-stack-with-yaml/appB/appB.cabal new file mode 100644 index 000000000..e9b261c94 --- /dev/null +++ b/tests/projects/multi-stack-with-yaml/appB/appB.cabal @@ -0,0 +1,12 @@ +cabal-version: >=2.0 +name: appB +version: 0.1.0.0 +build-type: Simple + +library + exposed-modules: Lib + -- other-modules: + -- other-extensions: + build-depends: base >=4.10 && < 5, filepath + hs-source-dirs: src + default-language: Haskell2010 diff --git a/tests/projects/multi-stack-with-yaml/appB/src/Lib.hs b/tests/projects/multi-stack-with-yaml/appB/src/Lib.hs new file mode 100644 index 000000000..6d85a26fe --- /dev/null +++ b/tests/projects/multi-stack-with-yaml/appB/src/Lib.hs @@ -0,0 +1 @@ +module Lib where diff --git a/tests/projects/multi-stack-with-yaml/hie.yaml b/tests/projects/multi-stack-with-yaml/hie.yaml new file mode 100644 index 000000000..46cbb53df --- /dev/null +++ b/tests/projects/multi-stack-with-yaml/hie.yaml @@ -0,0 +1,16 @@ +cradle: + multi: + - path: "appA" + config: + cradle: + stack: + - path: appA/src + component: appA:lib + stackYaml: stack-alt.yaml + - path: "appB" + config: + cradle: + stack: + - path: appB/src + component: appB:lib + stackYaml: stack-alt.yaml diff --git a/tests/projects/multi-stack/multi-stack.cabal b/tests/projects/multi-stack/multi-stack.cabal index c55b7c1bb..b6eb67fdf 100644 --- a/tests/projects/multi-stack/multi-stack.cabal +++ b/tests/projects/multi-stack/multi-stack.cabal @@ -20,4 +20,4 @@ executable multi-stack build-depends: base >=4.10 && < 5, directory -- hs-source-dirs: default-language: Haskell2010 - ghc-options: +RTS -A1m -N -RTS -Wall \ No newline at end of file + ghc-options: +RTS -A1m -N -RTS -Wall diff --git a/tests/projects/stack-with-yaml/Setup.hs b/tests/projects/stack-with-yaml/Setup.hs new file mode 100644 index 000000000..9a994af67 --- /dev/null +++ b/tests/projects/stack-with-yaml/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/tests/projects/stack-with-yaml/app/Main.hs b/tests/projects/stack-with-yaml/app/Main.hs new file mode 100644 index 000000000..0efdb0b52 --- /dev/null +++ b/tests/projects/stack-with-yaml/app/Main.hs @@ -0,0 +1,4 @@ + +import System.Directory (getCurrentDirectory) + +main = return () diff --git a/tests/projects/stack-with-yaml/hie.yaml b/tests/projects/stack-with-yaml/hie.yaml new file mode 100644 index 000000000..a5f7431f6 --- /dev/null +++ b/tests/projects/stack-with-yaml/hie.yaml @@ -0,0 +1,9 @@ +cradle: + stack: + stackYaml: "stack-alt.yaml" + components: + - path: ./src + component: "stack-with-yaml:lib" + + - path: ./app + component: "stack-with-yaml:exe:stack-with-yaml" diff --git a/tests/projects/stack-with-yaml/src/Lib.hs b/tests/projects/stack-with-yaml/src/Lib.hs new file mode 100644 index 000000000..a709c5ea9 --- /dev/null +++ b/tests/projects/stack-with-yaml/src/Lib.hs @@ -0,0 +1,5 @@ +module Lib where + +import System.FilePath (()) + +foo = "test" "me" diff --git a/tests/projects/stack-with-yaml/stack-with-yaml.cabal b/tests/projects/stack-with-yaml/stack-with-yaml.cabal new file mode 100644 index 000000000..538314132 --- /dev/null +++ b/tests/projects/stack-with-yaml/stack-with-yaml.cabal @@ -0,0 +1,23 @@ +cabal-version: >=2.0 +name: stack-with-yaml +version: 0.1.0.0 +build-type: Simple + +library + exposed-modules: Lib + -- other-modules: + -- other-extensions: + build-depends: base >=4.10 && < 5, filepath + hs-source-dirs: src + default-language: Haskell2010 + + + +executable stack-with-yaml + main-is: app/Main.hs + -- other-modules: + -- other-extensions: + build-depends: base >=4.10 && < 5, directory + -- hs-source-dirs: + default-language: Haskell2010 + ghc-options: +RTS -A1m -N -RTS -Wall