Skip to content

Commit

Permalink
Allow specifying a stack.yaml for stack configurations (#230)
Browse files Browse the repository at this point in the history
* allow specifying a stack.yaml for stack configurations

* fix test cases

* add test cases for stack with custom yaml

* add parser test cases

* whitespace

* change suggestive name

* fix test cases (again)

* add missing files to distribution

* fix typo

* default settings for configurations

* add warning about multiple stackYamls

* review fixes

* [ci skip] document changes to cabal configurations

* Use suggested changes

Co-authored-by: fendor <fendor@users.noreply.github.com>
WorldSEnder and fendor authored Aug 23, 2020

Verified

This commit was created on GitHub.com and signed with GitHub’s verified signature.
1 parent 0f823f9 commit 0ed7604
Showing 24 changed files with 402 additions and 84 deletions.
4 changes: 2 additions & 2 deletions .gitignore
Original file line number Diff line number Diff line change
@@ -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/
49 changes: 49 additions & 0 deletions README.md
Original file line number Diff line number Diff line change
@@ -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 <component name>` 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
18 changes: 17 additions & 1 deletion hie-bios.cabal
Original file line number Diff line number Diff line change
@@ -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,
160 changes: 128 additions & 32 deletions src/HIE/Bios/Config.hs
Original file line number Diff line number Diff line change
@@ -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
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
58 changes: 34 additions & 24 deletions src/HIE/Bios/Cradle.hs
Original file line number Diff line number Diff line change
@@ -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
29 changes: 19 additions & 10 deletions tests/BiosTests.hs
Original file line number Diff line number Diff line change
@@ -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
50 changes: 36 additions & 14 deletions tests/ParserTests.hs
Original file line number Diff line number Diff line change
@@ -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,43 +11,56 @@ import Data.Yaml
import qualified Data.Text as T
import System.FilePath
import Control.Applicative ( (<|>) )
import Control.Exception

configDir :: FilePath
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)
12 changes: 12 additions & 0 deletions tests/configs/keys-not-unique-fails.yaml
Original file line number Diff line number Diff line change
@@ -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"
8 changes: 8 additions & 0 deletions tests/configs/multi-stack-with-yaml.yaml
Original file line number Diff line number Diff line change
@@ -0,0 +1,8 @@
cradle:
stack:
stackYaml: "stack-8.8.3.yaml"
components:
- path: "./src"
component: "lib:hie-bios"
- path: "./vendor"
component: "parser-tests"
4 changes: 4 additions & 0 deletions tests/configs/stack-with-both.yaml
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
cradle:
stack:
stackYaml: "stack-8.8.3.yaml"
component: "hie-bios:hie"
3 changes: 3 additions & 0 deletions tests/configs/stack-with-yaml.yaml
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
cradle:
stack:
stackYaml: "stack-8.8.3.yaml"
2 changes: 2 additions & 0 deletions tests/projects/multi-stack-with-yaml/appA/Setup.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
import Distribution.Simple
main = defaultMain
12 changes: 12 additions & 0 deletions tests/projects/multi-stack-with-yaml/appA/appA.cabal
Original file line number Diff line number Diff line change
@@ -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
1 change: 1 addition & 0 deletions tests/projects/multi-stack-with-yaml/appA/src/Lib.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
module Lib where
2 changes: 2 additions & 0 deletions tests/projects/multi-stack-with-yaml/appB/Setup.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
import Distribution.Simple
main = defaultMain
12 changes: 12 additions & 0 deletions tests/projects/multi-stack-with-yaml/appB/appB.cabal
Original file line number Diff line number Diff line change
@@ -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
1 change: 1 addition & 0 deletions tests/projects/multi-stack-with-yaml/appB/src/Lib.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
module Lib where
16 changes: 16 additions & 0 deletions tests/projects/multi-stack-with-yaml/hie.yaml
Original file line number Diff line number Diff line change
@@ -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
2 changes: 1 addition & 1 deletion tests/projects/multi-stack/multi-stack.cabal
Original file line number Diff line number Diff line change
@@ -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
ghc-options: +RTS -A1m -N -RTS -Wall
2 changes: 2 additions & 0 deletions tests/projects/stack-with-yaml/Setup.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
import Distribution.Simple
main = defaultMain
4 changes: 4 additions & 0 deletions tests/projects/stack-with-yaml/app/Main.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@

import System.Directory (getCurrentDirectory)

main = return ()
9 changes: 9 additions & 0 deletions tests/projects/stack-with-yaml/hie.yaml
Original file line number Diff line number Diff line change
@@ -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"
5 changes: 5 additions & 0 deletions tests/projects/stack-with-yaml/src/Lib.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,5 @@
module Lib where

import System.FilePath ((</>))

foo = "test" </> "me"
23 changes: 23 additions & 0 deletions tests/projects/stack-with-yaml/stack-with-yaml.cabal
Original file line number Diff line number Diff line change
@@ -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

0 comments on commit 0ed7604

Please sign in to comment.