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..428ee1c --- /dev/null +++ b/dhall-to-etlas @@ -0,0 +1 @@ +Subproject commit 428ee1c73fc906370b7dbb99f680cc5693fad0ce 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/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 diff --git a/etlas-cabal/Distribution/Simple.hs b/etlas-cabal/Distribution/Simple.hs index 85ed402..e1644d9 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 () @@ -239,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) 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-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/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/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 a01d32a..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 @@ -144,7 +139,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 +392,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/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/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/IndexUtils.hs b/etlas/Distribution/Client/IndexUtils.hs index 6be1da1..a57093e 100644 --- a/etlas/Distribution/Client/IndexUtils.hs +++ b/etlas/Distribution/Client/IndexUtils.hs @@ -79,11 +79,12 @@ 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, parseGenericPackageDescriptionFromDhall ) #ifdef CABAL_PARSEC import Distribution.PackageDescription.Parsec - ( parseGenericPackageDescriptionMaybe ) -import qualified Distribution.PackageDescription.Parsec as PackageDesc.Parse + ( parseGenericPackageDescriptionMaybe, parseGenericPackageDescription, runParseResult ) +import Distribution.Parsec.Types.Common #else import Distribution.ParseUtils ( ParseResult(..) ) @@ -91,7 +92,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) @@ -108,6 +108,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 @@ -528,25 +529,33 @@ 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 -> 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 - 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) + #else - parsed = parseGenericPackageDescription . ignoreBOM . fromUTF8 . BS.Char8.unpack - $ content - descr = case parsed of - ParseOk _ d -> 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 @@ -784,9 +793,9 @@ 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 + (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 @@ -799,7 +808,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 @@ -811,34 +820,46 @@ 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 :: ByteString -> IO GenericPackageDescription - readPackageDescription 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" + 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" + case parseGenericPackageDescription . ignoreBOM . fromUTF8 . BS.Char8.unpack $ content of + ParseOk _ d -> return d + _ -> interror $ "failed to parse " ++ fileName ++ " 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/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/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 new file mode 100644 index 0000000..bd09d9c --- /dev/null +++ b/etlas/Distribution/Client/PackageDescription/Dhall.hs @@ -0,0 +1,92 @@ +{-# LANGUAGE CPP #-} +module Distribution.Client.PackageDescription.Dhall where + +import Data.Function ( (&) ) + +import qualified Data.Text as StrictText +import qualified Data.Text.IO as StrictText + +import qualified Dhall +import DhallToCabal (dhallToCabal) + +import Distribution.Verbosity +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 +import Distribution.PackageDescription.Parse as Cabal.Parse + (readGenericPackageDescription , parseGenericPackageDescription, ParseResult(..)) +#endif +import Distribution.Simple.Utils (die', info) + +import Lens.Micro (set) + +import System.Directory (doesFileExist) +import System.FilePath (takeDirectory, takeExtension, ()) + +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 + +readDhallGenericPackageDescription :: Verbosity -> FilePath -> IO GenericPackageDescription +readDhallGenericPackageDescription verbosity dhallFilePath = do + exists <- doesFileExist dhallFilePath + unless exists $ + die' verbosity $ + "Error Parsing: file \"" ++ dhallFilePath ++ "\" doesn't exist. Cannot continue." + + source <- StrictText.readFile dhallFilePath + info verbosity $ "Reading package configuration from " ++ dhallFilePath + 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 + let content = showGenericPackageDescription genPkgDesc + result = parseCabalGenericPackageDescription content + + case result of + Nothing -> die' verbosity $ "Failing parsing \"" ++ dhallFilePath ++ "\"." + Just x -> return x + + 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 + +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 + 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/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/ProjectConfig.hs b/etlas/Distribution/Client/ProjectConfig.hs index 5e8ac44..dc8e73a 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,12 +631,14 @@ reportParseResult verbosity filetype filename (ParseFailed err) = -- to the project root. -- data ProjectPackageLocation = - ProjectPackageLocalCabalFile FilePath - | ProjectPackageLocalDirectory FilePath FilePath -- dir and .cabal file - | ProjectPackageLocalTarball FilePath - | ProjectPackageRemoteTarball URI - | ProjectPackageRemoteRepo SourceRepo - | ProjectPackageNamed Dependency + 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 deriving Show @@ -670,8 +673,8 @@ data BadPackageLocation data BadPackageLocationMatch = BadLocUnexpectedFile String | BadLocNonexistantFile String - | BadLocDirNoCabalFile String - | BadLocDirManyCabalFiles String + | BadLocDirNoConfigFiles String + | BadLocDirManyConfigFiles String deriving Show renderBadPackageLocations :: BadPackageLocations -> String @@ -721,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 @@ -753,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)." @@ -778,8 +781,24 @@ 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 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 @@ -886,17 +905,24 @@ 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)) + | takeFileName pkglocstr == "etlas.dhall" + -> return (Right (ProjectPackageLocalDhallFile pkglocstr)) + | takeExtension pkglocstr == ".cabal" -> return (Right (ProjectPackageLocalCabalFile pkglocstr)) @@ -919,16 +945,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 @@ -938,19 +975,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.readDhallGenericPackageDescription 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) @@ -966,7 +1024,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 @@ -975,19 +1034,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, 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 diff --git a/etlas/Distribution/Client/SetupWrapper.hs b/etlas/Distribution/Client/SetupWrapper.hs index dc484ca..b052d00 100644 --- a/etlas/Distribution/Client/SetupWrapper.hs +++ b/etlas/Distribution/Client/SetupWrapper.hs @@ -36,13 +36,10 @@ import Distribution.PackageDescription ( GenericPackageDescription(packageDescription) , PackageDescription(..), specVersion , BuildType(..), knownBuildTypes ) -#ifdef CABAL_PARSEC -import Distribution.PackageDescription.Parsec - ( readGenericPackageDescription ) -#else -import Distribution.PackageDescription.Parse - ( readGenericPackageDescription ) -#endif +import Distribution.Client.PackageDescription.Dhall + ( readGenericPackageDescription + , writeDerivedCabalFile) + import Distribution.Simple.Compiler ( Compiler, PackageDB(..), PackageDBStack ) import Distribution.Simple.Program @@ -93,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 @@ -103,6 +100,7 @@ data Setup = Setup { setupMethod :: SetupMethod , setupScriptOptions :: SetupScriptOptions , setupVersion :: Version , setupBuildType :: BuildType + , setupGenericPackage :: GenericPackageDescription , setupPackage :: PackageDescription } @@ -115,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 @@ -249,6 +247,7 @@ defaultSetupScriptOptions = SetupScriptOptions { type SetupRunner = Verbosity -> SetupScriptOptions -> BuildType + -> GenericPackageDescription -> [String] -> IO () @@ -258,11 +257,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)) @@ -275,12 +276,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: " @@ -323,13 +324,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 @@ -373,39 +375,60 @@ 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 - runSetupCommand verbosity setup cmd (flags $ setupVersion setup) extraArgs +setupWrapper verbosity options mgenPkg mpkg cmd flags extraArgs = do + setup <- getSetup verbosity options mgenPkg mpkg + + existEtlasDhallFile <- doesFileExist $ + (fromMaybe "." (useWorkingDir options)) "etlas.dhall" + let flags' = flags $ setupVersion setup + needDerivedCabalFile = setupMethod setup == SelfExecMethod + && commandName cmd == "configure" + && not ( "cabal-file" `elem` allArgs ) + && existEtlasDhallFile + where allArgs = commandShowOptions cmd flags' ++ extraArgs + + 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' extraArgs' -- ------------------------------------------------------------ -- * Internal SetupMethod -- ------------------------------------------------------------ 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. @@ -440,7 +463,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 @@ -470,7 +493,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/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 " diff --git a/etlas/Distribution/Client/Targets.hs b/etlas/Distribution/Client/Targets.hs index dd3a2fa..d684ca2 100644 --- a/etlas/Distribution/Client/Targets.hs +++ b/etlas/Distribution/Client/Targets.hs @@ -86,20 +86,23 @@ 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, 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 @@ -108,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 @@ -154,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 -- @@ -182,7 +185,6 @@ readUserTargets verbosity targetStrs = do reportUserTargetProblems verbosity problems return targets - data UserTargetProblem = UserTargetUnexpectedFile String | UserTargetNonexistantFile String @@ -212,30 +214,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 @@ -274,7 +277,6 @@ readUserTarget targetstr = v | v == nullVersion -> Dependency (packageName p) anyVersion | otherwise -> Dependency (packageName p) (thisVersion v) - reportUserTargetProblems :: Verbosity -> [UserTargetProblem] -> IO () reportUserTargetProblems verbosity problems = do case [ target | UserTargetUnrecognised target <- problems ] of @@ -286,7 +288,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 @@ -307,7 +309,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 () @@ -410,7 +412,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) ] @@ -423,7 +425,7 @@ expandUserTarget verbosity worldFile userTarget = case userTarget of 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,8 +479,9 @@ readPackageTarget verbosity = traverse modifyLocation readTarballPackageTarget location tarballFile tarballOriginalLoc = do (filename, content) <- extractTarballPackageCabalFile tarballFile tarballOriginalLoc - case parsePackageDescription' content of - Nothing -> die' verbosity $ "Could not parse the 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 { @@ -497,7 +500,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 @@ -511,28 +514,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 = fromMaybe (head files) $ find isDhallFile files + _ -> Left multipleCabalFiles where - noCabalFile = "No cabal 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" - [".", _dir, file] -> takeExtension file == ".cabal" + 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 fmap Just $ 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 -- ------------------------------------------------------------ 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/etlas.cabal b/etlas/etlas.cabal index 487bd1e..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. @@ -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,8 @@ library binary >= 0.5 && < 0.9, bytestring >= 0.9 && < 1, etlas-cabal >= 1.0, + dhall >= 1.17.0 && < 1.18, + dhall-to-etlas >= 1.3, containers >= 0.4 && < 0.6, cryptohash-sha256 >= 0.11 && < 0.12, deepseq >= 1.3 && < 1.5, @@ -220,9 +223,10 @@ library process >= 1.1.0.2 && < 1.7, 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 else @@ -269,4 +273,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 diff --git a/etlas/main/Main.hs b/etlas/main/Main.hs index ffeb591..125b089 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 @@ -360,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) @@ -526,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 @@ -592,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 @@ -620,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 @@ -750,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 @@ -833,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 @@ -851,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) @@ -871,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) diff --git a/stack.yaml b/stack.yaml index 8f7d8c3..2f0db0c 100644 --- a/stack.yaml +++ b/stack.yaml @@ -4,6 +4,32 @@ extra-deps: - ed25519-0.0.5.0 - mintty-0.1.1 - parsec-3.1.13.0 +- dhall-1.17.0 +- 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.2.7.1 +- 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 +- cborg-0.2.0.0 +- serialise-0.2.0.0 resolver: lts-6.27 flags: etlas-cabal: @@ -14,5 +40,6 @@ flags: win32-2-5: false packages: - etlas-cabal/ +- dhall-to-etlas/ - etlas/ - hackage-security/hackage-security