From 4ff0bc87d7b2ff16d659de568fbbd2e79935a04d Mon Sep 17 00:00:00 2001 From: jneira Date: Wed, 8 Aug 2018 10:31:01 +0200 Subject: [PATCH 01/46] Add dhall-to-etlas submodule --- .gitmodules | 3 +++ dhall-to-etlas | 1 + 2 files changed, 4 insertions(+) create mode 160000 dhall-to-etlas diff --git a/.gitmodules b/.gitmodules index 2c49574..7db299c 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,3 +1,6 @@ [submodule "hackage-security"] path = hackage-security url = https://github.com/Jyothsnasrinivas/hackage-security.git +[submodule "dhall-to-etlas"] + path = dhall-to-etlas + url = https://github.com/eta-lang/dhall-to-etlas diff --git a/dhall-to-etlas b/dhall-to-etlas new file mode 160000 index 0000000..6f617bd --- /dev/null +++ b/dhall-to-etlas @@ -0,0 +1 @@ +Subproject commit 6f617bd036c35b45910a23e79b5b412760bd13da From 100538408f1bdbb65d0ec2a8175d75562cf9d1fd Mon Sep 17 00:00:00 2001 From: jneira Date: Wed, 8 Aug 2018 11:18:27 +0200 Subject: [PATCH 02/46] bump up to latest forced tag --- dhall-to-etlas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/dhall-to-etlas b/dhall-to-etlas index 6f617bd..6aa77ac 160000 --- a/dhall-to-etlas +++ b/dhall-to-etlas @@ -1 +1 @@ -Subproject commit 6f617bd036c35b45910a23e79b5b412760bd13da +Subproject commit 6aa77ac2382d3c772a5e7405c99c4005f2f4d32a From d1e8a27a2bbc578c029378698e59d36d2036cb67 Mon Sep 17 00:00:00 2001 From: jneira Date: Wed, 8 Aug 2018 11:18:58 +0200 Subject: [PATCH 03/46] allow build dhall-to-etlas (including allow-newer to true) --- stack.yaml | 26 ++++++++++++++++++++++++++ 1 file changed, 26 insertions(+) diff --git a/stack.yaml b/stack.yaml index 8f7d8c3..ff5e6b9 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,9 +1,34 @@ +allow-newer: true extra-deps: - cryptohash-sha256-0.11.100.1 - echo-0.1.3 - ed25519-0.0.5.0 - mintty-0.1.1 - parsec-3.1.13.0 +- dhall-1.16.1 +- ansi-terminal-0.7.1.1 +- ansi-wl-pprint-0.6.8.2 +- cryptonite-0.24 +- formatting-6.3.2 +- megaparsec-6.4.1 +- parser-combinators-0.4.0 +- optparse-generic-1.3.0 +- optparse-applicative-0.14.0.0 +- Only-0.1 +- memory-0.14.14 +- basement-0.0.6 +- prettyprinter-1.2.0.1 +- prettyprinter-ansi-terminal-1.1.1.2 +- directory-1.3.1.0 +- foundation-0.0.19 +- process-1.2.3.0 +- repline-0.1.7.0 +- haskeline-0.7.4.2 +- insert-ordered-containers-0.2.1.0 +- aeson-1.2.3.0 +- th-abstraction-0.2.6.0 +- hashable-1.2.7.0 +- Diff-0.3.4 resolver: lts-6.27 flags: etlas-cabal: @@ -14,5 +39,6 @@ flags: win32-2-5: false packages: - etlas-cabal/ +- dhall-to-etlas/ - etlas/ - hackage-security/hackage-security From acafc3ab409ab1344e6ffce91886ec3dd0361610 Mon Sep 17 00:00:00 2001 From: jneira Date: Wed, 8 Aug 2018 11:32:56 +0200 Subject: [PATCH 04/46] add dhall-to-etlas dep to etlas lib --- etlas/etlas.cabal | 1 + 1 file changed, 1 insertion(+) diff --git a/etlas/etlas.cabal b/etlas/etlas.cabal index 487bd1e..de87bd1 100644 --- a/etlas/etlas.cabal +++ b/etlas/etlas.cabal @@ -200,6 +200,7 @@ library binary >= 0.5 && < 0.9, bytestring >= 0.9 && < 1, etlas-cabal >= 1.0, + dhall-to-etlas >= 1.3, containers >= 0.4 && < 0.6, cryptohash-sha256 >= 0.11 && < 0.12, deepseq >= 1.3 && < 1.5, From 18b9bd8ea526a7b95628ec75b68f59296527980b Mon Sep 17 00:00:00 2001 From: jneira Date: Thu, 9 Aug 2018 14:58:18 +0200 Subject: [PATCH 05/46] Add dhall as a new valid ProjectPackageLocation --- etlas/Distribution/Client/ProjectConfig.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/etlas/Distribution/Client/ProjectConfig.hs b/etlas/Distribution/Client/ProjectConfig.hs index 5e8ac44..da28547 100644 --- a/etlas/Distribution/Client/ProjectConfig.hs +++ b/etlas/Distribution/Client/ProjectConfig.hs @@ -631,6 +631,7 @@ reportParseResult verbosity filetype filename (ParseFailed err) = -- data ProjectPackageLocation = ProjectPackageLocalCabalFile FilePath + | ProjectPackageLocalDhallFile FilePath | ProjectPackageLocalDirectory FilePath FilePath -- dir and .cabal file | ProjectPackageLocalTarball FilePath | ProjectPackageRemoteTarball URI @@ -897,6 +898,9 @@ findProjectPackages DistDirLayout{distProjectRootDirectory} | extensionIsTarGz pkglocstr -> return (Right (ProjectPackageLocalTarball pkglocstr)) + | takeExtension pkglocstr == ".dhall" + -> return (Right (ProjectPackageLocalDhallFile pkglocstr)) + | takeExtension pkglocstr == ".cabal" -> return (Right (ProjectPackageLocalCabalFile pkglocstr)) From 08a5c385d56e20d7a10c26e5ecf4eb6e90bca583 Mon Sep 17 00:00:00 2001 From: jneira Date: Fri, 10 Aug 2018 06:29:28 +0200 Subject: [PATCH 06/46] Add project location dir with dhall file --- etlas/Distribution/Client/ProjectConfig.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/etlas/Distribution/Client/ProjectConfig.hs b/etlas/Distribution/Client/ProjectConfig.hs index da28547..0925b0e 100644 --- a/etlas/Distribution/Client/ProjectConfig.hs +++ b/etlas/Distribution/Client/ProjectConfig.hs @@ -633,6 +633,7 @@ data ProjectPackageLocation = ProjectPackageLocalCabalFile FilePath | ProjectPackageLocalDhallFile FilePath | ProjectPackageLocalDirectory FilePath FilePath -- dir and .cabal file + | ProjectPackageLocalDhallDirectory FilePath FilePath -- dir and etlas.dhall file | ProjectPackageLocalTarball FilePath | ProjectPackageRemoteTarball URI | ProjectPackageRemoteRepo SourceRepo From f84ea85a4e380892085e1b15670c92d8814dd48c Mon Sep 17 00:00:00 2001 From: jneira Date: Fri, 10 Aug 2018 12:38:44 +0200 Subject: [PATCH 07/46] Package with the dhall-to-etlas specific functions --- .../Client/PackageDescription/Dhall.hs | 36 +++++++++++++++++++ 1 file changed, 36 insertions(+) create mode 100644 etlas/Distribution/Client/PackageDescription/Dhall.hs diff --git a/etlas/Distribution/Client/PackageDescription/Dhall.hs b/etlas/Distribution/Client/PackageDescription/Dhall.hs new file mode 100644 index 0000000..906e3d4 --- /dev/null +++ b/etlas/Distribution/Client/PackageDescription/Dhall.hs @@ -0,0 +1,36 @@ +module Distribution.Client.PackageDescription.Dhall where + +import Data.Function ( (&) ) +import qualified Data.Text.IO as StrictText + +import qualified Dhall +import DhallToCabal (dhallToCabal) + +import Distribution.Verbosity +import Distribution.PackageDescription +import Distribution.Simple.Utils (die') + +import Lens.Micro ( set ) + +import System.Directory (doesFileExist) +import System.FilePath (takeDirectory) + +import Control.Monad (unless) + +readGenericPackageDescription :: Verbosity -> FilePath -> IO GenericPackageDescription +readGenericPackageDescription verbosity dhallFilePath = do + exists <- doesFileExist dhallFilePath + unless exists $ + die' verbosity $ + "Error Parsing: file \"" ++ dhallFilePath ++ "\" doesn't exist. Cannot continue." + + let settings = Dhall.defaultInputSettings + & set Dhall.rootDirectory ( takeDirectory dhallFilePath ) + & set Dhall.sourceName dhallFilePath + + source <- StrictText.readFile dhallFilePath + + explaining $ dhallToCabal settings source + + where + explaining = if verbosity >= verbose then Dhall.detailed else id From d3674b598c26f90f72759d6d56229dd6769c2c70 Mon Sep 17 00:00:00 2001 From: jneira Date: Fri, 10 Aug 2018 12:40:16 +0200 Subject: [PATCH 08/46] Add deps and module for dhall integration --- etlas/etlas.cabal | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/etlas/etlas.cabal b/etlas/etlas.cabal index de87bd1..a4359a6 100644 --- a/etlas/etlas.cabal +++ b/etlas/etlas.cabal @@ -97,6 +97,7 @@ library Distribution.Client.PackageUtils Distribution.Client.ParseUtils Distribution.Client.Patch + Distribution.Client.PackageDescription.Dhall Distribution.Client.ProjectBuilding Distribution.Client.ProjectBuilding.Types Distribution.Client.ProjectConfig @@ -200,6 +201,7 @@ library binary >= 0.5 && < 0.9, bytestring >= 0.9 && < 1, etlas-cabal >= 1.0, + dhall >= 1.16 && < 1.17, dhall-to-etlas >= 1.3, containers >= 0.4 && < 0.6, cryptohash-sha256 >= 0.11 && < 0.12, @@ -222,7 +224,9 @@ library network-uri >= 2.6 && < 2.7, network >= 2.6 && < 2.7, bytestring >= 0.10.2, - parsec >= 3.1.13.0 && < 3.2 + text >= 1.2, + parsec >= 3.1.13.0 && < 3.2, + microlens >=0.1.0.0 && <0.5 if os(windows) build-depends: Win32 >= 2 && < 3 @@ -270,4 +274,4 @@ custom-setup setup-depends: Cabal >= 1.22, base, process >= 1.1.0.1 && < 1.6, - filepath >= 1.3 && < 1.5 + filepath >= 1.3 && < 1.5 From b879980b1761c02204078713113ac9f2f0905d8d Mon Sep 17 00:00:00 2001 From: jneira Date: Fri, 10 Aug 2018 12:41:11 +0200 Subject: [PATCH 09/46] Change target selection error msg to include etlas.dhall --- etlas/Distribution/Client/TargetSelector.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/etlas/Distribution/Client/TargetSelector.hs b/etlas/Distribution/Client/TargetSelector.hs index 72e6c69..f61137d 100644 --- a/etlas/Distribution/Client/TargetSelector.hs +++ b/etlas/Distribution/Client/TargetSelector.hs @@ -775,8 +775,8 @@ reportTargetSelectorProblems verbosity problems = do [] -> return () _:_ -> die' verbosity $ - "There is no .cabal package file or cabal.project file. " - ++ "To build packages locally you need at minimum a .cabal " + "There is no etlas.dhall, .cabal package file or cabal.project file. " + ++ "To build packages locally you need at minimum an etlas.dhall or .cabal " ++ "file. You can use 'etlas init' to create one.\n" ++ "\n" ++ "For non-trivial projects you will also want a cabal.project " From 75636998daff15bc33da1f6611bf435abe7763ac Mon Sep 17 00:00:00 2001 From: jneira Date: Fri, 10 Aug 2018 12:41:57 +0200 Subject: [PATCH 10/46] Include etlas.dhall in projct config --- etlas/Distribution/Client/ProjectConfig.hs | 147 ++++++++++++++------- 1 file changed, 97 insertions(+), 50 deletions(-) diff --git a/etlas/Distribution/Client/ProjectConfig.hs b/etlas/Distribution/Client/ProjectConfig.hs index 0925b0e..ed25f70 100644 --- a/etlas/Distribution/Client/ProjectConfig.hs +++ b/etlas/Distribution/Client/ProjectConfig.hs @@ -90,6 +90,7 @@ import Distribution.PackageDescription.Parsec import Distribution.PackageDescription.Parse ( readGenericPackageDescription ) #endif +import qualified Distribution.Client.PackageDescription.Dhall as Dhall import Distribution.Simple.Compiler ( Compiler, compilerInfo ) import Distribution.Simple.Program @@ -509,10 +510,10 @@ readProjectLocalConfig verbosity DistDirLayout{distProjectFile} = do defaultImplicitProjectConfig = mempty { -- We expect a package in the current directory. - projectPackages = [ "./*.cabal" ], + projectPackages = [ ], -- This is to automatically pick up deps that we unpack locally. - projectPackagesOptional = [ "./*/*.cabal" ], + projectPackagesOptional = [ "./*.cabal", "./etlas.dhall", "./*/*.cabal", "./*/etlas.dhall" ], projectConfigProvenance = Set.singleton Implicit } @@ -630,14 +631,14 @@ reportParseResult verbosity filetype filename (ParseFailed err) = -- to the project root. -- data ProjectPackageLocation = - ProjectPackageLocalCabalFile FilePath - | ProjectPackageLocalDhallFile FilePath - | ProjectPackageLocalDirectory FilePath FilePath -- dir and .cabal file + ProjectPackageLocalCabalFile FilePath + | ProjectPackageLocalDhallFile FilePath + | ProjectPackageLocalCabalDirectory FilePath FilePath -- dir and .cabal file | ProjectPackageLocalDhallDirectory FilePath FilePath -- dir and etlas.dhall file - | ProjectPackageLocalTarball FilePath - | ProjectPackageRemoteTarball URI - | ProjectPackageRemoteRepo SourceRepo - | ProjectPackageNamed Dependency + | ProjectPackageLocalTarball FilePath + | ProjectPackageRemoteTarball URI + | ProjectPackageRemoteRepo SourceRepo + | ProjectPackageNamed Dependency deriving Show @@ -672,8 +673,8 @@ data BadPackageLocation data BadPackageLocationMatch = BadLocUnexpectedFile String | BadLocNonexistantFile String - | BadLocDirNoCabalFile String - | BadLocDirManyCabalFiles String + | BadLocDirNoConfigFiles String + | BadLocDirManyConfigFiles String deriving Show renderBadPackageLocations :: BadPackageLocations -> String @@ -723,9 +724,9 @@ renderBadPackageLocations (BadPackageLocations provenance bpls) renderImplicitBadPackageLocation :: BadPackageLocation -> String renderImplicitBadPackageLocation bpl = case bpl of BadLocGlobEmptyMatch pkglocstr -> - "No cabal.project file or cabal file matching the default glob '" + "No cabal.project file, etlas.dhall file or cabal file matching the default glob '" ++ pkglocstr ++ "' was found.\n" - ++ "Please create a package description file .cabal " + ++ "Please create a package description file etlas.dhall/.cabal " ++ "or a cabal.project file referencing the packages you " ++ "want to build." _ -> renderBadPackageLocation bpl @@ -755,14 +756,14 @@ renderBadPackageLocationMatch :: BadPackageLocationMatch -> String renderBadPackageLocationMatch bplm = case bplm of BadLocUnexpectedFile pkglocstr -> "The package location '" ++ pkglocstr ++ "' is not recognised. The " - ++ "supported file targets are .cabal files, .tar.gz tarballs or package " - ++ "directories (i.e. directories containing a .cabal file)." + ++ "supported file targets are etlas.dhall file, .cabal files, .tar.gz tarballs or package " + ++ "directories (i.e. directories containing an etlas.dhall or .cabal file)." BadLocNonexistantFile pkglocstr -> "The package location '" ++ pkglocstr ++ "' does not exist." - BadLocDirNoCabalFile pkglocstr -> - "The package directory '" ++ pkglocstr ++ "' does not contain any " - ++ ".cabal file." - BadLocDirManyCabalFiles pkglocstr -> + BadLocDirNoConfigFiles pkglocstr -> + "The package directory '" ++ pkglocstr ++ "' does not contain an " + ++ "etlas.dhall file or any .cabal file." + BadLocDirManyConfigFiles pkglocstr -> "The package directory '" ++ pkglocstr ++ "' contains multiple " ++ ".cabal files (which is not currently supported)." @@ -888,18 +889,22 @@ findProjectPackages DistDirLayout{distProjectRootDirectory} dir -> liftIO $ doesDirectoryExist dir case () of _ | isDir - -> do matches <- matchFileGlob (globStarDotCabal pkglocstr) - case matches of - [cabalFile] - -> return (Right (ProjectPackageLocalDirectory - pkglocstr cabalFile)) - [] -> return (Left (BadLocDirNoCabalFile pkglocstr)) - _ -> return (Left (BadLocDirManyCabalFiles pkglocstr)) + -> do matchesDhall <- matchFileGlob (globEtlasDotDhall pkglocstr) + matchesCabal <- matchFileGlob (globStarDotCabal pkglocstr) + return $ case (matchesDhall, matchesCabal) of + ([etlasDhall],_) + -> Right (ProjectPackageLocalDhallDirectory + pkglocstr etlasDhall) + ([],[cabalFile]) + -> Right (ProjectPackageLocalCabalDirectory + pkglocstr cabalFile) + ([],[]) -> Left (BadLocDirNoConfigFiles pkglocstr) + _ -> Left (BadLocDirManyConfigFiles pkglocstr) | extensionIsTarGz pkglocstr -> return (Right (ProjectPackageLocalTarball pkglocstr)) - | takeExtension pkglocstr == ".dhall" + | takeFileName pkglocstr == "etlas.dhall" -> return (Right (ProjectPackageLocalDhallFile pkglocstr)) | takeExtension pkglocstr == ".cabal" @@ -924,16 +929,27 @@ findProjectPackages DistDirLayout{distProjectRootDirectory} -- For a directory @some/dir/@, this is a glob of the form @some/dir/\*.cabal@. -- The directory part can be either absolute or relative. -- + globStarDotCabal :: FilePath -> FilePathGlob -globStarDotCabal dir = +globStarDotCabal = globFilePath $ GlobFile [WildCard, Literal ".cabal"] + +-- | A glob to find the etlas.dhall file in a directory. +-- +-- For a directory @some/dir/@, this is a glob of the form @some/dir/\etlas.dhall@. +-- The directory part can be either absolute or relative. +-- + +globEtlasDotDhall :: FilePath -> FilePathGlob +globEtlasDotDhall = globFilePath $ GlobFile [Literal "etlas.dhall"] + +globFilePath :: FilePathGlobRel -> FilePath -> FilePathGlob +globFilePath globFile dir = FilePathGlob (if isAbsolute dir then FilePathRoot root else FilePathRelative) - (foldr (\d -> GlobDir [Literal d]) - (GlobFile [WildCard, Literal ".cabal"]) dirComponents) + (foldr (\d -> GlobDir [Literal d]) globFile dirComponents) where (root, dirComponents) = fmap splitDirectories (splitDrive dir) - - + --TODO: [code cleanup] use sufficiently recent transformers package mplusMaybeT :: Monad m => m (Maybe a) -> m (Maybe a) -> m (Maybe a) mplusMaybeT ma mb = do @@ -943,19 +959,40 @@ mplusMaybeT ma mb = do Just x -> return (Just x) --- | Read the @.cabal@ file of the given package. +-- | Read the @etlas.dhall@ or @.cabal@ file of the given package. -- -- Note here is where we convert from project-root relative paths to absolute -- paths. -- readSourcePackage :: Verbosity -> DistDirLayout -> ProjectPackageLocation -> Rebuild (PackageSpecifier UnresolvedSourcePackage) -readSourcePackage verbosity distDirLayout (ProjectPackageLocalCabalFile cabalFile) = - readSourcePackage verbosity distDirLayout (ProjectPackageLocalDirectory dir cabalFile) +readSourcePackage verbosity distDirLayout + (ProjectPackageLocalDhallFile dhallFile) = + readSourcePackage verbosity distDirLayout (ProjectPackageLocalDhallDirectory dir dhallFile) + where + dir = takeDirectory dhallFile + +readSourcePackage verbosity distDirLayout + (ProjectPackageLocalCabalFile cabalFile) = + readSourcePackage verbosity distDirLayout (ProjectPackageLocalCabalDirectory dir cabalFile) where dir = takeDirectory cabalFile -readSourcePackage verbosity _distDirLayout (ProjectPackageLocalDirectory dir cabalFile) = do +readSourcePackage verbosity _distDirLayout + (ProjectPackageLocalDhallDirectory dir dhallFile) = do + monitorFiles [monitorFileHashed dhallFile] + root <- askRoot + pkgdesc <- liftIO $ Dhall.readGenericPackageDescription verbosity (root dhallFile) + return $ SpecificSourcePackage SourcePackage { + packageInfoId = packageId pkgdesc, + packageDescription = pkgdesc, + packageSource = LocalUnpackedPackage (root dir), + packageDescrOverride = Nothing, + packagePatch = Nothing + } + +readSourcePackage verbosity _distDirLayout + (ProjectPackageLocalCabalDirectory dir cabalFile) = do monitorFiles [monitorFileHashed cabalFile] root <- askRoot pkgdesc <- liftIO $ readGenericPackageDescription verbosity (root cabalFile) @@ -971,7 +1008,8 @@ readSourcePackage _verbosity _distDirLayout (ProjectPackageNamed (Dependency pkgname verrange)) = return $ NamedPackage pkgname [PackagePropertyVersion verrange] -readSourcePackage verbosity distDirLayout (ProjectPackageRemoteRepo sourceRepo) = do +readSourcePackage verbosity distDirLayout + (ProjectPackageRemoteRepo sourceRepo) = do root <- askRoot let sourceRepoLocation | Just location <- repoLocation sourceRepo @@ -980,19 +1018,28 @@ readSourcePackage verbosity distDirLayout (ProjectPackageRemoteRepo sourceRepo) destDir = root distTempDirectory distDirLayout "scm" showHashValue (hashString (show [sourceRepo])) pkgDestDir = destDir fromMaybe "" (repoSubdir sourceRepo) - cabalFile <- liftIO $ do - exists <- doesDirectoryExist destDir - when (not (exists)) $ - downloadSourceRepo verbosity destDir - (Left sourceRepoLocation) [sourceRepo] - files <- getDirectoryContents pkgDestDir - let cabalFiles = filter (\file -> takeExtension file == ".cabal") files - case length cabalFiles of - 0 -> die' verbosity $ "No cabal file found for " ++ sourceRepoLocation - 1 -> return () - _ -> die' verbosity $ "Multiple cabal files found for " ++ sourceRepoLocation - return $ head cabalFiles - pkgdesc <- liftIO $ readGenericPackageDescription verbosity (pkgDestDir cabalFile) + + pkgdesc <- liftIO $ do + files <- do + exists <- doesDirectoryExist destDir + when (not (exists)) $ + downloadSourceRepo verbosity destDir + (Left sourceRepoLocation) [sourceRepo] + getDirectoryContents destDir + let mbDhallFile = find (== "etlas.dhall") files + case mbDhallFile of + Just dhallFile -> + Dhall.readGenericPackageDescription verbosity (destDir dhallFile) + Nothing -> do + let cabalFiles = filter (\file -> takeExtension file == ".cabal") files + cabalFile <- do + case length cabalFiles of + 0 -> die' verbosity $ "No etlas.dhall or cabal file found for " ++ sourceRepoLocation + 1 -> return () + _ -> die' verbosity $ "Multiple cabal files found for " ++ sourceRepoLocation + return $ head cabalFiles + readGenericPackageDescription verbosity (destDir cabalFile) + let pkgid = packageId pkgdesc return $ SpecificSourcePackage SourcePackage { packageInfoId = pkgid, From bb0f800aab8751c64053b601d14af10b4cdace5a Mon Sep 17 00:00:00 2001 From: jneira Date: Tue, 14 Aug 2018 12:22:56 +0200 Subject: [PATCH 11/46] remove duplicated import --- etlas/etlas.cabal | 1 - 1 file changed, 1 deletion(-) diff --git a/etlas/etlas.cabal b/etlas/etlas.cabal index a4359a6..51d9dfa 100644 --- a/etlas/etlas.cabal +++ b/etlas/etlas.cabal @@ -223,7 +223,6 @@ library process >= 1.1.0.2 && < 1.7, network-uri >= 2.6 && < 2.7, network >= 2.6 && < 2.7, - bytestring >= 0.10.2, text >= 1.2, parsec >= 3.1.13.0 && < 3.2, microlens >=0.1.0.0 && <0.5 From f649437596ad4b8f7df7545b16fa6587d8e1dd3f Mon Sep 17 00:00:00 2001 From: jneira Date: Tue, 14 Aug 2018 12:23:45 +0200 Subject: [PATCH 12/46] Use cabal parsec to reparse dhall GenericPackageDescription --- .../Client/PackageDescription/Dhall.hs | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/etlas/Distribution/Client/PackageDescription/Dhall.hs b/etlas/Distribution/Client/PackageDescription/Dhall.hs index 906e3d4..028f996 100644 --- a/etlas/Distribution/Client/PackageDescription/Dhall.hs +++ b/etlas/Distribution/Client/PackageDescription/Dhall.hs @@ -1,5 +1,6 @@ module Distribution.Client.PackageDescription.Dhall where +import qualified Data.ByteString.Char8 as BS.Char import Data.Function ( (&) ) import qualified Data.Text.IO as StrictText @@ -8,6 +9,8 @@ import DhallToCabal (dhallToCabal) import Distribution.Verbosity import Distribution.PackageDescription +import Distribution.PackageDescription.PrettyPrint (showGenericPackageDescription) +import Distribution.PackageDescription.Parsec (parseGenericPackageDescriptionMaybe) import Distribution.Simple.Utils (die') import Lens.Micro ( set ) @@ -30,7 +33,17 @@ readGenericPackageDescription verbosity dhallFilePath = do source <- StrictText.readFile dhallFilePath - explaining $ dhallToCabal settings source + genPkgDesc <- explaining $ dhallToCabal settings source + -- TODO: It should use directly the `GenericPackageDescription` generated by dhall. + -- However, it actually has not the `condTreeConstraints` field informed and + -- this make it unusable to be consumed by etlas/cabal + let bs = BS.Char.pack $ showGenericPackageDescription genPkgDesc + result = parseGenericPackageDescriptionMaybe bs + case result of + Nothing -> die' verbosity $ "Failing parsing \"" ++ dhallFilePath ++ "\"." + Just x -> return x + where explaining = if verbosity >= verbose then Dhall.detailed else id + From c7fefaf0afaa6071cbc579cb2da828a9fc314cd3 Mon Sep 17 00:00:00 2001 From: jneira Date: Tue, 14 Aug 2018 14:58:03 +0200 Subject: [PATCH 13/46] Use readDhallGenericPackageDescription --- .../Distribution/PackageDescription/Check.hs | 33 ++++++++++------- etlas-cabal/Distribution/Simple/Utils.hs | 32 +++++++++------- etlas/Distribution/Client/GenBounds.hs | 7 +--- etlas/Distribution/Client/Outdated.hs | 9 +---- .../Client/PackageDescription/Dhall.hs | 37 ++++++++++++++++--- etlas/Distribution/Client/ProjectConfig.hs | 2 +- etlas/Distribution/Client/SetupWrapper.hs | 8 +--- etlas/Distribution/Client/Targets.hs | 16 +++++--- etlas/Distribution/Client/Utils.hs | 2 +- etlas/main/Main.hs | 8 +--- 10 files changed, 89 insertions(+), 65 deletions(-) diff --git a/etlas-cabal/Distribution/PackageDescription/Check.hs b/etlas-cabal/Distribution/PackageDescription/Check.hs index 85f5131..ee9d8ec 100644 --- a/etlas-cabal/Distribution/PackageDescription/Check.hs +++ b/etlas-cabal/Distribution/PackageDescription/Check.hs @@ -1781,19 +1781,26 @@ findPackageDesc :: Monad m => CheckPackageContentOps m -> m (Either PackageCheck FilePath) -- ^.cabal findPackageDesc ops = do let dir = "." - files <- getDirectoryContents ops dir - -- to make sure we do not mistake a ~/.cabal/ dir for a .cabal - -- file we filter to exclude dirs and null base file names: - cabalFiles <- filterM (doesFileExist ops) - [ dir file - | file <- files - , let (name, ext) = splitExtension file - , not (null name) && ext == ".cabal" ] - case cabalFiles of - [] -> return (Left $ PackageBuildImpossible noDesc) - [cabalFile] -> return (Right cabalFile) - multiple -> return (Left $ PackageBuildImpossible - $ multiDesc multiple) + dhallFile = dir "etlas.dhall" + + existDhallFile <- doesFileExist ops dhallFile + + if existDhallFile then return (Right dhallFile) + else do + + files <- getDirectoryContents ops dir + -- to make sure we do not mistake a ~/.cabal/ dir for a .cabal + -- file we filter to exclude dirs and null base file names: + cabalFiles <- filterM (doesFileExist ops) + [ dir file + | file <- files + , let (name, ext) = splitExtension file + , not (null name) && ext == ".cabal" ] + case cabalFiles of + [] -> return (Left $ PackageBuildImpossible noDesc) + [cabalFile] -> return (Right cabalFile) + multiple -> return (Left $ PackageBuildImpossible + $ multiDesc multiple) where noDesc :: String diff --git a/etlas-cabal/Distribution/Simple/Utils.hs b/etlas-cabal/Distribution/Simple/Utils.hs index 2b8007f..6a43f3f 100644 --- a/etlas-cabal/Distribution/Simple/Utils.hs +++ b/etlas-cabal/Distribution/Simple/Utils.hs @@ -1472,22 +1472,28 @@ defaultPackageDesc :: Verbosity -> IO FilePath defaultPackageDesc _verbosity = tryFindPackageDesc currentDir -- |Find a package description file in the given directory. Looks for --- @.cabal@ files. +-- an @etlas.dhall@ file or @.cabal@ files. findPackageDesc :: FilePath -- ^Where to look -> NoCallStackIO (Either String FilePath) -- ^.cabal findPackageDesc dir - = do files <- getDirectoryContents dir - -- to make sure we do not mistake a ~/.cabal/ dir for a .cabal - -- file we filter to exclude dirs and null base file names: - cabalFiles <- filterM doesFileExist - [ dir file - | file <- files - , let (name, ext) = splitExtension file - , not (null name) && ext == ".cabal" ] - case cabalFiles of - [] -> return (Left noDesc) - [cabalFile] -> return (Right cabalFile) - multiple -> return (Left $ multiDesc multiple) + = do let dhallFile = dir "etlas.dhall" + + existDhallFile <- doesFileExist dhallFile + + if existDhallFile then return (Right dhallFile) + else do + files <- getDirectoryContents dir + -- to make sure we do not mistake a ~/.cabal/ dir for a .cabal + -- file we filter to exclude dirs and null base file names: + cabalFiles <- filterM doesFileExist + [ dir file + | file <- files + , let (name, ext) = splitExtension file + , not (null name) && ext == ".cabal" ] + case cabalFiles of + [] -> return (Left noDesc) + [cabalFile] -> return (Right cabalFile) + multiple -> return (Left $ multiDesc multiple) where noDesc :: String diff --git a/etlas/Distribution/Client/GenBounds.hs b/etlas/Distribution/Client/GenBounds.hs index b6658c4..a5334f3 100644 --- a/etlas/Distribution/Client/GenBounds.hs +++ b/etlas/Distribution/Client/GenBounds.hs @@ -29,13 +29,8 @@ import Distribution.PackageDescription ( buildDepends ) import Distribution.PackageDescription.Configuration ( finalizePD ) -#ifdef CABAL_PARSEC -import Distribution.PackageDescription.Parsec +import Distribution.Client.PackageDescription.Dhall ( readGenericPackageDescription ) -#else -import Distribution.PackageDescription.Parse - ( readGenericPackageDescription ) -#endif import Distribution.Types.ComponentRequestedSpec ( defaultComponentRequestedSpec ) import Distribution.Types.Dependency diff --git a/etlas/Distribution/Client/Outdated.hs b/etlas/Distribution/Client/Outdated.hs index bc7eac1..4cb2797 100644 --- a/etlas/Distribution/Client/Outdated.hs +++ b/etlas/Distribution/Client/Outdated.hs @@ -43,13 +43,8 @@ import Distribution.Verbosity (Verbosity, silent) import Distribution.Version (Version, LowerBound(..), UpperBound(..) ,asVersionIntervals, majorBoundVersion) -#ifdef CABAL_PARSEC -import Distribution.PackageDescription.Parsec - (readGenericPackageDescription) -#else -import Distribution.PackageDescription.Parse - (readGenericPackageDescription) -#endif +import Distribution.Client.PackageDescription.Dhall + ( readGenericPackageDescription ) import qualified Data.Set as S import System.Directory (getCurrentDirectory) diff --git a/etlas/Distribution/Client/PackageDescription/Dhall.hs b/etlas/Distribution/Client/PackageDescription/Dhall.hs index 028f996..18f60a7 100644 --- a/etlas/Distribution/Client/PackageDescription/Dhall.hs +++ b/etlas/Distribution/Client/PackageDescription/Dhall.hs @@ -1,6 +1,7 @@ +{-# LANGUAGE CPP #-} module Distribution.Client.PackageDescription.Dhall where -import qualified Data.ByteString.Char8 as BS.Char +import qualified Data.ByteString.Char8 as BS.Char8 import Data.Function ( (&) ) import qualified Data.Text.IO as StrictText @@ -10,18 +11,32 @@ import DhallToCabal (dhallToCabal) import Distribution.Verbosity import Distribution.PackageDescription import Distribution.PackageDescription.PrettyPrint (showGenericPackageDescription) -import Distribution.PackageDescription.Parsec (parseGenericPackageDescriptionMaybe) +#ifdef CABAL_PARSEC +import qualified Distribution.PackageDescription.Parsec as Cabal.Parse + ( readGenericPackageDescription, parseGenericPackageDescriptionMaybe ) +#else +import Distribution.PackageDescription.Parse as Cabal.Parse + ( readGenericPackageDescription , parseGenericPackageDescription, ParseResult(..) ) +#endif import Distribution.Simple.Utils (die') import Lens.Micro ( set ) import System.Directory (doesFileExist) -import System.FilePath (takeDirectory) +import System.FilePath (takeDirectory, takeExtension) import Control.Monad (unless) +import Debug.Trace readGenericPackageDescription :: Verbosity -> FilePath -> IO GenericPackageDescription -readGenericPackageDescription verbosity dhallFilePath = do +readGenericPackageDescription verbosity path = + if (trace "Extension:" $ traceId $ takeExtension path) == "dhall" then + readDhallGenericPackageDescription verbosity path + else + Cabal.Parse.readGenericPackageDescription verbosity path + +readDhallGenericPackageDescription :: Verbosity -> FilePath -> IO GenericPackageDescription +readDhallGenericPackageDescription verbosity dhallFilePath = do exists <- doesFileExist dhallFilePath unless exists $ die' verbosity $ @@ -37,8 +52,8 @@ readGenericPackageDescription verbosity dhallFilePath = do -- TODO: It should use directly the `GenericPackageDescription` generated by dhall. -- However, it actually has not the `condTreeConstraints` field informed and -- this make it unusable to be consumed by etlas/cabal - let bs = BS.Char.pack $ showGenericPackageDescription genPkgDesc - result = parseGenericPackageDescriptionMaybe bs + let content = showGenericPackageDescription genPkgDesc + result = parseCabalGenericPackageDescription content case result of Nothing -> die' verbosity $ "Failing parsing \"" ++ dhallFilePath ++ "\"." @@ -47,3 +62,13 @@ readGenericPackageDescription verbosity dhallFilePath = do where explaining = if verbosity >= verbose then Dhall.detailed else id +parseCabalGenericPackageDescription :: String -> Maybe GenericPackageDescription +#ifdef CABAL_PARSEC +parseCabalGenericPackageDescription content = + Cabal.Parse.parseGenericPackageDescriptionMaybe $ BS.Char8.pack content +#else +parseCabalGenericPackageDescription content = + case Cabal.Parse.parseGenericPackageDescription content of + ParseOk _ pkg -> Just pkg + _ -> Nothing +#endif diff --git a/etlas/Distribution/Client/ProjectConfig.hs b/etlas/Distribution/Client/ProjectConfig.hs index ed25f70..fb9cd9a 100644 --- a/etlas/Distribution/Client/ProjectConfig.hs +++ b/etlas/Distribution/Client/ProjectConfig.hs @@ -982,7 +982,7 @@ readSourcePackage verbosity _distDirLayout (ProjectPackageLocalDhallDirectory dir dhallFile) = do monitorFiles [monitorFileHashed dhallFile] root <- askRoot - pkgdesc <- liftIO $ Dhall.readGenericPackageDescription verbosity (root dhallFile) + pkgdesc <- liftIO $ Dhall.readDhallGenericPackageDescription verbosity (root dhallFile) return $ SpecificSourcePackage SourcePackage { packageInfoId = packageId pkgdesc, packageDescription = pkgdesc, diff --git a/etlas/Distribution/Client/SetupWrapper.hs b/etlas/Distribution/Client/SetupWrapper.hs index dc484ca..4645e9f 100644 --- a/etlas/Distribution/Client/SetupWrapper.hs +++ b/etlas/Distribution/Client/SetupWrapper.hs @@ -36,13 +36,9 @@ import Distribution.PackageDescription ( GenericPackageDescription(packageDescription) , PackageDescription(..), specVersion , BuildType(..), knownBuildTypes ) -#ifdef CABAL_PARSEC -import Distribution.PackageDescription.Parsec +import Distribution.Client.PackageDescription.Dhall ( readGenericPackageDescription ) -#else -import Distribution.PackageDescription.Parse - ( readGenericPackageDescription ) -#endif + import Distribution.Simple.Compiler ( Compiler, PackageDB(..), PackageDBStack ) import Distribution.Simple.Program diff --git a/etlas/Distribution/Client/Targets.hs b/etlas/Distribution/Client/Targets.hs index dd3a2fa..4b7c6e1 100644 --- a/etlas/Distribution/Client/Targets.hs +++ b/etlas/Distribution/Client/Targets.hs @@ -86,14 +86,16 @@ import Distribution.Simple.Utils #ifdef CABAL_PARSEC import Distribution.PackageDescription.Parsec - ( readGenericPackageDescription, parseGenericPackageDescriptionMaybe ) + ( parseGenericPackageDescriptionMaybe ) #else import Distribution.PackageDescription.Parse - ( readGenericPackageDescription, parseGenericPackageDescription, ParseResult(..) ) + ( parseGenericPackageDescription, ParseResult(..) ) import Distribution.Simple.Utils ( fromUTF8, ignoreBOM ) import qualified Data.ByteString.Lazy.Char8 as BS.Char8 #endif +import Distribution.Client.PackageDescription.Dhall + ( readGenericPackageDescription ) -- import Data.List ( find, nub ) import Data.Either @@ -182,7 +184,7 @@ readUserTargets verbosity targetStrs = do reportUserTargetProblems verbosity problems return targets - +-- TODO handle etlas.dhall with a new case UserTargetLocalDhallFile data UserTargetProblem = UserTargetUnexpectedFile String | UserTargetNonexistantFile String @@ -274,7 +276,7 @@ readUserTarget targetstr = v | v == nullVersion -> Dependency (packageName p) anyVersion | otherwise -> Dependency (packageName p) (thisVersion v) - +-- TODO handle etlas.dhall case reportUserTargetProblems :: Verbosity -> [UserTargetProblem] -> IO () reportUserTargetProblems verbosity problems = do case [ target | UserTargetUnrecognised target <- problems ] of @@ -421,6 +423,7 @@ expandUserTarget verbosity worldFile userTarget = case userTarget of UserTargetRemoteTarball tarballURL -> return [ PackageTargetLocation (RemoteTarballPackage tarballURL ()) ] +-- Handle etlas.dhall case localPackageError :: FilePath -> String localPackageError dir = "Error reading local package.\nCouldn't find .cabal file in: " ++ dir @@ -474,11 +477,12 @@ readPackageTarget verbosity = traverse modifyLocation ScmPackage _ _ _ _ -> error "TODO: readPackageTarget ScmPackage" + -- TODO: parse etlas.dhall file readTarballPackageTarget location tarballFile tarballOriginalLoc = do (filename, content) <- extractTarballPackageCabalFile tarballFile tarballOriginalLoc case parsePackageDescription' content of - Nothing -> die' verbosity $ "Could not parse the cabal file " + Nothing -> die' verbosity $ "Could not parse the dhall or cabal file " ++ filename ++ " in " ++ tarballFile Just pkg -> return $ SourcePackage { @@ -488,7 +492,7 @@ readPackageTarget verbosity = traverse modifyLocation packageDescrOverride = Nothing, packagePatch = Nothing } - + -- TODO: extract etlas.dhall file extractTarballPackageCabalFile :: FilePath -> String -> IO (FilePath, BS.ByteString) extractTarballPackageCabalFile tarballFile tarballOriginalLoc = do diff --git a/etlas/Distribution/Client/Utils.hs b/etlas/Distribution/Client/Utils.hs index 56ef947..3ae3fb8 100644 --- a/etlas/Distribution/Client/Utils.hs +++ b/etlas/Distribution/Client/Utils.hs @@ -301,7 +301,7 @@ relaxEncodingErrors handle = do -- |Like 'tryFindPackageDesc', but with error specific to add-source deps. tryFindAddSourcePackageDesc :: Verbosity -> FilePath -> String -> IO FilePath tryFindAddSourcePackageDesc verbosity depPath err = tryFindPackageDesc verbosity depPath $ - err ++ "\n" ++ "Failed to read cabal file of add-source dependency: " + err ++ "\n" ++ "Failed to read etlas.dhall or cabal file of add-source dependency: " ++ depPath -- |Try to find a @.cabal@ file, in directory @depPath@. Fails if one cannot be diff --git a/etlas/main/Main.hs b/etlas/main/Main.hs index ffeb591..a34e52d 100644 --- a/etlas/main/Main.hs +++ b/etlas/main/Main.hs @@ -144,12 +144,8 @@ import Distribution.Client.BinaryUtils import Distribution.Package (packageId) import Distribution.PackageDescription ( BuildType(..), Executable(..), buildable) -#ifdef CABAL_PARSEC -import Distribution.PackageDescription.Parsec ( readGenericPackageDescription ) -#else -import Distribution.PackageDescription.Parse ( readGenericPackageDescription ) -#endif - +import Distribution.Client.PackageDescription.Dhall + ( readGenericPackageDescription ) import Distribution.PackageDescription.PrettyPrint ( writeGenericPackageDescription ) import qualified Distribution.Simple as Simple From 20157dd0dace0b2e21063b07075fb84c07f705e0 Mon Sep 17 00:00:00 2001 From: jneira Date: Tue, 14 Aug 2018 15:00:45 +0200 Subject: [PATCH 14/46] Remove trace --- etlas/Distribution/Client/PackageDescription/Dhall.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/etlas/Distribution/Client/PackageDescription/Dhall.hs b/etlas/Distribution/Client/PackageDescription/Dhall.hs index 18f60a7..ad21f2a 100644 --- a/etlas/Distribution/Client/PackageDescription/Dhall.hs +++ b/etlas/Distribution/Client/PackageDescription/Dhall.hs @@ -26,11 +26,10 @@ import System.Directory (doesFileExist) import System.FilePath (takeDirectory, takeExtension) import Control.Monad (unless) -import Debug.Trace readGenericPackageDescription :: Verbosity -> FilePath -> IO GenericPackageDescription readGenericPackageDescription verbosity path = - if (trace "Extension:" $ traceId $ takeExtension path) == "dhall" then + if (takeExtension path) == "dhall" then readDhallGenericPackageDescription verbosity path else Cabal.Parse.readGenericPackageDescription verbosity path From e19793f84ddaf79026b89625eaa09567fd98b0b4 Mon Sep 17 00:00:00 2001 From: jneira Date: Tue, 14 Aug 2018 15:01:30 +0200 Subject: [PATCH 15/46] Correct extension --- etlas/Distribution/Client/PackageDescription/Dhall.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/etlas/Distribution/Client/PackageDescription/Dhall.hs b/etlas/Distribution/Client/PackageDescription/Dhall.hs index ad21f2a..4896f65 100644 --- a/etlas/Distribution/Client/PackageDescription/Dhall.hs +++ b/etlas/Distribution/Client/PackageDescription/Dhall.hs @@ -29,7 +29,7 @@ import Control.Monad (unless) readGenericPackageDescription :: Verbosity -> FilePath -> IO GenericPackageDescription readGenericPackageDescription verbosity path = - if (takeExtension path) == "dhall" then + if (takeExtension path) == ".dhall" then readDhallGenericPackageDescription verbosity path else Cabal.Parse.readGenericPackageDescription verbosity path From 7671ca4b1ffeb1ad1154c816cc61f4db6ae1d15c Mon Sep 17 00:00:00 2001 From: jneira Date: Mon, 20 Aug 2018 15:02:33 +0200 Subject: [PATCH 16/46] add stub of remove duplicate pkg locations --- etlas/Distribution/Client/ProjectConfig.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/etlas/Distribution/Client/ProjectConfig.hs b/etlas/Distribution/Client/ProjectConfig.hs index fb9cd9a..1f6dfe4 100644 --- a/etlas/Distribution/Client/ProjectConfig.hs +++ b/etlas/Distribution/Client/ProjectConfig.hs @@ -781,8 +781,12 @@ findProjectPackages DistDirLayout{distProjectRootDirectory} let repoPkgs = map ProjectPackageRemoteRepo projectPackagesRepo namedPkgs = map ProjectPackageNamed projectPackagesNamed - return (concat [requiredPkgs, optionalPkgs, repoPkgs, namedPkgs]) + return $ removeDuplicatedPackageLocations + $ concat [requiredPkgs, optionalPkgs, repoPkgs, namedPkgs] where + + removeDuplicatedPackageLocations = id + findPackageLocations required pkglocstr = do (problems, pkglocs) <- partitionEithers <$> mapM (findPackageLocation required) pkglocstr From cc11f3f4062a9508d6cdba8755257326a69720b5 Mon Sep 17 00:00:00 2001 From: jneira Date: Tue, 21 Aug 2018 10:15:53 +0200 Subject: [PATCH 17/46] bump dhall-to-etlas --- dhall-to-etlas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/dhall-to-etlas b/dhall-to-etlas index 6aa77ac..f619a15 160000 --- a/dhall-to-etlas +++ b/dhall-to-etlas @@ -1 +1 @@ -Subproject commit 6aa77ac2382d3c772a5e7405c99c4005f2f4d32a +Subproject commit f619a1530290d9bae23e90aa57fe2c8eb7cbe7ca From 416c0ecd6130940fb2ee771196624f6fafdf9621 Mon Sep 17 00:00:00 2001 From: jneira Date: Tue, 21 Aug 2018 15:00:02 +0200 Subject: [PATCH 18/46] Add GenericPackageDescription as setupWrapper argument --- etlas-cabal/Distribution/Simple.hs | 14 ++++-- etlas/Distribution/Client/BinaryDist.hs | 15 +++---- etlas/Distribution/Client/Configure.hs | 4 +- etlas/Distribution/Client/Install.hs | 3 +- .../Client/PackageDescription/Dhall.hs | 12 ++--- etlas/Distribution/Client/ProjectBuilding.hs | 6 +-- etlas/Distribution/Client/SetupWrapper.hs | 44 +++++++++++-------- etlas/Distribution/Client/SrcDist.hs | 23 +++++----- etlas/main/Main.hs | 16 +++---- 9 files changed, 71 insertions(+), 66 deletions(-) diff --git a/etlas-cabal/Distribution/Simple.hs b/etlas-cabal/Distribution/Simple.hs index 85ed402..14aba6e 100644 --- a/etlas-cabal/Distribution/Simple.hs +++ b/etlas-cabal/Distribution/Simple.hs @@ -45,11 +45,12 @@ module Distribution.Simple ( module Distribution.Simple.Compiler, module Language.Haskell.Extension, -- * Simple interface - defaultMain, defaultMainNoRead, defaultMainArgs, + defaultMain, defaultMainNoRead, + defaultMainNoReadArgs, defaultMainArgs, -- * Customization UserHooks(..), Args, defaultMainWithHooks, defaultMainWithHooksArgs, - defaultMainWithHooksNoRead, + defaultMainWithHooksNoRead, defaultMainWithHooksNoReadArgs, -- ** Standard sets of hooks simpleUserHooks, autoconfUserHooks, @@ -139,10 +140,17 @@ defaultMainWithHooksArgs = defaultMainHelper defaultMainNoRead :: GenericPackageDescription -> IO () defaultMainNoRead = defaultMainWithHooksNoRead simpleUserHooks +defaultMainNoReadArgs :: GenericPackageDescription -> [String] -> IO () +defaultMainNoReadArgs = defaultMainWithHooksNoReadArgs simpleUserHooks + -- | A customizable version of 'defaultMainNoRead'. defaultMainWithHooksNoRead :: UserHooks -> GenericPackageDescription -> IO () defaultMainWithHooksNoRead hooks pkg_descr = - getArgs >>= + getArgs >>= defaultMainWithHooksNoReadArgs hooks pkg_descr + +defaultMainWithHooksNoReadArgs :: UserHooks -> GenericPackageDescription + -> [String] -> IO () +defaultMainWithHooksNoReadArgs hooks pkg_descr = defaultMainHelper hooks { readDesc = return (Just pkg_descr) } defaultMainHelper :: UserHooks -> Args -> IO () diff --git a/etlas/Distribution/Client/BinaryDist.hs b/etlas/Distribution/Client/BinaryDist.hs index 0c37d6f..d2ae85f 100644 --- a/etlas/Distribution/Client/BinaryDist.hs +++ b/etlas/Distribution/Client/BinaryDist.hs @@ -20,13 +20,8 @@ import Distribution.PackageDescription ( PackageDescription ) import Distribution.PackageDescription.Configuration ( flattenPackageDescription ) -#ifdef CABAL_PARSEC -import Distribution.PackageDescription.Parsec +import Distribution.Client.PackageDescription.Dhall ( readGenericPackageDescription ) -#else -import Distribution.PackageDescription.Parse - ( readGenericPackageDescription ) -#endif import Distribution.Simple.Utils ( createDirectoryIfMissingVerbose, defaultPackageDesc , withTempDirectory ) @@ -38,13 +33,13 @@ import Distribution.Simple.BuildPaths ( binPref ) import Distribution.Text ( display ) import System.FilePath (()) -import Control.Monad (liftM) -- |Create a binary distribution. bdist :: BDistFlags -> BDistExFlags -> IO () bdist flags exflags = do - pkg <- liftM flattenPackageDescription - (readGenericPackageDescription verbosity =<< defaultPackageDesc verbosity) + genPkg <- readGenericPackageDescription verbosity =<< defaultPackageDesc verbosity + let pkg = flattenPackageDescription genPkg + let withDir :: (FilePath -> IO a) -> IO a withDir = withTempDirectory verbosity tmpTargetDir "bdist." @@ -57,7 +52,7 @@ bdist flags exflags = do createDirectoryIfMissingVerbose verbosity True outDir createDirectoryIfMissingVerbose verbosity True tarBallPath - setupWrapper verbosity setupOpts (Just pkg) bdistCommand (const flags') [] + setupWrapper verbosity setupOpts (Just genPkg) (Just pkg) bdistCommand (const flags') [] createArchive verbosity pkg tmpDir tarBallPath diff --git a/etlas/Distribution/Client/Configure.hs b/etlas/Distribution/Client/Configure.hs index a01d32a..9de38f5 100644 --- a/etlas/Distribution/Client/Configure.hs +++ b/etlas/Distribution/Client/Configure.hs @@ -144,7 +144,7 @@ configure verbosity packageDBs repoCtxt binariesPath comp platform progdb ++ message ++ "\nTrying configure anyway." setupWrapper verbosity (setupScriptOptions installedPkgIndex Nothing) - Nothing configureCommand (const configFlags) extraArgs + Nothing Nothing configureCommand (const configFlags) extraArgs Right installPlan0 -> let installPlan = InstallPlan.configureInstallPlan configFlags installPlan0 @@ -397,7 +397,7 @@ configurePackage verbosity platform comp scriptOptions configFlags extraArgs = setupWrapper verbosity - scriptOptions (Just pkg) configureCommand configureFlags extraArgs + scriptOptions (Just gpkg) (Just pkg) configureCommand configureFlags extraArgs where gpkg = packageDescription spkg diff --git a/etlas/Distribution/Client/Install.hs b/etlas/Distribution/Client/Install.hs index 7d834a4..a6be33d 100644 --- a/etlas/Distribution/Client/Install.hs +++ b/etlas/Distribution/Client/Install.hs @@ -1592,8 +1592,7 @@ installUnpackedPackage verbosity installLock numJobs setupWrapper verbosity scriptOptions { useLoggingHandle = logFileHandle , useWorkingDir = workingDir } - (Just pkg) - cmd flags []) + Nothing (Just pkg) cmd flags []) withBuildTestDocs mLogPath action | isBinary = maybeBuildBinaries >> action DocsNotTried TestsNotTried | otherwise = do diff --git a/etlas/Distribution/Client/PackageDescription/Dhall.hs b/etlas/Distribution/Client/PackageDescription/Dhall.hs index 4896f65..cc9f916 100644 --- a/etlas/Distribution/Client/PackageDescription/Dhall.hs +++ b/etlas/Distribution/Client/PackageDescription/Dhall.hs @@ -18,7 +18,7 @@ import qualified Distribution.PackageDescription.Parsec as Cabal.Parse import Distribution.PackageDescription.Parse as Cabal.Parse ( readGenericPackageDescription , parseGenericPackageDescription, ParseResult(..) ) #endif -import Distribution.Simple.Utils (die') +import Distribution.Simple.Utils (die', info) import Lens.Micro ( set ) @@ -29,10 +29,10 @@ import Control.Monad (unless) readGenericPackageDescription :: Verbosity -> FilePath -> IO GenericPackageDescription readGenericPackageDescription verbosity path = - if (takeExtension path) == ".dhall" then - readDhallGenericPackageDescription verbosity path - else - Cabal.Parse.readGenericPackageDescription verbosity path + if (takeExtension path) == ".dhall" then + readDhallGenericPackageDescription verbosity path + else + Cabal.Parse.readGenericPackageDescription verbosity path readDhallGenericPackageDescription :: Verbosity -> FilePath -> IO GenericPackageDescription readDhallGenericPackageDescription verbosity dhallFilePath = do @@ -46,7 +46,7 @@ readDhallGenericPackageDescription verbosity dhallFilePath = do & set Dhall.sourceName dhallFilePath source <- StrictText.readFile dhallFilePath - + info verbosity $ "Reading package configuration from " ++ dhallFilePath genPkgDesc <- explaining $ dhallToCabal settings source -- TODO: It should use directly the `GenericPackageDescription` generated by dhall. -- However, it actually has not the `condTreeConstraints` field informed and diff --git a/etlas/Distribution/Client/ProjectBuilding.hs b/etlas/Distribution/Client/ProjectBuilding.hs index 98481d1..4e33163 100644 --- a/etlas/Distribution/Client/ProjectBuilding.hs +++ b/etlas/Distribution/Client/ProjectBuilding.hs @@ -1076,7 +1076,7 @@ buildAndInstallUnpackedPackage verbosity setupWrapper verbosity scriptOptions { useLoggingHandle = mLogFileHandle } - (Just (elabPkgDescription pkg)) + Nothing (Just (elabPkgDescription pkg)) cmd flags args mlogFile :: Maybe FilePath @@ -1313,14 +1313,14 @@ buildInplaceUnpackedPackage verbosity setupInteractive cmd flags args = setupWrapper verbosity scriptOptions { isInteractive = True } - (Just (elabPkgDescription pkg)) + Nothing (Just (elabPkgDescription pkg)) cmd flags args setup :: CommandUI flags -> (Version -> flags) -> [String] -> IO () setup cmd flags args = setupWrapper verbosity scriptOptions - (Just (elabPkgDescription pkg)) + Nothing (Just (elabPkgDescription pkg)) cmd flags args generateInstalledPackageInfo :: IO InstalledPackageInfo diff --git a/etlas/Distribution/Client/SetupWrapper.hs b/etlas/Distribution/Client/SetupWrapper.hs index 4645e9f..6b6b868 100644 --- a/etlas/Distribution/Client/SetupWrapper.hs +++ b/etlas/Distribution/Client/SetupWrapper.hs @@ -99,6 +99,7 @@ data Setup = Setup { setupMethod :: SetupMethod , setupScriptOptions :: SetupScriptOptions , setupVersion :: Version , setupBuildType :: BuildType + , setupGenericPackage :: GenericPackageDescription , setupPackage :: PackageDescription } @@ -245,6 +246,7 @@ defaultSetupScriptOptions = SetupScriptOptions { type SetupRunner = Verbosity -> SetupScriptOptions -> BuildType + -> GenericPackageDescription -> [String] -> IO () @@ -254,11 +256,13 @@ type SetupRunner = Verbosity -- 'setupScriptOptions'. getSetup :: Verbosity -> SetupScriptOptions + -> Maybe GenericPackageDescription -> Maybe PackageDescription -> IO Setup -getSetup verbosity options mpkg = do - pkg <- maybe getPkg return mpkg - let options' = options { +getSetup verbosity options mgenPkg mpkg = do + genPkg <- maybe getGenPkg return mgenPkg + let pkg = fromMaybe (packageDescription genPkg) mpkg + options' = options { useCabalVersion = intersectVersionRanges (useCabalVersion options) (orLaterVersion (specVersion pkg)) @@ -271,12 +275,12 @@ getSetup verbosity options mpkg = do , setupScriptOptions = options'' , setupVersion = version , setupBuildType = buildType' + , setupGenericPackage = genPkg , setupPackage = pkg } where - getPkg = tryFindPackageDesc (fromMaybe "." (useWorkingDir options)) - >>= readGenericPackageDescription verbosity - >>= return . packageDescription + getGenPkg = tryFindPackageDesc (fromMaybe "." (useWorkingDir options)) + >>= readGenericPackageDescription verbosity checkBuildType (UnknownBuildType name) = die' verbosity $ "The build-type '" ++ name ++ "' is not known. Use one of: " @@ -319,13 +323,14 @@ runSetup verbosity setup args0 = do let method = setupMethod setup options = setupScriptOptions setup bt = setupBuildType setup + genPkg = setupGenericPackage setup args = verbosityHack (setupVersion setup) args0 when (verbosity >= deafening {- avoid test if not debug -} && args /= args0) $ infoNoWrap verbose $ "Applied verbosity hack:\n" ++ " Before: " ++ show args0 ++ "\n" ++ " After: " ++ show args ++ "\n" - runSetupMethod method verbosity options bt args + runSetupMethod method verbosity options bt genPkg args -- | This is a horrible hack to make sure passing fancy verbosity -- flags (e.g., @-v'info +callstack'@) doesn't break horribly on @@ -369,14 +374,15 @@ runSetupCommand verbosity setup cmd flags extraArgs = do -- may depend on the Cabal library version in use. setupWrapper :: Verbosity -> SetupScriptOptions + -> Maybe GenericPackageDescription -> Maybe PackageDescription -> CommandUI flags -> (Version -> flags) -- ^ produce command flags given the etlas-cabal library version -> [String] -> IO () -setupWrapper verbosity options mpkg cmd flags extraArgs = do - setup <- getSetup verbosity options mpkg +setupWrapper verbosity options mgenPkg mpkg cmd flags extraArgs = do + setup <- getSetup verbosity options mgenPkg mpkg runSetupCommand verbosity setup cmd (flags $ setupVersion setup) extraArgs -- ------------------------------------------------------------ @@ -384,24 +390,24 @@ setupWrapper verbosity options mpkg cmd flags extraArgs = do -- ------------------------------------------------------------ internalSetupMethod :: SetupRunner -internalSetupMethod verbosity options bt args = do +internalSetupMethod verbosity options bt genPkg args = do info verbosity $ "Using internal setup method with build-type " ++ show bt ++ " and args:\n " ++ show args inDir (useWorkingDir options) $ do withEnv "ETA_DIST_DIR" (useDistPref options) $ withExtraPathEnv (useExtraPathEnv options) $ - buildTypeAction bt args + buildTypeAction bt genPkg args -buildTypeAction :: BuildType -> ([String] -> IO ()) -buildTypeAction Simple = Simple.defaultMainArgs -buildTypeAction Configure = Simple.defaultMainWithHooksArgs +buildTypeAction :: BuildType -> GenericPackageDescription + -> ([String] -> IO ()) +buildTypeAction Simple = Simple.defaultMainNoReadArgs +buildTypeAction Configure = Simple.defaultMainWithHooksNoReadArgs Simple.autoconfUserHooks -buildTypeAction Make = Make.defaultMainArgs +buildTypeAction Make = const Make.defaultMainArgs -- TODO: Change the following once you support custom build types -buildTypeAction Custom = Simple.defaultMainArgs +buildTypeAction Custom = Simple.defaultMainNoReadArgs buildTypeAction (UnknownBuildType _) = error "buildTypeAction UnknownBuildType" - -- | @runProcess'@ is a version of @runProcess@ where we have -- the additional option to decide whether or not we should -- delegate CTRL+C to the spawned process. @@ -436,7 +442,7 @@ runProcess' cmd args mb_cwd mb_env mb_stdin mb_stdout mb_stderr _delegate = do -- ------------------------------------------------------------ selfExecSetupMethod :: SetupRunner -selfExecSetupMethod verbosity options bt args0 = do +selfExecSetupMethod verbosity options bt _ args0 = do let args = ["act-as-setup", "--build-type=" ++ display bt, "--"] ++ args0 @@ -466,7 +472,7 @@ selfExecSetupMethod verbosity options bt args0 = do -- ------------------------------------------------------------ externalSetupMethod :: WithCallStack (FilePath -> SetupRunner) -externalSetupMethod path verbosity options _ args = do +externalSetupMethod path verbosity options _ _ args = do info verbosity $ unwords (path : args) case useLoggingHandle options of Nothing -> return () diff --git a/etlas/Distribution/Client/SrcDist.hs b/etlas/Distribution/Client/SrcDist.hs index 980e44e..3e44b2f 100644 --- a/etlas/Distribution/Client/SrcDist.hs +++ b/etlas/Distribution/Client/SrcDist.hs @@ -22,13 +22,8 @@ import Distribution.PackageDescription ( PackageDescription ) import Distribution.PackageDescription.Configuration ( flattenPackageDescription ) -#ifdef CABAL_PARSEC -import Distribution.PackageDescription.Parsec +import Distribution.Client.PackageDescription.Dhall ( readGenericPackageDescription ) -#else -import Distribution.PackageDescription.Parse - ( readGenericPackageDescription ) -#endif import Distribution.Simple.Utils ( createDirectoryIfMissingVerbose, defaultPackageDesc , warn, die', notice, withTempDirectory ) @@ -49,7 +44,7 @@ import Distribution.Client.Utils import Distribution.Compat.Exception (catchIO) import System.FilePath ((), (<.>), normalise) -import Control.Monad (when, unless, liftM) +import Control.Monad (when, unless) import System.Directory (doesFileExist, removeFile, canonicalizePath, getTemporaryDirectory) import System.Process (runProcess, waitForProcess) import System.Exit (ExitCode(..)) @@ -58,8 +53,9 @@ import Control.Exception (IOException, evaluate) -- |Create a source distribution. sdist :: SDistFlags -> SDistExFlags -> IO () sdist flags exflags = do - pkg <- liftM flattenPackageDescription - (readGenericPackageDescription verbosity =<< defaultPackageDesc verbosity) + genPkg <- readGenericPackageDescription verbosity =<< defaultPackageDesc verbosity + let pkg = flattenPackageDescription genPkg + let withDir :: (FilePath -> IO a) -> IO a withDir = if not needMakeArchive then \f -> f tmpTargetDir else withTempDirectory verbosity tmpTargetDir "sdist." @@ -76,7 +72,7 @@ sdist flags exflags = do -- Run 'setup sdist --output-directory=tmpDir' (or -- '--list-source'/'--output-directory=someOtherDir') in case we were passed -- those options. - setupWrapper verbosity setupOpts (Just pkg) sdistCommand (const flags') [] + setupWrapper verbosity setupOpts (Just genPkg) (Just pkg) sdistCommand (const flags') [] -- Unless we were given --list-sources or --output-directory ourselves, -- create an archive. @@ -163,10 +159,11 @@ createZipArchive isBin verbosity pkg tmpDir targetPref = do allPackageSourceFiles :: Verbosity -> SetupScriptOptions -> FilePath -> IO [FilePath] allPackageSourceFiles verbosity setupOpts0 packageDir = do - pkg <- do + genPkg <- do let err = "Error reading source files of package." desc <- tryFindAddSourcePackageDesc verbosity packageDir err - flattenPackageDescription `fmap` readGenericPackageDescription verbosity desc + readGenericPackageDescription verbosity desc + let pkg = flattenPackageDescription genPkg globalTmp <- getTemporaryDirectory withTempDirectory verbosity globalTmp "etlas-list-sources." $ \tempDir -> do let file = tempDir "etlas-sdist-list-sources" @@ -185,7 +182,7 @@ allPackageSourceFiles verbosity setupOpts0 packageDir = do doListSources :: IO [FilePath] doListSources = do - setupWrapper verbosity setupOpts (Just pkg) sdistCommand (const flags) [] + setupWrapper verbosity setupOpts (Just genPkg) (Just pkg) sdistCommand (const flags) [] fmap lines . readFile $ file onFailedListSources :: IOException -> IO () diff --git a/etlas/main/Main.hs b/etlas/main/Main.hs index a34e52d..125b089 100644 --- a/etlas/main/Main.hs +++ b/etlas/main/Main.hs @@ -356,7 +356,7 @@ wrapperAction command verbosityFlag distPrefFlag = let config = either (\(SomeException _) -> mempty) snd load distPref <- findSavedDistPref config (distPrefFlag flags) let setupScriptOptions = defaultSetupScriptOptions { useDistPref = distPref } - setupWrapper verbosity setupScriptOptions Nothing + setupWrapper verbosity setupScriptOptions Nothing Nothing command (const flags) extraArgs configureAction :: (ConfigFlags, ConfigExFlags) @@ -522,7 +522,7 @@ buildAction (buildFlags, buildExFlags) extraArgs globalFlags = do -- 'reconfigure' twice. build :: Verbosity -> SavedConfig -> FilePath -> BuildFlags -> [String] -> IO () build verbosity config distPref buildFlags extraArgs = - setupWrapper verbosity setupOptions Nothing + setupWrapper verbosity setupOptions Nothing Nothing (Cabal.buildCommand progDb) mkBuildFlags extraArgs where progDb = defaultProgramDb @@ -588,7 +588,7 @@ replAction (replFlags, buildExFlags) extraArgs globalFlags = do nixShell verbosity distPref globalFlags config $ do maybeWithSandboxDirOnSearchPath useSandbox $ - setupWrapper verbosity setupOptions Nothing + setupWrapper verbosity setupOptions Nothing Nothing (Cabal.replCommand progDb) (const replFlags') extraArgs -- No .cabal file in the current directory: just start the REPL (possibly @@ -616,7 +616,7 @@ installAction (configFlags, _, installFlags, _) _ globalFlags let setupOpts = defaultSetupScriptOptions { useDistPref = dist } nixShellIfSandboxed verb dist globalFlags config useSandbox $ setupWrapper - verb setupOpts Nothing + verb setupOpts Nothing Nothing installCommand (const mempty) [] installAction @@ -746,7 +746,7 @@ testAction (testFlags, buildFlags, buildExFlags) extraArgs globalFlags = do build verbosity config distPref buildFlags' extraArgs' maybeWithSandboxDirOnSearchPath useSandbox $ - setupWrapper verbosity setupOptions Nothing + setupWrapper verbosity setupOptions Nothing Nothing Cabal.testCommand (const testFlags') extraArgs' data ComponentNames = ComponentNamesUnknown @@ -829,7 +829,7 @@ benchmarkAction build verbosity config' distPref buildFlags' extraArgs' maybeWithSandboxDirOnSearchPath useSandbox $ - setupWrapper verbosity setupOptions Nothing + setupWrapper verbosity setupOptions Nothing Nothing Cabal.benchmarkCommand (const benchmarkFlags') extraArgs' haddockAction :: HaddockFlags -> [String] -> Action @@ -847,7 +847,7 @@ haddockAction haddockFlags extraArgs globalFlags = do haddockFlags { haddockDistPref = toFlag distPref } setupScriptOptions = defaultSetupScriptOptions { useDistPref = distPref } - setupWrapper verbosity setupScriptOptions Nothing + setupWrapper verbosity setupScriptOptions Nothing Nothing haddockCommand (const haddockFlags') extraArgs when (haddockForHackage haddockFlags == Flag ForHackage) $ do pkg <- fmap LBI.localPkgDescr (getPersistBuildConfig distPref) @@ -867,7 +867,7 @@ cleanAction cleanFlags extraArgs globalFlags = do , useWin32CleanHack = True } cleanFlags' = cleanFlags { cleanDistPref = toFlag distPref } - setupWrapper verbosity setupScriptOptions Nothing + setupWrapper verbosity setupScriptOptions Nothing Nothing cleanCommand (const cleanFlags') extraArgs where verbosity = fromFlagOrDefault normal (cleanVerbosity cleanFlags) From 0a78baea1c7ffcbc0244e4d5053232f14ed06ab4 Mon Sep 17 00:00:00 2001 From: jneira Date: Wed, 22 Aug 2018 15:00:15 +0200 Subject: [PATCH 19/46] complete readGenericPackageDescription using dhall file --- etlas/Distribution/Client/Check.hs | 7 ++----- etlas/Distribution/Client/Configure.hs | 7 +------ etlas/Distribution/Client/IndexUtils.hs | 5 ++--- .../Client/PackageDescription/Dhall.hs | 21 ++++++++++++++----- etlas/Distribution/Client/Sandbox.hs | 7 ++----- 5 files changed, 23 insertions(+), 24 deletions(-) diff --git a/etlas/Distribution/Client/Check.hs b/etlas/Distribution/Client/Check.hs index 76e5e5c..8e73662 100644 --- a/etlas/Distribution/Client/Check.hs +++ b/etlas/Distribution/Client/Check.hs @@ -18,11 +18,8 @@ module Distribution.Client.Check ( import Control.Monad ( when, unless ) -#ifdef CABAL_PARSEC -import Distribution.PackageDescription.Parsec ( readGenericPackageDescription ) -#else -import Distribution.PackageDescription.Parse ( readGenericPackageDescription ) -#endif +import Distribution.Client.PackageDescription.Dhall + ( readGenericPackageDescription ) import Distribution.PackageDescription.Check import Distribution.PackageDescription.Configuration diff --git a/etlas/Distribution/Client/Configure.hs b/etlas/Distribution/Client/Configure.hs index 9de38f5..92a75f2 100644 --- a/etlas/Distribution/Client/Configure.hs +++ b/etlas/Distribution/Client/Configure.hs @@ -68,13 +68,8 @@ import Distribution.Package import Distribution.Types.Dependency ( Dependency(..), thisPackageVersion ) import qualified Distribution.PackageDescription as PkgDesc -#ifdef CABAL_PARSEC -import Distribution.PackageDescription.Parsec +import Distribution.Client.PackageDescription.Dhall ( readGenericPackageDescription ) -#else -import Distribution.PackageDescription.Parse - ( readGenericPackageDescription ) -#endif import Distribution.PackageDescription.Configuration ( finalizePD ) import Distribution.Version diff --git a/etlas/Distribution/Client/IndexUtils.hs b/etlas/Distribution/Client/IndexUtils.hs index 6be1da1..32a1c6f 100644 --- a/etlas/Distribution/Client/IndexUtils.hs +++ b/etlas/Distribution/Client/IndexUtils.hs @@ -79,11 +79,11 @@ import Distribution.Client.Setup ( RepoContext(..), updateCommand ) import Distribution.Simple.Command import qualified Distribution.Simple.Eta as Eta - +import qualified Distribution.Client.PackageDescription.Dhall as PackageDesc.Parse + ( readGenericPackageDescription ) #ifdef CABAL_PARSEC import Distribution.PackageDescription.Parsec ( parseGenericPackageDescriptionMaybe ) -import qualified Distribution.PackageDescription.Parsec as PackageDesc.Parse #else import Distribution.ParseUtils ( ParseResult(..) ) @@ -91,7 +91,6 @@ import Distribution.PackageDescription.Parse ( parseGenericPackageDescription ) import Distribution.Simple.Utils ( fromUTF8, ignoreBOM ) -import qualified Distribution.PackageDescription.Parse as PackageDesc.Parse #endif import Distribution.Solver.Types.PackageIndex (PackageIndex) diff --git a/etlas/Distribution/Client/PackageDescription/Dhall.hs b/etlas/Distribution/Client/PackageDescription/Dhall.hs index cc9f916..ec141d7 100644 --- a/etlas/Distribution/Client/PackageDescription/Dhall.hs +++ b/etlas/Distribution/Client/PackageDescription/Dhall.hs @@ -10,20 +10,23 @@ import DhallToCabal (dhallToCabal) import Distribution.Verbosity import Distribution.PackageDescription -import Distribution.PackageDescription.PrettyPrint (showGenericPackageDescription) +import Distribution.PackageDescription.PrettyPrint + (showGenericPackageDescription) #ifdef CABAL_PARSEC import qualified Distribution.PackageDescription.Parsec as Cabal.Parse - ( readGenericPackageDescription, parseGenericPackageDescriptionMaybe ) + (readGenericPackageDescription, parseGenericPackageDescriptionMaybe) #else import Distribution.PackageDescription.Parse as Cabal.Parse - ( readGenericPackageDescription , parseGenericPackageDescription, ParseResult(..) ) + (readGenericPackageDescription , parseGenericPackageDescription, ParseResult(..)) #endif import Distribution.Simple.Utils (die', info) -import Lens.Micro ( set ) +import Distribution.Client.DistDirLayout + +import Lens.Micro (set) import System.Directory (doesFileExist) -import System.FilePath (takeDirectory, takeExtension) +import System.FilePath (takeDirectory, takeExtension, ()) import Control.Monad (unless) @@ -71,3 +74,11 @@ parseCabalGenericPackageDescription content = ParseOk _ pkg -> Just pkg _ -> Nothing #endif + +writeDerivedCabalFile :: Verbosity -> DistDirLayout -> GenericPackageDescription -> IO () +writeDerivedCabalFile verbosity distDirLayout _genPkg = do + let distCacheDir = distProjectCacheDirectory distDirLayout + path = distCacheDir "etlas.dhall.cabal" + info verbosity $ "Writing derived from dhall cabal file: " ++ path + -- writeGenericPackageDescription + diff --git a/etlas/Distribution/Client/Sandbox.hs b/etlas/Distribution/Client/Sandbox.hs index 27882a9..48811e4 100644 --- a/etlas/Distribution/Client/Sandbox.hs +++ b/etlas/Distribution/Client/Sandbox.hs @@ -80,11 +80,8 @@ import Distribution.Client.Utils ( inDir, tryCanonicalizePath , tryFindAddSourcePackageDesc) import Distribution.PackageDescription.Configuration ( flattenPackageDescription ) -#ifdef CABAL_PARSEC -import Distribution.PackageDescription.Parsec ( readGenericPackageDescription ) -#else -import Distribution.PackageDescription.Parse ( readGenericPackageDescription ) -#endif +import Distribution.Client.PackageDescription.Dhall + ( readGenericPackageDescription ) import Distribution.Simple.Compiler ( Compiler(..), PackageDB(..) ) import Distribution.Simple.Configure ( configCompilerAuxEx , getPackageDBContents From 4eecccebbdae9f12299581525370b06ac44a6faf Mon Sep 17 00:00:00 2001 From: jneira Date: Fri, 24 Aug 2018 13:41:47 +0200 Subject: [PATCH 20/46] stick to master version --- dhall-to-etlas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/dhall-to-etlas b/dhall-to-etlas index f619a15..e0e7e60 160000 --- a/dhall-to-etlas +++ b/dhall-to-etlas @@ -1 +1 @@ -Subproject commit f619a1530290d9bae23e90aa57fe2c8eb7cbe7ca +Subproject commit e0e7e60ef449229db6de938817cab95a6a039bcd From f1658f99d8443d16a5f2cad0860143c7f3c823c2 Mon Sep 17 00:00:00 2001 From: jneira Date: Fri, 24 Aug 2018 13:42:27 +0200 Subject: [PATCH 21/46] use dhall version with caching hashed imports --- stack.yaml | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/stack.yaml b/stack.yaml index ff5e6b9..04c9980 100644 --- a/stack.yaml +++ b/stack.yaml @@ -5,7 +5,9 @@ extra-deps: - ed25519-0.0.5.0 - mintty-0.1.1 - parsec-3.1.13.0 -- dhall-1.16.1 +# - dhall-1.16.1 +- git: https://github.com/eta-lang/dhall-haskell.git + commit: afb6315dd3ad075d0a3681e449298a9da3c5e073 - ansi-terminal-0.7.1.1 - ansi-wl-pprint-0.6.8.2 - cryptonite-0.24 @@ -29,6 +31,8 @@ extra-deps: - th-abstraction-0.2.6.0 - hashable-1.2.7.0 - Diff-0.3.4 +- cborg-0.2.0.0 +- serialise-0.2.0.0 resolver: lts-6.27 flags: etlas-cabal: From a354ed4568853a203a2a1959219d2df79c1ac7da Mon Sep 17 00:00:00 2001 From: jneira Date: Fri, 24 Aug 2018 13:42:59 +0200 Subject: [PATCH 22/46] remove unnecesary log --- etlas-cabal/Distribution/Simple.hs | 3 --- 1 file changed, 3 deletions(-) diff --git a/etlas-cabal/Distribution/Simple.hs b/etlas-cabal/Distribution/Simple.hs index 14aba6e..e1644d9 100644 --- a/etlas-cabal/Distribution/Simple.hs +++ b/etlas-cabal/Distribution/Simple.hs @@ -247,9 +247,6 @@ confPkgDescr hooks verbosity mb_path = do pdfile <- case mb_path of Nothing -> defaultPackageDesc verbosity Just path -> return path -#ifdef CABAL_PARSEC - info verbosity "Using Parsec parser" -#endif descr <- readGenericPackageDescription verbosity pdfile return (Just pdfile, descr) From 7022ccb2f453dd181527fea8c8826d6386d51c06 Mon Sep 17 00:00:00 2001 From: jneira Date: Fri, 24 Aug 2018 14:45:56 +0200 Subject: [PATCH 23/46] Write derived cabal file before self exec methods in setupWrapper --- .../Client/PackageDescription/Dhall.hs | 15 ++++++--------- etlas/Distribution/Client/SetupWrapper.hs | 9 ++++++++- 2 files changed, 14 insertions(+), 10 deletions(-) diff --git a/etlas/Distribution/Client/PackageDescription/Dhall.hs b/etlas/Distribution/Client/PackageDescription/Dhall.hs index ec141d7..07a8e4a 100644 --- a/etlas/Distribution/Client/PackageDescription/Dhall.hs +++ b/etlas/Distribution/Client/PackageDescription/Dhall.hs @@ -11,7 +11,7 @@ import DhallToCabal (dhallToCabal) import Distribution.Verbosity import Distribution.PackageDescription import Distribution.PackageDescription.PrettyPrint - (showGenericPackageDescription) + (showGenericPackageDescription, writeGenericPackageDescription) #ifdef CABAL_PARSEC import qualified Distribution.PackageDescription.Parsec as Cabal.Parse (readGenericPackageDescription, parseGenericPackageDescriptionMaybe) @@ -21,8 +21,6 @@ import Distribution.PackageDescription.Parse as Cabal.Parse #endif import Distribution.Simple.Utils (die', info) -import Distribution.Client.DistDirLayout - import Lens.Micro (set) import System.Directory (doesFileExist) @@ -75,10 +73,9 @@ parseCabalGenericPackageDescription content = _ -> Nothing #endif -writeDerivedCabalFile :: Verbosity -> DistDirLayout -> GenericPackageDescription -> IO () -writeDerivedCabalFile verbosity distDirLayout _genPkg = do - let distCacheDir = distProjectCacheDirectory distDirLayout - path = distCacheDir "etlas.dhall.cabal" - info verbosity $ "Writing derived from dhall cabal file: " ++ path - -- writeGenericPackageDescription +writeDerivedCabalFile :: Verbosity -> FilePath -> GenericPackageDescription -> IO () +writeDerivedCabalFile verbosity dir genPkg = do + let path = dir "etlas.dhall.cabal" + info verbosity $ "Writing derived cabal file from dhall file: " ++ path + writeGenericPackageDescription path genPkg diff --git a/etlas/Distribution/Client/SetupWrapper.hs b/etlas/Distribution/Client/SetupWrapper.hs index 6b6b868..1c0e4dd 100644 --- a/etlas/Distribution/Client/SetupWrapper.hs +++ b/etlas/Distribution/Client/SetupWrapper.hs @@ -37,7 +37,8 @@ import Distribution.PackageDescription , PackageDescription(..), specVersion , BuildType(..), knownBuildTypes ) import Distribution.Client.PackageDescription.Dhall - ( readGenericPackageDescription ) + ( readGenericPackageDescription + , writeDerivedCabalFile) import Distribution.Simple.Compiler ( Compiler, PackageDB(..), PackageDBStack ) @@ -383,6 +384,12 @@ setupWrapper :: Verbosity -> IO () setupWrapper verbosity options mgenPkg mpkg cmd flags extraArgs = do setup <- getSetup verbosity options mgenPkg mpkg + case setupMethod setup of + InternalMethod -> return () + _ -> do let dir = useDistPref options + genPkg = setupGenericPackage setup + writeDerivedCabalFile verbosity dir genPkg + runSetupCommand verbosity setup cmd (flags $ setupVersion setup) extraArgs -- ------------------------------------------------------------ From 770c87c8f97f2e063ce38a7758e18b463cf65b70 Mon Sep 17 00:00:00 2001 From: jneira Date: Sun, 26 Aug 2018 23:18:17 +0200 Subject: [PATCH 24/46] write derived cabal file before self exec mehod --- .../Client/PackageDescription/Dhall.hs | 4 ++- etlas/Distribution/Client/SetupWrapper.hs | 28 +++++++++++++------ 2 files changed, 22 insertions(+), 10 deletions(-) diff --git a/etlas/Distribution/Client/PackageDescription/Dhall.hs b/etlas/Distribution/Client/PackageDescription/Dhall.hs index 07a8e4a..432f828 100644 --- a/etlas/Distribution/Client/PackageDescription/Dhall.hs +++ b/etlas/Distribution/Client/PackageDescription/Dhall.hs @@ -73,9 +73,11 @@ parseCabalGenericPackageDescription content = _ -> Nothing #endif -writeDerivedCabalFile :: Verbosity -> FilePath -> GenericPackageDescription -> IO () +writeDerivedCabalFile :: Verbosity -> FilePath + -> GenericPackageDescription -> IO FilePath writeDerivedCabalFile verbosity dir genPkg = do let path = dir "etlas.dhall.cabal" info verbosity $ "Writing derived cabal file from dhall file: " ++ path writeGenericPackageDescription path genPkg + return path diff --git a/etlas/Distribution/Client/SetupWrapper.hs b/etlas/Distribution/Client/SetupWrapper.hs index 1c0e4dd..371ba52 100644 --- a/etlas/Distribution/Client/SetupWrapper.hs +++ b/etlas/Distribution/Client/SetupWrapper.hs @@ -90,7 +90,7 @@ import Distribution.Simple.Utils import Control.Exception ( bracket ) import System.FilePath ( takeDirectory, (), (<.>) ) -import System.Directory ( doesDirectoryExist ) +import System.Directory ( doesDirectoryExist, doesFileExist ) import qualified System.Win32 as Win32 #endif @@ -113,7 +113,7 @@ data SetupMethod = InternalMethod -- child process | ExternalMethod FilePath -- ^ run Cabal commands through a custom \"Setup\" executable - + deriving (Eq) --TODO: The 'setupWrapper' and 'SetupScriptOptions' should be split into two -- parts: one that has no policy and just does as it's told with all the -- explicit options, and an optional initial part that applies certain @@ -384,13 +384,23 @@ setupWrapper :: Verbosity -> IO () setupWrapper verbosity options mgenPkg mpkg cmd flags extraArgs = do setup <- getSetup verbosity options mgenPkg mpkg - case setupMethod setup of - InternalMethod -> return () - _ -> do let dir = useDistPref options - genPkg = setupGenericPackage setup - writeDerivedCabalFile verbosity dir genPkg - - runSetupCommand verbosity setup cmd (flags $ setupVersion setup) extraArgs + + existEtlasDhallFile <- doesFileExist $ + (fromMaybe "." (useWorkingDir options)) "etlas.dhall" + let needDerivedCabalFile = setupMethod setup == SelfExecMethod + && commandName cmd == "configure" + && not ( "cabal-file" `elem` extraArgs ) + && existEtlasDhallFile + + cabalFileArg <- + if needDerivedCabalFile then do + let dir = useDistPref options + genPkg = setupGenericPackage setup + cabalFilePath <- writeDerivedCabalFile verbosity dir genPkg + return ["--cabal-file", cabalFilePath] + else return [] + let extraArgs' = extraArgs ++ cabalFileArg + runSetupCommand verbosity setup cmd (flags $ setupVersion setup) extraArgs' -- ------------------------------------------------------------ -- * Internal SetupMethod From e2d2e06150d06dabfaf5186fccceb045bbbae29b Mon Sep 17 00:00:00 2001 From: jneira Date: Mon, 27 Aug 2018 08:48:38 +0200 Subject: [PATCH 25/46] bump up dhall-to-etlas to last master --- dhall-to-etlas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/dhall-to-etlas b/dhall-to-etlas index e0e7e60..f9c28b4 160000 --- a/dhall-to-etlas +++ b/dhall-to-etlas @@ -1 +1 @@ -Subproject commit e0e7e60ef449229db6de938817cab95a6a039bcd +Subproject commit f9c28b48b8b639e5608d0b9f8bd6f841203829a1 From 225d8e2233792e2887e710798857ab5b7008dfd3 Mon Sep 17 00:00:00 2001 From: jneira Date: Mon, 27 Aug 2018 14:46:41 +0200 Subject: [PATCH 26/46] Examine flags to honor --cabal-file arg --- etlas/Distribution/Client/SetupWrapper.hs | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/etlas/Distribution/Client/SetupWrapper.hs b/etlas/Distribution/Client/SetupWrapper.hs index 371ba52..b052d00 100644 --- a/etlas/Distribution/Client/SetupWrapper.hs +++ b/etlas/Distribution/Client/SetupWrapper.hs @@ -387,10 +387,12 @@ setupWrapper verbosity options mgenPkg mpkg cmd flags extraArgs = do existEtlasDhallFile <- doesFileExist $ (fromMaybe "." (useWorkingDir options)) "etlas.dhall" - let needDerivedCabalFile = setupMethod setup == SelfExecMethod + let flags' = flags $ setupVersion setup + needDerivedCabalFile = setupMethod setup == SelfExecMethod && commandName cmd == "configure" - && not ( "cabal-file" `elem` extraArgs ) + && not ( "cabal-file" `elem` allArgs ) && existEtlasDhallFile + where allArgs = commandShowOptions cmd flags' ++ extraArgs cabalFileArg <- if needDerivedCabalFile then do @@ -399,8 +401,10 @@ setupWrapper verbosity options mgenPkg mpkg cmd flags extraArgs = do cabalFilePath <- writeDerivedCabalFile verbosity dir genPkg return ["--cabal-file", cabalFilePath] else return [] + let extraArgs' = extraArgs ++ cabalFileArg - runSetupCommand verbosity setup cmd (flags $ setupVersion setup) extraArgs' + + runSetupCommand verbosity setup cmd flags' extraArgs' -- ------------------------------------------------------------ -- * Internal SetupMethod From 255ea7d20b32ec878725aa51621ef1463fa97258 Mon Sep 17 00:00:00 2001 From: jneira Date: Mon, 27 Aug 2018 15:01:15 +0200 Subject: [PATCH 27/46] add etlas.dhall file case to (old-)install tarball --- etlas/Distribution/Client/Targets.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/etlas/Distribution/Client/Targets.hs b/etlas/Distribution/Client/Targets.hs index 4b7c6e1..e16ac4e 100644 --- a/etlas/Distribution/Client/Targets.hs +++ b/etlas/Distribution/Client/Targets.hs @@ -520,12 +520,14 @@ readPackageTarget verbosity = traverse modifyLocation _ -> Left noCabalFile _files -> Left multipleCabalFiles where - noCabalFile = "No cabal file found" + noCabalFile = "No cabal or etlas.dhall file found" multipleCabalFiles = "Multiple cabal files found" isCabalFile e = case splitPath (Tar.entryPath e) of [ _dir, file] -> takeExtension file == ".cabal" + || file == "etlas.dhall" [".", _dir, file] -> takeExtension file == ".cabal" + || file == "etlas.dhall" _ -> False parsePackageDescription' :: BS.ByteString -> Maybe GenericPackageDescription From 79b0d0598b195d00a9a733630153a080bc3c1d2f Mon Sep 17 00:00:00 2001 From: jneira Date: Tue, 28 Aug 2018 06:40:25 +0200 Subject: [PATCH 28/46] Initial support for etlas.dhall in Targets --- .../Client/PackageDescription/Dhall.hs | 19 +++- etlas/Distribution/Client/Targets.hs | 91 ++++++++++--------- 2 files changed, 64 insertions(+), 46 deletions(-) diff --git a/etlas/Distribution/Client/PackageDescription/Dhall.hs b/etlas/Distribution/Client/PackageDescription/Dhall.hs index 432f828..921b6e6 100644 --- a/etlas/Distribution/Client/PackageDescription/Dhall.hs +++ b/etlas/Distribution/Client/PackageDescription/Dhall.hs @@ -3,6 +3,8 @@ module Distribution.Client.PackageDescription.Dhall where import qualified Data.ByteString.Char8 as BS.Char8 import Data.Function ( (&) ) + +import qualified Data.Text as StrictText import qualified Data.Text.IO as StrictText import qualified Dhall @@ -42,13 +44,11 @@ readDhallGenericPackageDescription verbosity dhallFilePath = do die' verbosity $ "Error Parsing: file \"" ++ dhallFilePath ++ "\" doesn't exist. Cannot continue." - let settings = Dhall.defaultInputSettings - & set Dhall.rootDirectory ( takeDirectory dhallFilePath ) - & set Dhall.sourceName dhallFilePath - source <- StrictText.readFile dhallFilePath info verbosity $ "Reading package configuration from " ++ dhallFilePath - genPkgDesc <- explaining $ dhallToCabal settings source + genPkgDesc <- explaining $ parseGenericPackageDescriptionFromDhall + dhallFilePath source + -- TODO: It should use directly the `GenericPackageDescription` generated by dhall. -- However, it actually has not the `condTreeConstraints` field informed and -- this make it unusable to be consumed by etlas/cabal @@ -73,6 +73,15 @@ parseCabalGenericPackageDescription content = _ -> Nothing #endif +parseGenericPackageDescriptionFromDhall :: FilePath -> StrictText.Text + -> IO GenericPackageDescription +parseGenericPackageDescriptionFromDhall dhallFilePath content = do + let settings = Dhall.defaultInputSettings + & set Dhall.rootDirectory ( takeDirectory dhallFilePath ) + & set Dhall.sourceName dhallFilePath + dhallToCabal settings content + + writeDerivedCabalFile :: Verbosity -> FilePath -> GenericPackageDescription -> IO FilePath writeDerivedCabalFile verbosity dir genPkg = do diff --git a/etlas/Distribution/Client/Targets.hs b/etlas/Distribution/Client/Targets.hs index e16ac4e..455c857 100644 --- a/etlas/Distribution/Client/Targets.hs +++ b/etlas/Distribution/Client/Targets.hs @@ -95,13 +95,14 @@ import Distribution.Simple.Utils import qualified Data.ByteString.Lazy.Char8 as BS.Char8 #endif import Distribution.Client.PackageDescription.Dhall - ( readGenericPackageDescription ) + ( readGenericPackageDescription, parseGenericPackageDescriptionFromDhall ) -- import Data.List ( find, nub ) import Data.Either ( partitionEithers ) import qualified Data.Map as Map import qualified Data.ByteString.Lazy as BS +import qualified Data.Text.Encoding as StrictText import qualified Distribution.Client.GZipUtils as GZipUtils import Control.Monad (mapM) import qualified Distribution.Compat.ReadP as Parse @@ -110,7 +111,7 @@ import Distribution.Compat.ReadP import Distribution.ParseUtils ( readPToMaybe ) import System.FilePath - ( takeExtension, dropExtension, takeDirectory, splitPath ) + ( takeExtension, dropExtension, takeDirectory, takeFileName, splitPath ) import System.Directory ( doesFileExist, doesDirectoryExist ) import Network.URI @@ -156,7 +157,7 @@ data UserTarget = -- > etlas install foo.cabal -- > etlas install ../lib/other/bar.cabal -- - | UserTargetLocalCabalFile FilePath + | UserTargetLocalPkgConfigFile FilePath -- | A specific package that is available as a local tarball file -- @@ -214,30 +215,31 @@ readUserTarget targetstr = where testNamedTargets = readPToMaybe parseDependencyOrPackageId - testFileTargets filename = do - isDir <- doesDirectoryExist filename - isFile <- doesFileExist filename - parentDirExists <- case takeDirectory filename of + testFileTargets path = do + isDir <- doesDirectoryExist path + isFile <- doesFileExist path + parentDirExists <- case takeDirectory path of [] -> return False dir -> doesDirectoryExist dir let result | isDir - = Just (Right (UserTargetLocalDir filename)) + = Just (Right (UserTargetLocalDir path)) - | isFile && extensionIsBinaryTarGz filename - = Just (Right (UserTargetLocalTarball filename True)) + | isFile && extensionIsBinaryTarGz path + = Just (Right (UserTargetLocalTarball path True)) - | isFile && extensionIsTarGz filename - = Just (Right (UserTargetLocalTarball filename False)) + | isFile && extensionIsTarGz path + = Just (Right (UserTargetLocalTarball path False)) - | isFile && takeExtension filename == ".cabal" - = Just (Right (UserTargetLocalCabalFile filename)) + | isFile && ( takeExtension path == ".cabal" || + takeFileName path == "etlas.dhall" ) + = Just (Right (UserTargetLocalPkgConfigFile path)) | isFile - = Just (Left (UserTargetUnexpectedFile filename)) + = Just (Left (UserTargetUnexpectedFile path)) | parentDirExists - = Just (Left (UserTargetNonexistantFile filename)) + = Just (Left (UserTargetNonexistantFile path)) | otherwise = Nothing @@ -288,7 +290,7 @@ reportUserTargetProblems verbosity problems = do ++ "Targets can be:\n" ++ " - package names, e.g. 'pkgname', 'pkgname-1.0.1', 'pkgname < 2.0'\n" ++ " - the special 'world' target\n" - ++ " - cabal files 'pkgname.cabal' or package directories 'pkgname/'\n" + ++ " - cabal files 'pkgname.cabal', an 'etlas.dhall' file or package directories 'pkgname/'\n" ++ " - package tarballs 'pkgname.tar.gz' or 'http://example.com/pkgname.tar.gz'" case [ () | UserTargetBadWorldPkg <- problems ] of @@ -309,7 +311,7 @@ reportUserTargetProblems verbosity problems = do [ "Unrecognised file target '" ++ name ++ "'." | name <- target ] ++ "File targets can be either package tarballs 'pkgname.tar.gz' " - ++ "or cabal files 'pkgname.cabal'." + ++ ", cabal files 'pkgname.cabal' or an 'etlas.dhall' file." case [ target | UserTargetUnexpectedUriScheme target <- problems ] of [] -> return () @@ -412,7 +414,7 @@ expandUserTarget verbosity worldFile userTarget = case userTarget of UserTargetLocalDir dir -> return [ PackageTargetLocation (LocalUnpackedPackage dir) ] - UserTargetLocalCabalFile file -> do + UserTargetLocalPkgConfigFile file -> do let dir = takeDirectory file _ <- tryFindPackageDesc verbosity dir (localPackageError dir) -- just as a check return [ PackageTargetLocation (LocalUnpackedPackage dir) ] @@ -426,7 +428,7 @@ expandUserTarget verbosity worldFile userTarget = case userTarget of -- Handle etlas.dhall case localPackageError :: FilePath -> String localPackageError dir = - "Error reading local package.\nCouldn't find .cabal file in: " ++ dir + "Error reading local package.\nCouldn't find etlas.dhall or .cabal file in: " ++ dir -- ------------------------------------------------------------ -- * Fetching and reading package targets @@ -477,12 +479,12 @@ readPackageTarget verbosity = traverse modifyLocation ScmPackage _ _ _ _ -> error "TODO: readPackageTarget ScmPackage" - -- TODO: parse etlas.dhall file readTarballPackageTarget location tarballFile tarballOriginalLoc = do (filename, content) <- extractTarballPackageCabalFile tarballFile tarballOriginalLoc - case parsePackageDescription' content of - Nothing -> die' verbosity $ "Could not parse the dhall or cabal file " + genPkgDesc <- parsePackageDescription' filename content + case genPkgDesc of + Nothing -> die' verbosity $ "Could not parse dhall or cabal file " ++ filename ++ " in " ++ tarballFile Just pkg -> return $ SourcePackage { @@ -501,7 +503,7 @@ readPackageTarget verbosity = traverse modifyLocation either (die' verbosity . formatErr) return . check . accumEntryMap - . Tar.filterEntries isCabalFile + . Tar.filterEntries (\ e -> isDhallFile e || isCabalFile e ) . Tar.read . GZipUtils.maybeDecompress =<< BS.readFile tarballFile @@ -515,30 +517,37 @@ readPackageTarget verbosity = traverse modifyLocation check (Left e) = Left (show e) check (Right m) = case Map.elems m of [] -> Left noCabalFile - [file] -> case Tar.entryContent file of - Tar.NormalFile content _ -> Right (Tar.entryPath file, content) - _ -> Left noCabalFile - _files -> Left multipleCabalFiles + files | any isDhallFile files || length files == 1 -> + case Tar.entryContent file of + Tar.NormalFile content _ -> Right (Tar.entryPath file, content) + _ -> Left noCabalFile + where file = maybe (head files) $ find isDhallFile files + _ -> Left multipleCabalFiles where - noCabalFile = "No cabal or etlas.dhall file found" + noCabalFile = "No etlas.dhall or cabal file found" multipleCabalFiles = "Multiple cabal files found" - isCabalFile e = case splitPath (Tar.entryPath e) of - [ _dir, file] -> takeExtension file == ".cabal" - || file == "etlas.dhall" - [".", _dir, file] -> takeExtension file == ".cabal" - || file == "etlas.dhall" + isFile pred e = case splitPath (Tar.entryPath e) of + [ _dir, file] -> pred file + [".", _dir, file] -> pred file _ -> False - parsePackageDescription' :: BS.ByteString -> Maybe GenericPackageDescription + isCabalFile = isFile ( \f -> takeExtension f == ".cabal" ) + isDhallFile = isFile ( == "etlas.dhall" ) + + parsePackageDescription' :: FilePath -> BS.ByteString + -> IO (Maybe GenericPackageDescription) + parsePackageDescription' filePath content = + if takeExtension filePath == ".dhall" + then Just `fmap` parseGenericPackageDescriptionFromDhall filePath + $ StrictText.decodeUtf8 $ BS.toStrict content + else return $ #ifdef CABAL_PARSEC - parsePackageDescription' bs = - parseGenericPackageDescriptionMaybe (BS.toStrict bs) + parseGenericPackageDescriptionMaybe (BS.toStrict content) #else - parsePackageDescription' content = - case parseGenericPackageDescription . ignoreBOM . fromUTF8 . BS.Char8.unpack $ content of - ParseOk _ pkg -> Just pkg - _ -> Nothing + case parseGenericPackageDescription . ignoreBOM . fromUTF8 . BS.Char8.unpack $ content of + ParseOk _ pkg -> Just pkg + _ -> Nothing #endif -- ------------------------------------------------------------ From c4e52908c5f70c5d240c97f1afa9702d3734bf03 Mon Sep 17 00:00:00 2001 From: jneira Date: Tue, 28 Aug 2018 14:53:18 +0200 Subject: [PATCH 29/46] Complete support for etlas.dhall in Targets --- etlas/Distribution/Client/Get.hs | 4 ++-- etlas/Distribution/Client/Targets.hs | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/etlas/Distribution/Client/Get.hs b/etlas/Distribution/Client/Get.hs index 56a4ffc..f181443 100644 --- a/etlas/Distribution/Client/Get.hs +++ b/etlas/Distribution/Client/Get.hs @@ -139,8 +139,8 @@ get verbosity repoCtxt globalFlags getFlags userTargets = do checkTarget :: Verbosity -> UserTarget -> IO () checkTarget verbosity target = case target of - UserTargetLocalDir dir -> die' verbosity (notTarball dir) - UserTargetLocalCabalFile file -> die' verbosity (notTarball file) + UserTargetLocalDir dir -> die' verbosity (notTarball dir) + UserTargetLocalPkgConfigFile file -> die' verbosity (notTarball file) _ -> return () where notTarball t = diff --git a/etlas/Distribution/Client/Targets.hs b/etlas/Distribution/Client/Targets.hs index 455c857..f006ac7 100644 --- a/etlas/Distribution/Client/Targets.hs +++ b/etlas/Distribution/Client/Targets.hs @@ -521,7 +521,7 @@ readPackageTarget verbosity = traverse modifyLocation case Tar.entryContent file of Tar.NormalFile content _ -> Right (Tar.entryPath file, content) _ -> Left noCabalFile - where file = maybe (head files) $ find isDhallFile files + where file = fromMaybe (head files) $ find isDhallFile files _ -> Left multipleCabalFiles where noCabalFile = "No etlas.dhall or cabal file found" @@ -539,7 +539,7 @@ readPackageTarget verbosity = traverse modifyLocation -> IO (Maybe GenericPackageDescription) parsePackageDescription' filePath content = if takeExtension filePath == ".dhall" - then Just `fmap` parseGenericPackageDescriptionFromDhall filePath + then fmap Just $ parseGenericPackageDescriptionFromDhall filePath $ StrictText.decodeUtf8 $ BS.toStrict content else return $ #ifdef CABAL_PARSEC From 95914a6ed1e551cb9babd39b94985ef7dc05ed7c Mon Sep 17 00:00:00 2001 From: jneira Date: Thu, 30 Aug 2018 15:03:15 +0200 Subject: [PATCH 30/46] Continue handling of etlas.dhall --- etlas/Distribution/Client/IndexUtils.hs | 67 ++++++++++++++++--------- etlas/Distribution/Client/Targets.hs | 2 +- etlas/etlas.cabal | 4 +- stack.yaml | 2 +- 4 files changed, 46 insertions(+), 29 deletions(-) diff --git a/etlas/Distribution/Client/IndexUtils.hs b/etlas/Distribution/Client/IndexUtils.hs index 32a1c6f..6ce6df9 100644 --- a/etlas/Distribution/Client/IndexUtils.hs +++ b/etlas/Distribution/Client/IndexUtils.hs @@ -80,7 +80,7 @@ import Distribution.Client.Setup import Distribution.Simple.Command import qualified Distribution.Simple.Eta as Eta import qualified Distribution.Client.PackageDescription.Dhall as PackageDesc.Parse - ( readGenericPackageDescription ) + ( readGenericPackageDescription, parseGenericPackageDescriptionFromDhall ) #ifdef CABAL_PARSEC import Distribution.PackageDescription.Parsec ( parseGenericPackageDescriptionMaybe ) @@ -107,6 +107,7 @@ import qualified Data.ByteString.Lazy as BS import qualified Data.ByteString.Lazy.Char8 as BS.Char8 import qualified Data.ByteString.Char8 as BSS import Data.ByteString.Lazy (ByteString) +import qualified Data.Text.Encoding as StrictText import Distribution.Client.HttpUtils import Distribution.Client.GZipUtils (maybeDecompress) import Distribution.Client.Utils ( byteStringToFilePath @@ -527,25 +528,36 @@ tarEntriesList = go 0 extractPkg :: Verbosity -> Tar.Entry -> BlockNo -> Maybe (IO (Maybe PackageEntry)) extractPkg verbosity entry blockNo = case Tar.entryContent entry of Tar.NormalFile content _ - | takeExtension fileName == ".cabal" + | takeExtension fileName == ".cabal" || takeFileName fileName == "etlas.dhall" -> case splitDirectories (normalise fileName) of [pkgname,vers,_] -> case simpleParse vers of - Just ver -> Just . return $ Just (NormalPackage pkgid descr content (Right blockNo) Nothing) + Just ver -> do + Just $ do + descr' <- descr + return $ Just (NormalPackage pkgid descr' content (Right blockNo) Nothing) where pkgid = PackageIdentifier (mkPackageName pkgname) ver + parsed = if takeExtension fileName == ".dhall" + then fmap Just $ PackageDesc.Parse.parseGenericPackageDescriptionFromDhall fileName + $ StrictText.decodeUtf8 $ BS.toStrict content + else return $ #ifdef CABAL_PARSEC - parsed = parseGenericPackageDescriptionMaybe (BS.toStrict content) - descr = case parsed of - Just d -> d - Nothing -> error $ "Couldn't read cabal file " - ++ show fileName + parseGenericPackageDescriptionMaybe (BS.toStrict content) + descr = do + parsed' <- parsed + case parsed' of + Just d -> return d + Nothing -> error $ "Couldn't read cabal file " + ++ show fileName #else - parsed = parseGenericPackageDescription . ignoreBOM . fromUTF8 . BS.Char8.unpack + parseGenericPackageDescription . ignoreBOM . fromUTF8 . BS.Char8.unpack $ content - descr = case parsed of - ParseOk _ d -> d - _ -> error $ "Couldn't read cabal file " - ++ show fileName + descr = do + parsed' <- parsed + case parsed' of + ParseOk _ d -> return d + _ -> error $ "Couldn't read cabal file " + ++ show fileName #endif _ -> Nothing _ -> Nothing @@ -783,9 +795,10 @@ packageListFromCache verbosity mkPkg idxFile hnd Cache{..} mode patchesDir -- from the index tarball if it turns out that we need it. -- Most of the time we only need the package id. ~(pkg, pkgtxt, mPatchPath) <- unsafeInterleaveIO $ do - mPatch <- patchedPackageCabalFile pkgid patchesDir - pkgtxt <- maybe (getPackageDesc descLoc) return (fmap snd mPatch) - pkg <- readPackageDescription pkgtxt + mPatch <- patchedPackageCabalFile pkgid patchesDir + pkgtxt <- maybe (getPackageDesc descLoc) return (fmap snd mPatch) + let pkgpath = fromMaybe (show pkgid ++ ".cabal") (fmap fst mPatch) + pkg <- readPackageDescription pkgpath pkgtxt return (pkg, pkgtxt, (fmap fst mPatch)) let descLoc' = left (\x -> indexDir x) descLoc case mode of @@ -824,20 +837,24 @@ packageListFromCache verbosity mkPkg idxFile hnd Cache{..} mode patchesDir -> return content _ -> interror "unexpected tar entry type" - readPackageDescription :: ByteString -> IO GenericPackageDescription - readPackageDescription content = + readPackageDescription :: FilePath -> ByteString -> IO GenericPackageDescription + readPackageDescription fileName content = + if takeExtension fileName == ".dhall" + then PackageDesc.Parse.parseGenericPackageDescriptionFromDhall fileName + $ StrictText.decodeUtf8 $ BS.toStrict content + else #ifdef CABAL_PARSEC - case parseGenericPackageDescriptionMaybe (BS.toStrict content) of - Just gpd -> return gpd - Nothing -> interror "failed to parse .cabal file" + case parseGenericPackageDescriptionMaybe (BS.toStrict content) of + Just gpd -> return gpd + Nothing -> interror "failed to parse .cabal file using parsec" #else - case parseGenericPackageDescription . ignoreBOM . fromUTF8 . BS.Char8.unpack $ content of - ParseOk _ d -> return d - _ -> interror "failed to parse .cabal file" + case parseGenericPackageDescription . ignoreBOM . fromUTF8 . BS.Char8.unpack $ content of + ParseOk _ d -> return d + _ -> interror "failed to parse .cabal file" #endif interror :: String -> IO a - interror msg = die' verbosity $ "internal error when reading package index: " ++ msg + interror msg = die' verbosity $ "internal error when reading package index: " ++ msg ++". " ++ "The package index or index cache is probably " ++ "corrupt. Running 'etlas update' might fix it." diff --git a/etlas/Distribution/Client/Targets.hs b/etlas/Distribution/Client/Targets.hs index f006ac7..f0f0c4f 100644 --- a/etlas/Distribution/Client/Targets.hs +++ b/etlas/Distribution/Client/Targets.hs @@ -538,7 +538,7 @@ readPackageTarget verbosity = traverse modifyLocation parsePackageDescription' :: FilePath -> BS.ByteString -> IO (Maybe GenericPackageDescription) parsePackageDescription' filePath content = - if takeExtension filePath == ".dhall" + if takeExtension filePath == ".dhall" then fmap Just $ parseGenericPackageDescriptionFromDhall filePath $ StrictText.decodeUtf8 $ BS.toStrict content else return $ diff --git a/etlas/etlas.cabal b/etlas/etlas.cabal index 51d9dfa..2c914b9 100644 --- a/etlas/etlas.cabal +++ b/etlas/etlas.cabal @@ -225,8 +225,8 @@ library network >= 2.6 && < 2.7, text >= 1.2, parsec >= 3.1.13.0 && < 3.2, - microlens >=0.1.0.0 && <0.5 - + microlens >=0.1.0.0 && <0.5 + if os(windows) build-depends: Win32 >= 2 && < 3 else diff --git a/stack.yaml b/stack.yaml index 04c9980..0045130 100644 --- a/stack.yaml +++ b/stack.yaml @@ -7,7 +7,7 @@ extra-deps: - parsec-3.1.13.0 # - dhall-1.16.1 - git: https://github.com/eta-lang/dhall-haskell.git - commit: afb6315dd3ad075d0a3681e449298a9da3c5e073 + commit: 8c3adb7bd305edee70dc22b69b7664822c4b1595 - ansi-terminal-0.7.1.1 - ansi-wl-pprint-0.6.8.2 - cryptonite-0.24 From 0d16ef622f1903179975eb92c84b2452a711e30c Mon Sep 17 00:00:00 2001 From: jneira Date: Fri, 31 Aug 2018 06:26:09 +0200 Subject: [PATCH 31/46] set master version of dhall --- stack.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/stack.yaml b/stack.yaml index 0045130..f49468b 100644 --- a/stack.yaml +++ b/stack.yaml @@ -7,7 +7,7 @@ extra-deps: - parsec-3.1.13.0 # - dhall-1.16.1 - git: https://github.com/eta-lang/dhall-haskell.git - commit: 8c3adb7bd305edee70dc22b69b7664822c4b1595 + commit: dd92735677ac093222b02eab88d5cb5f88c163fd - ansi-terminal-0.7.1.1 - ansi-wl-pprint-0.6.8.2 - cryptonite-0.24 From 28290a52a8986a5ffb2cebeafe18af74e5ae53de Mon Sep 17 00:00:00 2001 From: jneira Date: Fri, 31 Aug 2018 06:26:40 +0200 Subject: [PATCH 32/46] set correct repo version of dhall --- stack.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/stack.yaml b/stack.yaml index f49468b..0a3f25b 100644 --- a/stack.yaml +++ b/stack.yaml @@ -6,7 +6,7 @@ extra-deps: - mintty-0.1.1 - parsec-3.1.13.0 # - dhall-1.16.1 -- git: https://github.com/eta-lang/dhall-haskell.git +- git: https://github.com/dhall-lang/dhall-haskell.git commit: dd92735677ac093222b02eab88d5cb5f88c163fd - ansi-terminal-0.7.1.1 - ansi-wl-pprint-0.6.8.2 From 2aadc55ceb05fd52d2c256f5802a4f6b091e3917 Mon Sep 17 00:00:00 2001 From: jneira Date: Fri, 31 Aug 2018 09:45:16 +0200 Subject: [PATCH 33/46] Add supoort for etlas.dhall in package list cache read --- etlas/Distribution/Client/IndexUtils.hs | 46 +++++++++++++++---------- 1 file changed, 28 insertions(+), 18 deletions(-) diff --git a/etlas/Distribution/Client/IndexUtils.hs b/etlas/Distribution/Client/IndexUtils.hs index 6ce6df9..f587be7 100644 --- a/etlas/Distribution/Client/IndexUtils.hs +++ b/etlas/Distribution/Client/IndexUtils.hs @@ -83,7 +83,8 @@ import qualified Distribution.Client.PackageDescription.Dhall as PackageDesc.Par ( readGenericPackageDescription, parseGenericPackageDescriptionFromDhall ) #ifdef CABAL_PARSEC import Distribution.PackageDescription.Parsec - ( parseGenericPackageDescriptionMaybe ) + ( parseGenericPackageDescriptionMaybe, parseGenericPackageDescription, runParseResult ) +import Distribution.Parsec.Types.Common #else import Distribution.ParseUtils ( ParseResult(..) ) @@ -130,6 +131,8 @@ import Network.HTTP.Headers import qualified Hackage.Security.Client as Sec import qualified Hackage.Security.Util.Some as Sec +import Debug.Trace + -- | Reduced-verbosity version of 'Configure.getInstalledPackages' getInstalledPackages :: Verbosity -> Compiler -> PackageDBStack -> ProgramDb @@ -796,9 +799,8 @@ packageListFromCache verbosity mkPkg idxFile hnd Cache{..} mode patchesDir -- Most of the time we only need the package id. ~(pkg, pkgtxt, mPatchPath) <- unsafeInterleaveIO $ do mPatch <- patchedPackageCabalFile pkgid patchesDir - pkgtxt <- maybe (getPackageDesc descLoc) return (fmap snd mPatch) - let pkgpath = fromMaybe (show pkgid ++ ".cabal") (fmap fst mPatch) - pkg <- readPackageDescription pkgpath pkgtxt + (pkgpath, pkgtxt) <- maybe (getPackageDesc descLoc) return mPatch + pkg <- parsePackageDescription pkgpath pkgtxt return (pkg, pkgtxt, (fmap fst mPatch)) let descLoc' = left (\x -> indexDir x) descLoc case mode of @@ -811,7 +813,7 @@ packageListFromCache verbosity mkPkg idxFile hnd Cache{..} mode patchesDir -- We have to read the .cabal file eagerly here because we can't cache the -- package id for build tree references - the user might edit the .cabal -- file after the reference was added to the index. - path <- liftM byteStringToFilePath . getEntryContent $ blockno + path <- liftM ( byteStringToFilePath . snd ) . getEntryInfo $ blockno pkg <- do let err = "Error reading package index from cache." file <- tryFindAddSourcePackageDesc verbosity path err PackageDesc.Parse.readGenericPackageDescription normal file @@ -823,34 +825,42 @@ packageListFromCache verbosity mkPkg idxFile hnd Cache{..} mode patchesDir indexDir = takeDirectory idxFile - getPackageDesc :: Either FilePath BlockNo -> IO ByteString - getPackageDesc (Left relPath) = BS.readFile (indexDir relPath) - getPackageDesc (Right blockNo) = getEntryContent blockNo + getPackageDesc :: Either FilePath BlockNo -> IO (FilePath, ByteString) + getPackageDesc (Left relPath) = do + let path = indexDir relPath + content <- BS.readFile path + return (path, content) + getPackageDesc (Right blockNo) = getEntryInfo blockNo - getEntryContent :: BlockNo -> IO ByteString - getEntryContent blockno = do + getEntryInfo :: BlockNo -> IO (FilePath, ByteString) + getEntryInfo blockno = do entry <- Tar.hReadEntry hnd blockno + let path = Tar.entryPath entry case Tar.entryContent entry of - Tar.NormalFile content _size -> return content + Tar.NormalFile content _size -> return (path, content) Tar.OtherEntryType typecode content _size | Tar.isBuildTreeRefTypeCode typecode - -> return content + -> return (path, content) _ -> interror "unexpected tar entry type" - readPackageDescription :: FilePath -> ByteString -> IO GenericPackageDescription - readPackageDescription fileName content = + parsePackageDescription :: FilePath -> ByteString -> IO GenericPackageDescription + parsePackageDescription fileName content = do if takeExtension fileName == ".dhall" then PackageDesc.Parse.parseGenericPackageDescriptionFromDhall fileName $ StrictText.decodeUtf8 $ BS.toStrict content else #ifdef CABAL_PARSEC - case parseGenericPackageDescriptionMaybe (BS.toStrict content) of - Just gpd -> return gpd - Nothing -> interror "failed to parse .cabal file using parsec" + do + let res = parseGenericPackageDescription (BS.toStrict content) + let (_, errors, result) = runParseResult res + mapM_ (warn verbosity . showPError fileName) errors + case result of + Nothing -> interror $ "failed to parse " ++ fileName ++ " file using parsec" + Just x -> return x #else case parseGenericPackageDescription . ignoreBOM . fromUTF8 . BS.Char8.unpack $ content of ParseOk _ d -> return d - _ -> interror "failed to parse .cabal file" + _ -> interror "failed to parse " ++ fileName ++ " file" #endif interror :: String -> IO a From 6f7f477a0568cd765d09609093653175868d6124 Mon Sep 17 00:00:00 2001 From: jneira Date: Fri, 31 Aug 2018 11:22:30 +0200 Subject: [PATCH 34/46] bump up dhall-to-etlas to master --- dhall-to-etlas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/dhall-to-etlas b/dhall-to-etlas index f9c28b4..1f3e67d 160000 --- a/dhall-to-etlas +++ b/dhall-to-etlas @@ -1 +1 @@ -Subproject commit f9c28b48b8b639e5608d0b9f8bd6f841203829a1 +Subproject commit 1f3e67d3963728ebc96f38373ce579fb66e46fc2 From 3d047d17b1647ba7ee7c2adc2c987a5271ec3dd6 Mon Sep 17 00:00:00 2001 From: jneira Date: Fri, 31 Aug 2018 11:23:16 +0200 Subject: [PATCH 35/46] Set PARSEC to false and fix compiler errors --- etlas/Distribution/Client/IndexUtils.hs | 33 ++++++++----------- .../Client/PackageDescription/Dhall.hs | 2 +- stack.yaml | 2 +- 3 files changed, 16 insertions(+), 21 deletions(-) diff --git a/etlas/Distribution/Client/IndexUtils.hs b/etlas/Distribution/Client/IndexUtils.hs index f587be7..a57093e 100644 --- a/etlas/Distribution/Client/IndexUtils.hs +++ b/etlas/Distribution/Client/IndexUtils.hs @@ -131,8 +131,6 @@ import Network.HTTP.Headers import qualified Hackage.Security.Client as Sec import qualified Hackage.Security.Util.Some as Sec -import Debug.Trace - -- | Reduced-verbosity version of 'Configure.getInstalledPackages' getInstalledPackages :: Verbosity -> Compiler -> PackageDBStack -> ProgramDb @@ -534,33 +532,30 @@ extractPkg verbosity entry blockNo = case Tar.entryContent entry of | takeExtension fileName == ".cabal" || takeFileName fileName == "etlas.dhall" -> case splitDirectories (normalise fileName) of [pkgname,vers,_] -> case simpleParse vers of - Just ver -> do - Just $ do + Just ver -> Just $ do descr' <- descr return $ Just (NormalPackage pkgid descr' content (Right blockNo) Nothing) where pkgid = PackageIdentifier (mkPackageName pkgname) ver + descr = do + parsed' <- parsed + case parsed' of + Just d -> return d + Nothing -> error $ "Couldn't read cabal file " + ++ show fileName parsed = if takeExtension fileName == ".dhall" then fmap Just $ PackageDesc.Parse.parseGenericPackageDescriptionFromDhall fileName $ StrictText.decodeUtf8 $ BS.toStrict content else return $ #ifdef CABAL_PARSEC parseGenericPackageDescriptionMaybe (BS.toStrict content) - descr = do - parsed' <- parsed - case parsed' of - Just d -> return d - Nothing -> error $ "Couldn't read cabal file " - ++ show fileName + #else - parseGenericPackageDescription . ignoreBOM . fromUTF8 . BS.Char8.unpack - $ content - descr = do - parsed' <- parsed - case parsed' of - ParseOk _ d -> return d - _ -> error $ "Couldn't read cabal file " - ++ show fileName + case parseGenericPackageDescription . ignoreBOM . fromUTF8 + . BS.Char8.unpack + $ content of + ParseOk _ d -> Just d + _ -> Nothing #endif _ -> Nothing _ -> Nothing @@ -860,7 +855,7 @@ packageListFromCache verbosity mkPkg idxFile hnd Cache{..} mode patchesDir #else case parseGenericPackageDescription . ignoreBOM . fromUTF8 . BS.Char8.unpack $ content of ParseOk _ d -> return d - _ -> interror "failed to parse " ++ fileName ++ " file" + _ -> interror $ "failed to parse " ++ fileName ++ " file" #endif interror :: String -> IO a diff --git a/etlas/Distribution/Client/PackageDescription/Dhall.hs b/etlas/Distribution/Client/PackageDescription/Dhall.hs index 921b6e6..bd09d9c 100644 --- a/etlas/Distribution/Client/PackageDescription/Dhall.hs +++ b/etlas/Distribution/Client/PackageDescription/Dhall.hs @@ -1,7 +1,6 @@ {-# LANGUAGE CPP #-} module Distribution.Client.PackageDescription.Dhall where -import qualified Data.ByteString.Char8 as BS.Char8 import Data.Function ( (&) ) import qualified Data.Text as StrictText @@ -15,6 +14,7 @@ import Distribution.PackageDescription import Distribution.PackageDescription.PrettyPrint (showGenericPackageDescription, writeGenericPackageDescription) #ifdef CABAL_PARSEC +import qualified Data.ByteString.Char8 as BS.Char8 import qualified Distribution.PackageDescription.Parsec as Cabal.Parse (readGenericPackageDescription, parseGenericPackageDescriptionMaybe) #else diff --git a/stack.yaml b/stack.yaml index 0a3f25b..bcc6817 100644 --- a/stack.yaml +++ b/stack.yaml @@ -38,7 +38,7 @@ flags: etlas-cabal: parsec: true etlas: - parsec: true + parsec: false mintty: win32-2-5: false packages: From 80054352d1a64ec733e65e9d9d303cc2442fbf14 Mon Sep 17 00:00:00 2001 From: jneira Date: Fri, 31 Aug 2018 14:58:37 +0200 Subject: [PATCH 36/46] Enable Parsec again --- stack.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/stack.yaml b/stack.yaml index bcc6817..0a3f25b 100644 --- a/stack.yaml +++ b/stack.yaml @@ -38,7 +38,7 @@ flags: etlas-cabal: parsec: true etlas: - parsec: false + parsec: true mintty: win32-2-5: false packages: From 184700573eb1a4048f3be796b894abdffbe3d451 Mon Sep 17 00:00:00 2001 From: jneira Date: Fri, 31 Aug 2018 15:01:04 +0200 Subject: [PATCH 37/46] Cherry pick changes of cabal pr 4654 to allow parse of flags with double dhases (like in cassava) --- etlas-cabal/Distribution/Parsec/Class.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/etlas-cabal/Distribution/Parsec/Class.hs b/etlas-cabal/Distribution/Parsec/Class.hs index ec40738..71e2b0d 100644 --- a/etlas-cabal/Distribution/Parsec/Class.hs +++ b/etlas-cabal/Distribution/Parsec/Class.hs @@ -20,6 +20,7 @@ import Data.Functor.Identity (Identity) import qualified Distribution.Compat.Parsec as P import Distribution.Parsec.Types.Common (PWarnType (..), PWarning (..), Position (..)) +import Distribution.Utils.Generic (lowercase) import qualified Text.Parsec as Parsec import qualified Text.Parsec.Language as Parsec import qualified Text.Parsec.Token as Parsec @@ -125,12 +126,11 @@ instance Parsec ModuleName where validModuleChar c = isAlphaNum c || c == '_' || c == '\'' instance Parsec FlagName where - parsec = mkFlagName . map toLower . intercalate "-" <$> P.sepBy1 component (P.char '-') + parsec = mkFlagName . lowercase <$> parsec' where - -- http://hackage.haskell.org/package/cabal-debian-4.24.8/cabal-debian.cabal - -- has flag with all digit component: pretty-112 - component :: P.Stream s Identity Char => P.Parsec s [PWarning] String - component = P.munch1 (\c -> isAlphaNum c || c `elem` "_") + parsec' = (:) <$> lead <*> rest + lead = P.satisfy (\c -> isAlphaNum c || c == '_') + rest = P.munch (\c -> isAlphaNum c || c == '_' || c == '-') instance Parsec Dependency where parsec = do From 1ba5974530839dff76c1dc3675bba6e24ae49406 Mon Sep 17 00:00:00 2001 From: jneira Date: Fri, 31 Aug 2018 22:58:53 +0200 Subject: [PATCH 38/46] set dhall version to 1.17 --- stack.yaml | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/stack.yaml b/stack.yaml index 0a3f25b..2822db8 100644 --- a/stack.yaml +++ b/stack.yaml @@ -5,9 +5,7 @@ extra-deps: - ed25519-0.0.5.0 - mintty-0.1.1 - parsec-3.1.13.0 -# - dhall-1.16.1 -- git: https://github.com/dhall-lang/dhall-haskell.git - commit: dd92735677ac093222b02eab88d5cb5f88c163fd +- dhall-1.17 - ansi-terminal-0.7.1.1 - ansi-wl-pprint-0.6.8.2 - cryptonite-0.24 From b473bc5cbe74fc97e926105a1fff345c676074e1 Mon Sep 17 00:00:00 2001 From: jneira Date: Sun, 2 Sep 2018 23:43:57 +0200 Subject: [PATCH 39/46] bump up master version --- dhall-to-etlas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/dhall-to-etlas b/dhall-to-etlas index 1f3e67d..19db2d4 160000 --- a/dhall-to-etlas +++ b/dhall-to-etlas @@ -1 +1 @@ -Subproject commit 1f3e67d3963728ebc96f38373ce579fb66e46fc2 +Subproject commit 19db2d4fce2d9f422ec12d0351d83460be16e810 From b6b84e01fa70832830dac5ad042f62e3d502be07 Mon Sep 17 00:00:00 2001 From: jneira Date: Mon, 3 Sep 2018 00:28:42 +0200 Subject: [PATCH 40/46] correct new dhall version --- stack.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/stack.yaml b/stack.yaml index 2822db8..be21be7 100644 --- a/stack.yaml +++ b/stack.yaml @@ -5,7 +5,7 @@ extra-deps: - ed25519-0.0.5.0 - mintty-0.1.1 - parsec-3.1.13.0 -- dhall-1.17 +- dhall-1.17.0 - ansi-terminal-0.7.1.1 - ansi-wl-pprint-0.6.8.2 - cryptonite-0.24 From ab290a2f16420f3fca1166d44ef15312a585c887 Mon Sep 17 00:00:00 2001 From: jneira Date: Mon, 3 Sep 2018 13:21:06 +0200 Subject: [PATCH 41/46] Pull latest master --- dhall-to-etlas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/dhall-to-etlas b/dhall-to-etlas index 19db2d4..428ee1c 160000 --- a/dhall-to-etlas +++ b/dhall-to-etlas @@ -1 +1 @@ -Subproject commit 19db2d4fce2d9f422ec12d0351d83460be16e810 +Subproject commit 428ee1c73fc906370b7dbb99f680cc5693fad0ce From 44c6158c280e428b01c5dc3996a1df6ce3fdd759 Mon Sep 17 00:00:00 2001 From: jneira Date: Mon, 3 Sep 2018 13:21:53 +0200 Subject: [PATCH 42/46] Bump up dhall version to 1.17 --- etlas/etlas.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/etlas/etlas.cabal b/etlas/etlas.cabal index 2c914b9..2302df6 100644 --- a/etlas/etlas.cabal +++ b/etlas/etlas.cabal @@ -201,7 +201,7 @@ library binary >= 0.5 && < 0.9, bytestring >= 0.9 && < 1, etlas-cabal >= 1.0, - dhall >= 1.16 && < 1.17, + dhall >= 1.17.0 && < 1.18, dhall-to-etlas >= 1.3, containers >= 0.4 && < 0.6, cryptohash-sha256 >= 0.11 && < 0.12, From 2133396c0e81c5141f7ddbf20c80ea429645e07c Mon Sep 17 00:00:00 2001 From: jneira Date: Mon, 3 Sep 2018 13:22:26 +0200 Subject: [PATCH 43/46] Relax lower bound of directory to remove allow-newer --- stack.yaml | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/stack.yaml b/stack.yaml index be21be7..2f0db0c 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,4 +1,3 @@ -allow-newer: true extra-deps: - cryptohash-sha256-0.11.100.1 - echo-0.1.3 @@ -19,7 +18,7 @@ extra-deps: - basement-0.0.6 - prettyprinter-1.2.0.1 - prettyprinter-ansi-terminal-1.1.1.2 -- directory-1.3.1.0 +- directory-1.2.7.1 - foundation-0.0.19 - process-1.2.3.0 - repline-0.1.7.0 From c59460e9217389e58604862ad89110eb0c968bcb Mon Sep 17 00:00:00 2001 From: jneira Date: Mon, 3 Sep 2018 13:23:34 +0200 Subject: [PATCH 44/46] remove overlapping package locations between dhall and cabal --- etlas/Distribution/Client/ProjectConfig.hs | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) diff --git a/etlas/Distribution/Client/ProjectConfig.hs b/etlas/Distribution/Client/ProjectConfig.hs index 1f6dfe4..dc8e73a 100644 --- a/etlas/Distribution/Client/ProjectConfig.hs +++ b/etlas/Distribution/Client/ProjectConfig.hs @@ -785,8 +785,20 @@ findProjectPackages DistDirLayout{distProjectRootDirectory} $ concat [requiredPkgs, optionalPkgs, repoPkgs, namedPkgs] where - removeDuplicatedPackageLocations = id - + removeDuplicatedPackageLocations pkgLocs = + filter (not . ( hasCabalLocationAnyParentDir dhallLocationsParentDirs )) pkgLocs + where dhallLocationsParentDirs = concatMap dhallParentDir pkgLocs + + dhallParentDir (ProjectPackageLocalDhallFile path) = [takeDirectory path] + dhallParentDir (ProjectPackageLocalDhallDirectory dir _) = [dir] + dhallParentDir _ = [] + + hasCabalLocationAnyParentDir dirs (ProjectPackageLocalCabalFile path) = + takeDirectory path `elem` dirs + hasCabalLocationAnyParentDir dirs (ProjectPackageLocalCabalDirectory dir _) = + dir `elem` dirs + hasCabalLocationAnyParentDir _ _ = False + findPackageLocations required pkglocstr = do (problems, pkglocs) <- partitionEithers <$> mapM (findPackageLocation required) pkglocstr From 3df78ccea000ebfacb722ebef49703c76545ae26 Mon Sep 17 00:00:00 2001 From: jneira Date: Mon, 3 Sep 2018 13:43:54 +0200 Subject: [PATCH 45/46] Bump up version to 1.6.0.0 --- etlas-cabal/etlas-cabal.cabal | 2 +- etlas/etlas.cabal | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/etlas-cabal/etlas-cabal.cabal b/etlas-cabal/etlas-cabal.cabal index 7e2f4b7..e3bc2fe 100644 --- a/etlas-cabal/etlas-cabal.cabal +++ b/etlas-cabal/etlas-cabal.cabal @@ -1,6 +1,6 @@ name: etlas-cabal -- @VERSION -version: 1.5.1.0 +version: 1.6.0.0 copyright: 2017, TypeLead, Inc. license: BSD3 license-file: LICENSE diff --git a/etlas/etlas.cabal b/etlas/etlas.cabal index 2302df6..64401b0 100644 --- a/etlas/etlas.cabal +++ b/etlas/etlas.cabal @@ -1,6 +1,6 @@ name: etlas -- @VERSION -version: 1.5.1.0 +version: 1.6.0.0 synopsis: The package manager for Eta. description: The package manager for Eta. From cb37ef383c947232f49f96abdfe341530eb33cd3 Mon Sep 17 00:00:00 2001 From: jneira Date: Mon, 3 Sep 2018 13:57:36 +0200 Subject: [PATCH 46/46] Remove TODO comments --- etlas/Distribution/Client/Targets.hs | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/etlas/Distribution/Client/Targets.hs b/etlas/Distribution/Client/Targets.hs index f0f0c4f..d684ca2 100644 --- a/etlas/Distribution/Client/Targets.hs +++ b/etlas/Distribution/Client/Targets.hs @@ -185,7 +185,6 @@ readUserTargets verbosity targetStrs = do reportUserTargetProblems verbosity problems return targets --- TODO handle etlas.dhall with a new case UserTargetLocalDhallFile data UserTargetProblem = UserTargetUnexpectedFile String | UserTargetNonexistantFile String @@ -278,7 +277,6 @@ readUserTarget targetstr = v | v == nullVersion -> Dependency (packageName p) anyVersion | otherwise -> Dependency (packageName p) (thisVersion v) --- TODO handle etlas.dhall case reportUserTargetProblems :: Verbosity -> [UserTargetProblem] -> IO () reportUserTargetProblems verbosity problems = do case [ target | UserTargetUnrecognised target <- problems ] of @@ -425,7 +423,6 @@ expandUserTarget verbosity worldFile userTarget = case userTarget of UserTargetRemoteTarball tarballURL -> return [ PackageTargetLocation (RemoteTarballPackage tarballURL ()) ] --- Handle etlas.dhall case localPackageError :: FilePath -> String localPackageError dir = "Error reading local package.\nCouldn't find etlas.dhall or .cabal file in: " ++ dir @@ -494,7 +491,7 @@ readPackageTarget verbosity = traverse modifyLocation packageDescrOverride = Nothing, packagePatch = Nothing } - -- TODO: extract etlas.dhall file + extractTarballPackageCabalFile :: FilePath -> String -> IO (FilePath, BS.ByteString) extractTarballPackageCabalFile tarballFile tarballOriginalLoc = do