From fe26b3e2041a3e940ac9eecd2b9e86464924578b Mon Sep 17 00:00:00 2001 From: jneira Date: Wed, 23 Jan 2019 14:59:55 +0100 Subject: [PATCH 01/11] Init use cabal cache file --- .../Client/PackageDescription/Dhall.hs | 10 +++++----- etlas/Distribution/Client/ProjectConfig.hs | 14 +++++++++++--- etlas/Distribution/Client/SetupWrapper.hs | 3 ++- 3 files changed, 18 insertions(+), 9 deletions(-) diff --git a/etlas/Distribution/Client/PackageDescription/Dhall.hs b/etlas/Distribution/Client/PackageDescription/Dhall.hs index dee1ad9..1d63a06 100644 --- a/etlas/Distribution/Client/PackageDescription/Dhall.hs +++ b/etlas/Distribution/Client/PackageDescription/Dhall.hs @@ -32,7 +32,7 @@ import Lens.Micro (Lens') import qualified Lens.Micro.Extras as Lens import System.Directory (doesFileExist) -import System.FilePath (takeDirectory, takeExtension, ()) +import System.FilePath (takeDirectory, takeExtension) import System.CPUTime (getCPUTime) import Control.Monad (unless) @@ -83,15 +83,15 @@ parseGenericPackageDescriptionFromDhall dhallFilePath content = do & Lens.set Dhall.sourceName dhallFilePath fmap fixGPDConstraints $ dhallToCabal settings content +-- writeDerivedCabalFileFromDhallFile :: writeDerivedCabalFile :: Verbosity -> FilePath - -> GenericPackageDescription -> IO FilePath -writeDerivedCabalFile verbosity dir genPkg = do - let path = dir "etlas.dhall.cabal" + -> GenericPackageDescription -> IO () +writeDerivedCabalFile verbosity path genPkg = do info verbosity $ "Writing derived cabal file from dhall file: " ++ path + let dir = takeDirectory path createDirectoryIfMissingVerbose verbosity True dir writeGenericPackageDescription path genPkg - return path -- TODO: Pick Lens modules from Cabal if we need them in more places condLibrary' :: Lens' GenericPackageDescription (Maybe (CondTree ConfVar [Dependency] Library)) diff --git a/etlas/Distribution/Client/ProjectConfig.hs b/etlas/Distribution/Client/ProjectConfig.hs index f9672b8..f11e498 100644 --- a/etlas/Distribution/Client/ProjectConfig.hs +++ b/etlas/Distribution/Client/ProjectConfig.hs @@ -119,6 +119,7 @@ import Distribution.ParseUtils import Control.Monad import Control.Monad.Trans (liftIO) import Control.Exception +import qualified Data.Hashable as Hashable import Data.Maybe import Data.Either import qualified Data.Map as Map @@ -1002,11 +1003,18 @@ readSourcePackage verbosity distDirLayout where dir = takeDirectory cabalFile -readSourcePackage verbosity _distDirLayout +readSourcePackage verbosity distDirLayout (ProjectPackageLocalDhallDirectory dir dhallFile) = do - monitorFiles [monitorFileHashed dhallFile] root <- askRoot - pkgdesc <- liftIO $ Dhall.readDhallGenericPackageDescription verbosity (root dhallFile) + let dhallPath = root dhallFile + fileMonitorDhall = monitorFileHashed dhallPath + monitorFiles [ fileMonitorDhall ] + pkgdesc <- liftIO $ + Dhall.readDhallGenericPackageDescription verbosity ( dhallPath ) + let cacheDir = distProjectCacheFile distDirLayout + cabalFileName = ( show $ Hashable.hash dhallPath ) ++ ".cabal" + liftIO $ + Dhall.writeDerivedCabalFile verbosity ( cacheDir cabalFileName ) pkgdesc return $ SpecificSourcePackage SourcePackage { packageInfoId = packageId pkgdesc, packageDescription = pkgdesc, diff --git a/etlas/Distribution/Client/SetupWrapper.hs b/etlas/Distribution/Client/SetupWrapper.hs index 38a0eae..f105223 100644 --- a/etlas/Distribution/Client/SetupWrapper.hs +++ b/etlas/Distribution/Client/SetupWrapper.hs @@ -401,8 +401,9 @@ setupWrapper verbosity options mgenPkg mpkg cmd flags extraArgs = do if needDerivedCabalFile then do let distDir = useDistPref options dir = if isAbsolute distDir then distDir else currentDir distDir + cabalFilePath = dir "etlas.dhall.cabal" genPkg = setupGenericPackage setup - cabalFilePath <- writeDerivedCabalFile verbosity dir genPkg + writeDerivedCabalFile verbosity cabalFilePath genPkg absCabalFilePath <- makeAbsoluteToCwd cabalFilePath return ["--cabal-file", absCabalFilePath] else return [] From 5de9e703633b78f5af422df572ce45606202b37e Mon Sep 17 00:00:00 2001 From: jneira Date: Thu, 24 Jan 2019 15:02:48 +0100 Subject: [PATCH 02/11] Read config from derived cabal file --- .../Client/PackageDescription/Dhall.hs | 33 ++++++++++++++++--- etlas/Distribution/Client/ProjectConfig.hs | 3 +- 2 files changed, 29 insertions(+), 7 deletions(-) diff --git a/etlas/Distribution/Client/PackageDescription/Dhall.hs b/etlas/Distribution/Client/PackageDescription/Dhall.hs index 1d63a06..d5d0b4e 100644 --- a/etlas/Distribution/Client/PackageDescription/Dhall.hs +++ b/etlas/Distribution/Client/PackageDescription/Dhall.hs @@ -32,18 +32,38 @@ import Lens.Micro (Lens') import qualified Lens.Micro.Extras as Lens import System.Directory (doesFileExist) -import System.FilePath (takeDirectory, takeExtension) +import System.FilePath (takeDirectory, takeExtension, ()) import System.CPUTime (getCPUTime) import Control.Monad (unless) - +import Data.Word (Word64) +import qualified Data.Hashable as Hashable +import Numeric (showHex) + readGenericPackageDescription :: Verbosity -> FilePath -> IO GenericPackageDescription readGenericPackageDescription verbosity path = if (takeExtension path) == ".dhall" then - readDhallGenericPackageDescription verbosity path + readCachedDhallGenericPackageDescription verbosity path else Cabal.Parse.readGenericPackageDescription verbosity path +readCachedDhallGenericPackageDescription :: Verbosity -> FilePath + -> IO GenericPackageDescription +readCachedDhallGenericPackageDescription verbosity dhallFilePath = do + + let cacheDir = takeDirectory dhallFilePath "dist" "cache" + derivedCabalFilePath = cacheDir getDerivedCabalFileName dhallFilePath + + exists <- doesFileExist derivedCabalFilePath + + if exists then do + info verbosity + $ "Reading package configuration from derived cabal file: " + ++ derivedCabalFilePath + readGenericPackageDescription verbosity derivedCabalFilePath + else + readDhallGenericPackageDescription verbosity dhallFilePath + readDhallGenericPackageDescription :: Verbosity -> FilePath -> IO GenericPackageDescription readDhallGenericPackageDescription verbosity dhallFilePath = do @@ -83,8 +103,11 @@ parseGenericPackageDescriptionFromDhall dhallFilePath content = do & Lens.set Dhall.sourceName dhallFilePath fmap fixGPDConstraints $ dhallToCabal settings content --- writeDerivedCabalFileFromDhallFile :: - +getDerivedCabalFileName :: FilePath -> FilePath +getDerivedCabalFileName dhallFilePath = hexStr ++ ".cabal" + where hash = Hashable.hash dhallFilePath + hexStr = showHex ( ( fromIntegral hash ) :: Word64 ) "" + writeDerivedCabalFile :: Verbosity -> FilePath -> GenericPackageDescription -> IO () writeDerivedCabalFile verbosity path genPkg = do diff --git a/etlas/Distribution/Client/ProjectConfig.hs b/etlas/Distribution/Client/ProjectConfig.hs index f11e498..b997e82 100644 --- a/etlas/Distribution/Client/ProjectConfig.hs +++ b/etlas/Distribution/Client/ProjectConfig.hs @@ -119,7 +119,6 @@ import Distribution.ParseUtils import Control.Monad import Control.Monad.Trans (liftIO) import Control.Exception -import qualified Data.Hashable as Hashable import Data.Maybe import Data.Either import qualified Data.Map as Map @@ -1012,7 +1011,7 @@ readSourcePackage verbosity distDirLayout pkgdesc <- liftIO $ Dhall.readDhallGenericPackageDescription verbosity ( dhallPath ) let cacheDir = distProjectCacheFile distDirLayout - cabalFileName = ( show $ Hashable.hash dhallPath ) ++ ".cabal" + cabalFileName = Dhall.getDerivedCabalFileName dhallPath liftIO $ Dhall.writeDerivedCabalFile verbosity ( cacheDir cabalFileName ) pkgdesc return $ SpecificSourcePackage SourcePackage { From 3836b7b1532ebd5360904c075d13573392ad8bd0 Mon Sep 17 00:00:00 2001 From: jneira Date: Fri, 25 Jan 2019 00:52:50 +0100 Subject: [PATCH 03/11] Use relative paths to cache etlas.dhall --- etlas/Distribution/Client/PackageDescription/Dhall.hs | 9 +++++++-- etlas/Distribution/Client/ProjectConfig.hs | 7 +++---- 2 files changed, 10 insertions(+), 6 deletions(-) diff --git a/etlas/Distribution/Client/PackageDescription/Dhall.hs b/etlas/Distribution/Client/PackageDescription/Dhall.hs index d5d0b4e..85ac854 100644 --- a/etlas/Distribution/Client/PackageDescription/Dhall.hs +++ b/etlas/Distribution/Client/PackageDescription/Dhall.hs @@ -51,8 +51,7 @@ readCachedDhallGenericPackageDescription :: Verbosity -> FilePath -> IO GenericPackageDescription readCachedDhallGenericPackageDescription verbosity dhallFilePath = do - let cacheDir = takeDirectory dhallFilePath "dist" "cache" - derivedCabalFilePath = cacheDir getDerivedCabalFileName dhallFilePath + let derivedCabalFilePath = getDerivedCabalFilePath dhallFilePath exists <- doesFileExist derivedCabalFilePath @@ -103,6 +102,12 @@ parseGenericPackageDescriptionFromDhall dhallFilePath content = do & Lens.set Dhall.sourceName dhallFilePath fmap fixGPDConstraints $ dhallToCabal settings content +getDerivedCabalFilePath :: FilePath -> FilePath +getDerivedCabalFilePath dhallFilePath = + cacheDir getDerivedCabalFileName dhallFilePath + where cacheDir = takeDirectory dhallFilePath "dist" "cache" + + getDerivedCabalFileName :: FilePath -> FilePath getDerivedCabalFileName dhallFilePath = hexStr ++ ".cabal" where hash = Hashable.hash dhallFilePath diff --git a/etlas/Distribution/Client/ProjectConfig.hs b/etlas/Distribution/Client/ProjectConfig.hs index b997e82..9654dab 100644 --- a/etlas/Distribution/Client/ProjectConfig.hs +++ b/etlas/Distribution/Client/ProjectConfig.hs @@ -1002,7 +1002,7 @@ readSourcePackage verbosity distDirLayout where dir = takeDirectory cabalFile -readSourcePackage verbosity distDirLayout +readSourcePackage verbosity _distDirLayout (ProjectPackageLocalDhallDirectory dir dhallFile) = do root <- askRoot let dhallPath = root dhallFile @@ -1010,10 +1010,9 @@ readSourcePackage verbosity distDirLayout monitorFiles [ fileMonitorDhall ] pkgdesc <- liftIO $ Dhall.readDhallGenericPackageDescription verbosity ( dhallPath ) - let cacheDir = distProjectCacheFile distDirLayout - cabalFileName = Dhall.getDerivedCabalFileName dhallPath + let cabalFilePath = Dhall.getDerivedCabalFilePath dhallPath liftIO $ - Dhall.writeDerivedCabalFile verbosity ( cacheDir cabalFileName ) pkgdesc + Dhall.writeDerivedCabalFile verbosity cabalFilePath pkgdesc return $ SpecificSourcePackage SourcePackage { packageInfoId = packageId pkgdesc, packageDescription = pkgdesc, From f37bf6c1ef2a4863da119699ffd62fb15bea6274 Mon Sep 17 00:00:00 2001 From: jneira Date: Fri, 25 Jan 2019 14:43:11 +0100 Subject: [PATCH 04/11] Use canonical path to dhall.etlas to name derived cabal file --- .../Client/PackageDescription/Dhall.hs | 22 ++++++++++--------- etlas/Distribution/Client/ProjectConfig.hs | 8 +++---- 2 files changed, 16 insertions(+), 14 deletions(-) diff --git a/etlas/Distribution/Client/PackageDescription/Dhall.hs b/etlas/Distribution/Client/PackageDescription/Dhall.hs index 85ac854..4306d8b 100644 --- a/etlas/Distribution/Client/PackageDescription/Dhall.hs +++ b/etlas/Distribution/Client/PackageDescription/Dhall.hs @@ -31,7 +31,7 @@ import qualified Lens.Micro as Lens import Lens.Micro (Lens') import qualified Lens.Micro.Extras as Lens -import System.Directory (doesFileExist) +import System.Directory (doesFileExist, canonicalizePath) import System.FilePath (takeDirectory, takeExtension, ()) import System.CPUTime (getCPUTime) import Control.Monad (unless) @@ -51,8 +51,7 @@ readCachedDhallGenericPackageDescription :: Verbosity -> FilePath -> IO GenericPackageDescription readCachedDhallGenericPackageDescription verbosity dhallFilePath = do - let derivedCabalFilePath = getDerivedCabalFilePath dhallFilePath - + derivedCabalFilePath <- getDerivedCabalFilePath dhallFilePath exists <- doesFileExist derivedCabalFilePath if exists then do @@ -102,16 +101,19 @@ parseGenericPackageDescriptionFromDhall dhallFilePath content = do & Lens.set Dhall.sourceName dhallFilePath fmap fixGPDConstraints $ dhallToCabal settings content -getDerivedCabalFilePath :: FilePath -> FilePath -getDerivedCabalFilePath dhallFilePath = - cacheDir getDerivedCabalFileName dhallFilePath +getDerivedCabalFilePath :: FilePath -> IO FilePath +getDerivedCabalFilePath dhallFilePath = do + cabalFileName <- getDerivedCabalFileName dhallFilePath + return $ cacheDir cabalFileName where cacheDir = takeDirectory dhallFilePath "dist" "cache" -getDerivedCabalFileName :: FilePath -> FilePath -getDerivedCabalFileName dhallFilePath = hexStr ++ ".cabal" - where hash = Hashable.hash dhallFilePath - hexStr = showHex ( ( fromIntegral hash ) :: Word64 ) "" +getDerivedCabalFileName :: FilePath -> IO FilePath +getDerivedCabalFileName dhallFilePath = do + canonPath <- canonicalizePath dhallFilePath + let hash = Hashable.hash canonPath + hexStr = showHex ( ( fromIntegral hash ) :: Word64 ) "" + return $ hexStr ++ ".cabal" writeDerivedCabalFile :: Verbosity -> FilePath -> GenericPackageDescription -> IO () diff --git a/etlas/Distribution/Client/ProjectConfig.hs b/etlas/Distribution/Client/ProjectConfig.hs index 9654dab..3b8bc1e 100644 --- a/etlas/Distribution/Client/ProjectConfig.hs +++ b/etlas/Distribution/Client/ProjectConfig.hs @@ -1008,10 +1008,10 @@ readSourcePackage verbosity _distDirLayout let dhallPath = root dhallFile fileMonitorDhall = monitorFileHashed dhallPath monitorFiles [ fileMonitorDhall ] - pkgdesc <- liftIO $ - Dhall.readDhallGenericPackageDescription verbosity ( dhallPath ) - let cabalFilePath = Dhall.getDerivedCabalFilePath dhallPath - liftIO $ + pkgdesc <- + liftIO $ Dhall.readDhallGenericPackageDescription verbosity ( dhallPath ) + liftIO $ do + cabalFilePath <- Dhall.getDerivedCabalFilePath dhallPath Dhall.writeDerivedCabalFile verbosity cabalFilePath pkgdesc return $ SpecificSourcePackage SourcePackage { packageInfoId = packageId pkgdesc, From 4d6638ee4f6dfad5993a25c8cbb421ad3a7e33df Mon Sep 17 00:00:00 2001 From: jneira Date: Mon, 28 Jan 2019 00:51:44 +0100 Subject: [PATCH 05/11] Using dhall cache storing the hash in a intermediate file --- .../Client/PackageDescription/Dhall.hs | 201 +++++++++++++----- etlas/Distribution/Client/ProjectConfig.hs | 5 +- etlas/etlas.cabal | 8 +- 3 files changed, 150 insertions(+), 64 deletions(-) diff --git a/etlas/Distribution/Client/PackageDescription/Dhall.hs b/etlas/Distribution/Client/PackageDescription/Dhall.hs index 4306d8b..1f0bb7f 100644 --- a/etlas/Distribution/Client/PackageDescription/Dhall.hs +++ b/etlas/Distribution/Client/PackageDescription/Dhall.hs @@ -1,26 +1,52 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP, RecordWildCards, OverloadedStrings #-} module Distribution.Client.PackageDescription.Dhall where +import Control.Exception ( SomeException, handle, throwIO ) +import qualified Control.Monad.Trans.State.Strict as State + +import qualified Crypto.Hash + import Data.Function ( (&) ) +import qualified Data.Hashable as Hashable +import Data.Maybe ( fromMaybe ) +import Data.Semigroup ( (<>) ) import qualified Data.Text as StrictText import qualified Data.Text.IO as StrictText +import Data.Word ( Word64 ) + import qualified Dhall -import DhallToCabal (dhallToCabal) +import qualified Dhall.Binary as Dhall +import qualified Dhall.Core as Dhall + hiding ( Type ) +import qualified Dhall.Context +import qualified Dhall.Import as Dhall + hiding ( startingContext, standardVersion ) +import qualified Dhall.Import ( standardVersion ) +import qualified Dhall.Parser as Dhall +import qualified Dhall.TypeCheck as Dhall + +import DhallToCabal ( dhallToCabal, genericPackageDescription ) import Distribution.Verbosity import Distribution.PackageDescription.PrettyPrint - (writeGenericPackageDescription) + ( writeGenericPackageDescription ) #ifdef CABAL_PARSEC import qualified Data.ByteString.Char8 as BS.Char8 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, createDirectoryIfMissingVerbose) +import Distribution.Simple.Utils + ( info, createDirectoryIfMissingVerbose ) import Distribution.PackageDescription import Distribution.Types.Dependency import Distribution.Types.ForeignLib @@ -28,16 +54,21 @@ import Distribution.Types.UnqualComponentName import Distribution.Types.CondTree import qualified Lens.Micro as Lens -import Lens.Micro (Lens') +import Lens.Micro ( Lens' ) import qualified Lens.Micro.Extras as Lens -import System.Directory (doesFileExist, canonicalizePath) -import System.FilePath (takeDirectory, takeExtension, ()) -import System.CPUTime (getCPUTime) -import Control.Monad (unless) -import Data.Word (Word64) -import qualified Data.Hashable as Hashable import Numeric (showHex) + +import System.CPUTime ( getCPUTime ) +import System.Directory + ( createDirectoryIfMissing + , doesFileExist + , canonicalizePath + ) +import System.FilePath + ( takeDirectory + , takeExtension + , () ) readGenericPackageDescription :: Verbosity -> FilePath -> IO GenericPackageDescription @@ -47,40 +78,6 @@ readGenericPackageDescription verbosity path = else Cabal.Parse.readGenericPackageDescription verbosity path -readCachedDhallGenericPackageDescription :: Verbosity -> FilePath - -> IO GenericPackageDescription -readCachedDhallGenericPackageDescription verbosity dhallFilePath = do - - derivedCabalFilePath <- getDerivedCabalFilePath dhallFilePath - exists <- doesFileExist derivedCabalFilePath - - if exists then do - info verbosity - $ "Reading package configuration from derived cabal file: " - ++ derivedCabalFilePath - readGenericPackageDescription verbosity derivedCabalFilePath - else - readDhallGenericPackageDescription verbosity dhallFilePath - -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 - start <- getCPUTime - gpd <- explaining $ parseGenericPackageDescriptionFromDhall dhallFilePath source - end <- getCPUTime - let diff = (fromIntegral (end - start)) / (10^(12 :: Integer)) - info verbosity $ "Configuration readed in " ++ show (diff :: Double) ++ " seconds" - return gpd - - where explaining = if verbosity >= verbose then Dhall.detailed else id - parseCabalGenericPackageDescription :: String -> Maybe GenericPackageDescription #ifdef CABAL_PARSEC @@ -93,27 +90,115 @@ parseCabalGenericPackageDescription content = _ -> Nothing #endif +readCachedDhallGenericPackageDescription :: Verbosity -> FilePath + -> IO GenericPackageDescription +readCachedDhallGenericPackageDescription verbosity dhallFilePath = do + + let explaining = if verbosity >= verbose then Dhall.detailed else id + + let readAndCacheGPD = do + info verbosity $ "Reading and caching package configuration from dhall file: " + ++ dhallFilePath + explaining $ readAndCacheGenericPackageDescriptionFromDhall dhallFilePath + + start <- getCPUTime + + fileWithDhallHashPath <- getFileWithDhallHashFilePath dhallFilePath + exists <- doesFileExist fileWithDhallHashPath + + gpd <- + if exists then do + hash <- StrictText.readFile fileWithDhallHashPath + + info verbosity $ "Reading package configuration from dhall cache using hash: " + ++ ( show hash ) ++ " stored in the file: " ++ fileWithDhallHashPath + + let cacheImport = "missing sha256:" <> hash + + let handler :: SomeException -> IO GenericPackageDescription + handler _ = readAndCacheGPD + + Control.Exception.handle handler + ( explaining $ + parseGenericPackageDescriptionFromDhall dhallFilePath cacheImport ) + else do + info verbosity $ "Missing file with the dhall cache: " + ++ fileWithDhallHashPath + readAndCacheGPD + + end <- getCPUTime + let diff = (fromIntegral (end - start)) / (10^(12 :: Integer)) + info verbosity $ "Configuration readed in " ++ show (diff :: Double) ++ " seconds" + + return gpd + parseGenericPackageDescriptionFromDhall :: FilePath -> StrictText.Text -> IO GenericPackageDescription -parseGenericPackageDescriptionFromDhall dhallFilePath content = do +parseGenericPackageDescriptionFromDhall dhallFilePath src = do let settings = Dhall.defaultInputSettings & Lens.set Dhall.rootDirectory ( takeDirectory dhallFilePath ) & Lens.set Dhall.sourceName dhallFilePath - fmap fixGPDConstraints $ dhallToCabal settings content + fmap fixGPDConstraints $ dhallToCabal settings src -getDerivedCabalFilePath :: FilePath -> IO FilePath -getDerivedCabalFilePath dhallFilePath = do - cabalFileName <- getDerivedCabalFileName dhallFilePath - return $ cacheDir cabalFileName - where cacheDir = takeDirectory dhallFilePath "dist" "cache" +readAndCacheGenericPackageDescriptionFromDhall :: FilePath + -> IO GenericPackageDescription +readAndCacheGenericPackageDescriptionFromDhall dhallFilePath = do + src <- StrictText.readFile dhallFilePath + parseAndCacheGenericPackageDescriptionFromDhall dhallFilePath src + +parseAndCacheGenericPackageDescriptionFromDhall :: FilePath -> StrictText.Text + -> IO GenericPackageDescription +parseAndCacheGenericPackageDescriptionFromDhall dhallFilePath src = do + let Dhall.Type {..} = genericPackageDescription + settings = Dhall.defaultInputSettings + & Lens.set Dhall.rootDirectory ( takeDirectory dhallFilePath ) + & Lens.set Dhall.sourceName dhallFilePath + expr <- Dhall.inputExprWithSettings settings src + let annot = ( ( Dhall.Annot expr expected ) + :: Dhall.Expr Dhall.Src Dhall.X ) + _ <- throws ( Dhall.typeWith Dhall.Context.empty annot ) + let hash = Dhall.hashExpression Dhall.defaultStandardVersion expr + writeDhallToCache hash expr + writeFileWithDhallHash hash dhallFilePath + return $ fixGPDConstraints ( fromMaybe + ( error "Empty extracted GenericPackageDescription" ) + ( extract expr ) ) + where throws = either Control.Exception.throwIO return +writeDhallToCache :: Crypto.Hash.Digest Crypto.Hash.SHA256 + -> Dhall.Expr Dhall.Src Dhall.X + -> IO () +writeDhallToCache hash expr = do + let status = Lens.set Dhall.Import.standardVersion + Dhall.defaultStandardVersion (Dhall.emptyStatus ".") + newImportHashed = + Dhall.ImportHashed { Dhall.hash = Just hash + , Dhall.importType = Dhall.Missing + } + newImport = + Dhall.Import { Dhall.importHashed = newImportHashed + , Dhall.importMode = Dhall.Code + } + State.evalStateT (Dhall.exprToImport newImport expr) status + +writeFileWithDhallHash :: Crypto.Hash.Digest Crypto.Hash.SHA256 + -> FilePath -> IO () +writeFileWithDhallHash hash dhallFilePath = do + path <- getFileWithDhallHashFilePath dhallFilePath + createDirectoryIfMissing True $ takeDirectory path + StrictText.writeFile path ( StrictText.pack ( show hash ) ) + +getFileWithDhallHashFilePath :: FilePath -> IO FilePath +getFileWithDhallHashFilePath dhallFilePath = do + let cacheDir = takeDirectory dhallFilePath "dist" "cache" + hashFileName <- getFileWithDhallHashFileName dhallFilePath + return $ cacheDir hashFileName -getDerivedCabalFileName :: FilePath -> IO FilePath -getDerivedCabalFileName dhallFilePath = do +getFileWithDhallHashFileName :: FilePath -> IO FilePath +getFileWithDhallHashFileName dhallFilePath = do canonPath <- canonicalizePath dhallFilePath let hash = Hashable.hash canonPath - hexStr = showHex ( ( fromIntegral hash ) :: Word64 ) "" - return $ hexStr ++ ".cabal" + return $ showHex ( ( fromIntegral hash ) :: Word64 ) "" writeDerivedCabalFile :: Verbosity -> FilePath -> GenericPackageDescription -> IO () diff --git a/etlas/Distribution/Client/ProjectConfig.hs b/etlas/Distribution/Client/ProjectConfig.hs index 3b8bc1e..a96b0c5 100644 --- a/etlas/Distribution/Client/ProjectConfig.hs +++ b/etlas/Distribution/Client/ProjectConfig.hs @@ -1009,10 +1009,7 @@ readSourcePackage verbosity _distDirLayout fileMonitorDhall = monitorFileHashed dhallPath monitorFiles [ fileMonitorDhall ] pkgdesc <- - liftIO $ Dhall.readDhallGenericPackageDescription verbosity ( dhallPath ) - liftIO $ do - cabalFilePath <- Dhall.getDerivedCabalFilePath dhallPath - Dhall.writeDerivedCabalFile verbosity cabalFilePath pkgdesc + liftIO $ Dhall.readCachedDhallGenericPackageDescription verbosity ( dhallPath ) return $ SpecificSourcePackage SourcePackage { packageInfoId = packageId pkgdesc, packageDescription = pkgdesc, diff --git a/etlas/etlas.cabal b/etlas/etlas.cabal index 6213734..282baea 100644 --- a/etlas/etlas.cabal +++ b/etlas/etlas.cabal @@ -200,6 +200,7 @@ library base16-bytestring >= 0.1.1 && < 0.2, binary >= 0.5 && < 0.9, bytestring >= 0.9 && < 1, + cryptonite >= 0.23 && < 1.0, etlas-cabal >= 1.0, dhall >= 1.19.0 && < 1.20, dhall-to-etlas >= 1.3, @@ -225,8 +226,11 @@ 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 !impl(ghc >= 8.0) + build-depends: semigroups == 0.18.*, + transformers == 0.4.2.* + if os(windows) build-depends: Win32 >= 2 && < 3 else From 70715df6b385f149300332229079725b20e23039 Mon Sep 17 00:00:00 2001 From: jneira Date: Mon, 28 Jan 2019 14:59:52 +0100 Subject: [PATCH 06/11] Finish read config using dhall cache --- .../Client/PackageDescription/Dhall.hs | 107 +++++++++++------- etlas/Distribution/Client/ProjectConfig.hs | 6 +- 2 files changed, 68 insertions(+), 45 deletions(-) diff --git a/etlas/Distribution/Client/PackageDescription/Dhall.hs b/etlas/Distribution/Client/PackageDescription/Dhall.hs index 1f0bb7f..5dbbfd0 100644 --- a/etlas/Distribution/Client/PackageDescription/Dhall.hs +++ b/etlas/Distribution/Client/PackageDescription/Dhall.hs @@ -1,7 +1,7 @@ {-# LANGUAGE CPP, RecordWildCards, OverloadedStrings #-} module Distribution.Client.PackageDescription.Dhall where -import Control.Exception ( SomeException, handle, throwIO ) +import Control.Exception ( throwIO ) import qualified Control.Monad.Trans.State.Strict as State import qualified Crypto.Hash @@ -90,47 +90,42 @@ parseCabalGenericPackageDescription content = _ -> Nothing #endif +measuringTime :: Verbosity -> String -> IO a -> IO a +measuringTime verbosity msg action = do + start <- getCPUTime + x <- action + end <- getCPUTime + let diff = (fromIntegral (end - start)) / (10^(12 :: Integer)) + info verbosity $ msg ++ show (diff :: Double) ++ " seconds" + return x + readCachedDhallGenericPackageDescription :: Verbosity -> FilePath -> IO GenericPackageDescription readCachedDhallGenericPackageDescription verbosity dhallFilePath = do - let explaining = if verbosity >= verbose then Dhall.detailed else id - - let readAndCacheGPD = do - info verbosity $ "Reading and caching package configuration from dhall file: " - ++ dhallFilePath - explaining $ readAndCacheGenericPackageDescriptionFromDhall dhallFilePath - - start <- getCPUTime - fileWithDhallHashPath <- getFileWithDhallHashFilePath dhallFilePath exists <- doesFileExist fileWithDhallHashPath gpd <- - if exists then do - hash <- StrictText.readFile fileWithDhallHashPath + if exists then measuringTime verbosity "Configuration readed in " $ do + + expectedHash <- StrictText.readFile fileWithDhallHashPath + let expectedHashStr = StrictText.unpack expectedHash info verbosity $ "Reading package configuration from dhall cache using hash: " - ++ ( show hash ) ++ " stored in the file: " ++ fileWithDhallHashPath + ++ expectedHashStr ++ " stored in file: " ++ fileWithDhallHashPath - let cacheImport = "missing sha256:" <> hash - - let handler :: SomeException -> IO GenericPackageDescription - handler _ = readAndCacheGPD + let cacheImport = "missing sha256:" <> expectedHash + parseGenericPackageDescriptionFromDhall dhallFilePath cacheImport - Control.Exception.handle handler - ( explaining $ - parseGenericPackageDescriptionFromDhall dhallFilePath cacheImport ) else do - info verbosity $ "Missing file with the dhall cache: " - ++ fileWithDhallHashPath - readAndCacheGPD + info verbosity $ "Missing file with dhall cache hash: " + ++ fileWithDhallHashPath + readAndCacheGenericPackageDescriptionFromDhall verbosity dhallFilePath - end <- getCPUTime - let diff = (fromIntegral (end - start)) / (10^(12 :: Integer)) - info verbosity $ "Configuration readed in " ++ show (diff :: Double) ++ " seconds" + let explaining = if verbosity >= verbose then Dhall.detailed else id - return gpd + explaining $ return gpd parseGenericPackageDescriptionFromDhall :: FilePath -> StrictText.Text -> IO GenericPackageDescription @@ -140,31 +135,59 @@ parseGenericPackageDescriptionFromDhall dhallFilePath src = do & Lens.set Dhall.sourceName dhallFilePath fmap fixGPDConstraints $ dhallToCabal settings src -readAndCacheGenericPackageDescriptionFromDhall :: FilePath +readAndCacheGenericPackageDescriptionFromDhall :: Verbosity + -> FilePath -> IO GenericPackageDescription -readAndCacheGenericPackageDescriptionFromDhall dhallFilePath = do - src <- StrictText.readFile dhallFilePath - parseAndCacheGenericPackageDescriptionFromDhall dhallFilePath src +readAndCacheGenericPackageDescriptionFromDhall verbosity dhallFilePath = do + info verbosity $ "Reading and caching package configuration from dhall file: " + ++ dhallFilePath + measuringTime verbosity "Configuration readed in " $ do + src <- StrictText.readFile dhallFilePath + parseAndCacheGenericPackageDescriptionFromDhall dhallFilePath src parseAndCacheGenericPackageDescriptionFromDhall :: FilePath -> StrictText.Text - -> IO GenericPackageDescription + -> IO GenericPackageDescription parseAndCacheGenericPackageDescriptionFromDhall dhallFilePath src = do let Dhall.Type {..} = genericPackageDescription - settings = Dhall.defaultInputSettings - & Lens.set Dhall.rootDirectory ( takeDirectory dhallFilePath ) - & Lens.set Dhall.sourceName dhallFilePath - expr <- Dhall.inputExprWithSettings settings src - let annot = ( ( Dhall.Annot expr expected ) + ( hash, normExpr ) <- parseAndHashGenericPackageDescriptionFromDhall + dhallFilePath src + cacheAndExtractGenericPackageDescriptionFromDhall hash normExpr dhallFilePath + +cacheAndExtractGenericPackageDescriptionFromDhall :: Crypto.Hash.Digest Crypto.Hash.SHA256 + -> Dhall.Expr Dhall.Src Dhall.X + -> FilePath + -> IO GenericPackageDescription +cacheAndExtractGenericPackageDescriptionFromDhall hash normExpr dhallFilePath = do + gpd <- extractGenericPackageDescriptionFromDhall normExpr + writeDhallToCache hash normExpr + writeFileWithDhallHash hash dhallFilePath + return gpd + +extractGenericPackageDescriptionFromDhall :: Dhall.Expr Dhall.Src Dhall.X + -> IO GenericPackageDescription +extractGenericPackageDescriptionFromDhall expr = do + let Dhall.Type {..} = genericPackageDescription + annot = ( ( Dhall.Annot expr expected ) :: Dhall.Expr Dhall.Src Dhall.X ) _ <- throws ( Dhall.typeWith Dhall.Context.empty annot ) - let hash = Dhall.hashExpression Dhall.defaultStandardVersion expr - writeDhallToCache hash expr - writeFileWithDhallHash hash dhallFilePath return $ fixGPDConstraints ( fromMaybe ( error "Empty extracted GenericPackageDescription" ) - ( extract expr ) ) - where throws = either Control.Exception.throwIO return + ( extract expr ) ) + where throws = either Control.Exception.throwIO return +parseAndHashGenericPackageDescriptionFromDhall :: FilePath -> StrictText.Text + -> IO ( Crypto.Hash.Digest Crypto.Hash.SHA256 + , Dhall.Expr Dhall.Src Dhall.X + ) +parseAndHashGenericPackageDescriptionFromDhall dhallFilePath src = do + let settings = Dhall.defaultInputSettings + & Lens.set Dhall.rootDirectory ( takeDirectory dhallFilePath ) + & Lens.set Dhall.sourceName dhallFilePath + expr <- Dhall.inputExprWithSettings settings src + let normExpr = Dhall.alphaNormalize expr + hash = Dhall.hashExpression Dhall.defaultStandardVersion normExpr + return ( hash, normExpr ) + writeDhallToCache :: Crypto.Hash.Digest Crypto.Hash.SHA256 -> Dhall.Expr Dhall.Src Dhall.X -> IO () diff --git a/etlas/Distribution/Client/ProjectConfig.hs b/etlas/Distribution/Client/ProjectConfig.hs index a96b0c5..abdfc82 100644 --- a/etlas/Distribution/Client/ProjectConfig.hs +++ b/etlas/Distribution/Client/ProjectConfig.hs @@ -1005,11 +1005,11 @@ readSourcePackage verbosity distDirLayout readSourcePackage verbosity _distDirLayout (ProjectPackageLocalDhallDirectory dir dhallFile) = do root <- askRoot - let dhallPath = root dhallFile - fileMonitorDhall = monitorFileHashed dhallPath + let dhallPath = dir dhallFile + fileMonitorDhall = monitorFileHashed $ root dhallPath monitorFiles [ fileMonitorDhall ] pkgdesc <- - liftIO $ Dhall.readCachedDhallGenericPackageDescription verbosity ( dhallPath ) + liftIO $ Dhall.readAndCacheGenericPackageDescriptionFromDhall verbosity dhallPath return $ SpecificSourcePackage SourcePackage { packageInfoId = packageId pkgdesc, packageDescription = pkgdesc, From 71c4a55dadaf8c92bbd1b2724f0f7826a5cf83e1 Mon Sep 17 00:00:00 2001 From: jneira Date: Mon, 28 Jan 2019 21:54:50 +0100 Subject: [PATCH 07/11] Reorganize code --- .../Client/PackageDescription/Dhall.hs | 28 ++++++++++--------- 1 file changed, 15 insertions(+), 13 deletions(-) diff --git a/etlas/Distribution/Client/PackageDescription/Dhall.hs b/etlas/Distribution/Client/PackageDescription/Dhall.hs index 5dbbfd0..0254b7a 100644 --- a/etlas/Distribution/Client/PackageDescription/Dhall.hs +++ b/etlas/Distribution/Client/PackageDescription/Dhall.hs @@ -153,6 +153,20 @@ parseAndCacheGenericPackageDescriptionFromDhall dhallFilePath src = do dhallFilePath src cacheAndExtractGenericPackageDescriptionFromDhall hash normExpr dhallFilePath +parseAndHashGenericPackageDescriptionFromDhall :: FilePath -> StrictText.Text + -> IO ( Crypto.Hash.Digest Crypto.Hash.SHA256 + , Dhall.Expr Dhall.Src Dhall.X + ) +parseAndHashGenericPackageDescriptionFromDhall dhallFilePath src = do + let settings = Dhall.defaultInputSettings + & Lens.set Dhall.rootDirectory ( takeDirectory dhallFilePath ) + & Lens.set Dhall.sourceName dhallFilePath + expr <- Dhall.inputExprWithSettings settings src + let normExpr = Dhall.alphaNormalize expr + hash = Dhall.hashExpression Dhall.defaultStandardVersion normExpr + return ( hash, normExpr ) + + cacheAndExtractGenericPackageDescriptionFromDhall :: Crypto.Hash.Digest Crypto.Hash.SHA256 -> Dhall.Expr Dhall.Src Dhall.X -> FilePath @@ -174,19 +188,7 @@ extractGenericPackageDescriptionFromDhall expr = do ( error "Empty extracted GenericPackageDescription" ) ( extract expr ) ) where throws = either Control.Exception.throwIO return - -parseAndHashGenericPackageDescriptionFromDhall :: FilePath -> StrictText.Text - -> IO ( Crypto.Hash.Digest Crypto.Hash.SHA256 - , Dhall.Expr Dhall.Src Dhall.X - ) -parseAndHashGenericPackageDescriptionFromDhall dhallFilePath src = do - let settings = Dhall.defaultInputSettings - & Lens.set Dhall.rootDirectory ( takeDirectory dhallFilePath ) - & Lens.set Dhall.sourceName dhallFilePath - expr <- Dhall.inputExprWithSettings settings src - let normExpr = Dhall.alphaNormalize expr - hash = Dhall.hashExpression Dhall.defaultStandardVersion normExpr - return ( hash, normExpr ) + writeDhallToCache :: Crypto.Hash.Digest Crypto.Hash.SHA256 -> Dhall.Expr Dhall.Src Dhall.X From e9efcf0e581d25fae85ec2d75d07c6125b2b963e Mon Sep 17 00:00:00 2001 From: jneira Date: Tue, 29 Jan 2019 01:08:09 +0100 Subject: [PATCH 08/11] Format code and shorten function names --- etlas/Distribution/Client/IndexUtils.hs | 10 +- .../Client/PackageDescription/Dhall.hs | 132 +++++++++++------- etlas/Distribution/Client/ProjectConfig.hs | 5 +- etlas/Distribution/Client/Targets.hs | 7 +- 4 files changed, 92 insertions(+), 62 deletions(-) diff --git a/etlas/Distribution/Client/IndexUtils.hs b/etlas/Distribution/Client/IndexUtils.hs index e388961..747ac2c 100644 --- a/etlas/Distribution/Client/IndexUtils.hs +++ b/etlas/Distribution/Client/IndexUtils.hs @@ -80,7 +80,9 @@ 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, parseGenericPackageDescriptionFromDhall ) + ( readGenericPackageDescription ) +import qualified Distribution.Client.PackageDescription.Dhall as PackageDescription.Dhall + ( parse ) #ifdef CABAL_PARSEC import Distribution.PackageDescription.Parsec ( parseGenericPackageDescriptionMaybe, parseGenericPackageDescription, runParseResult ) @@ -545,7 +547,7 @@ extractPkg verbosity entry blockNo = case Tar.entryContent entry of Nothing -> error $ "Couldn't read etlas or cabal file " ++ show fileName parsed = if takeExtension fileName == ".dhall" - then fmap Just $ PackageDesc.Parse.parseGenericPackageDescriptionFromDhall fileName + then fmap Just $ PackageDescription.Dhall.parse fileName $ StrictText.decodeUtf8 $ BS.toStrict content else return $ #ifdef CABAL_PARSEC @@ -842,8 +844,8 @@ packageListFromCache verbosity mkPkg idxFile hnd Cache{..} mode patchesDir parsePackageDescription :: FilePath -> ByteString -> IO GenericPackageDescription parsePackageDescription fileName content = do if takeExtension fileName == ".dhall" - then PackageDesc.Parse.parseGenericPackageDescriptionFromDhall fileName - $ StrictText.decodeUtf8 $ BS.toStrict content + then PackageDescription.Dhall.parse fileName + $ StrictText.decodeUtf8 $ BS.toStrict content else #ifdef CABAL_PARSEC do diff --git a/etlas/Distribution/Client/PackageDescription/Dhall.hs b/etlas/Distribution/Client/PackageDescription/Dhall.hs index 0254b7a..bc1513c 100644 --- a/etlas/Distribution/Client/PackageDescription/Dhall.hs +++ b/etlas/Distribution/Client/PackageDescription/Dhall.hs @@ -27,7 +27,7 @@ import qualified Dhall.Import ( standardVersion ) import qualified Dhall.Parser as Dhall import qualified Dhall.TypeCheck as Dhall -import DhallToCabal ( dhallToCabal, genericPackageDescription ) +import DhallToCabal ( genericPackageDescription ) import Distribution.Verbosity import Distribution.PackageDescription.PrettyPrint @@ -46,7 +46,9 @@ import Distribution.PackageDescription.Parse as Cabal.Parse ) #endif import Distribution.Simple.Utils - ( info, createDirectoryIfMissingVerbose ) + ( info + , createDirectoryIfMissingVerbose + ) import Distribution.PackageDescription import Distribution.Types.Dependency import Distribution.Types.ForeignLib @@ -68,13 +70,14 @@ import System.Directory import System.FilePath ( takeDirectory , takeExtension - , () ) + , () + ) readGenericPackageDescription :: Verbosity -> FilePath -> IO GenericPackageDescription readGenericPackageDescription verbosity path = if (takeExtension path) == ".dhall" then - readCachedDhallGenericPackageDescription verbosity path + readFromCache verbosity path else Cabal.Parse.readGenericPackageDescription verbosity path @@ -90,6 +93,7 @@ parseCabalGenericPackageDescription content = _ -> Nothing #endif + measuringTime :: Verbosity -> String -> IO a -> IO a measuringTime verbosity msg action = do start <- getCPUTime @@ -99,94 +103,102 @@ measuringTime verbosity msg action = do info verbosity $ msg ++ show (diff :: Double) ++ " seconds" return x -readCachedDhallGenericPackageDescription :: Verbosity -> FilePath - -> IO GenericPackageDescription -readCachedDhallGenericPackageDescription verbosity dhallFilePath = do +readFromCache :: Verbosity -> FilePath -> IO GenericPackageDescription +readFromCache verbosity dhallFilePath = do fileWithDhallHashPath <- getFileWithDhallHashFilePath dhallFilePath exists <- doesFileExist fileWithDhallHashPath gpd <- if exists then measuringTime verbosity "Configuration readed in " $ do - expectedHash <- StrictText.readFile fileWithDhallHashPath + let expectedHashStr = StrictText.unpack expectedHash info verbosity $ "Reading package configuration from dhall cache using hash: " ++ expectedHashStr ++ " stored in file: " ++ fileWithDhallHashPath let cacheImport = "missing sha256:" <> expectedHash - parseGenericPackageDescriptionFromDhall dhallFilePath cacheImport + + parse dhallFilePath cacheImport else do info verbosity $ "Missing file with dhall cache hash: " ++ fileWithDhallHashPath - readAndCacheGenericPackageDescriptionFromDhall verbosity dhallFilePath + readAndCache verbosity dhallFilePath let explaining = if verbosity >= verbose then Dhall.detailed else id explaining $ return gpd -parseGenericPackageDescriptionFromDhall :: FilePath -> StrictText.Text - -> IO GenericPackageDescription -parseGenericPackageDescriptionFromDhall dhallFilePath src = do - let settings = Dhall.defaultInputSettings - & Lens.set Dhall.rootDirectory ( takeDirectory dhallFilePath ) - & Lens.set Dhall.sourceName dhallFilePath - fmap fixGPDConstraints $ dhallToCabal settings src -readAndCacheGenericPackageDescriptionFromDhall :: Verbosity - -> FilePath - -> IO GenericPackageDescription -readAndCacheGenericPackageDescriptionFromDhall verbosity dhallFilePath = do +parse :: FilePath -> StrictText.Text -> IO GenericPackageDescription +parse dhallFilePath src = do + ( _, expr ) <- parseAndHash dhallFilePath src + + extract expr + + +readAndCache :: Verbosity -> FilePath -> IO GenericPackageDescription +readAndCache verbosity dhallFilePath = do info verbosity $ "Reading and caching package configuration from dhall file: " - ++ dhallFilePath + ++ dhallFilePath + measuringTime verbosity "Configuration readed in " $ do src <- StrictText.readFile dhallFilePath - parseAndCacheGenericPackageDescriptionFromDhall dhallFilePath src + parseAndCache dhallFilePath src + -parseAndCacheGenericPackageDescriptionFromDhall :: FilePath -> StrictText.Text - -> IO GenericPackageDescription -parseAndCacheGenericPackageDescriptionFromDhall dhallFilePath src = do +parseAndCache :: FilePath -> StrictText.Text -> IO GenericPackageDescription +parseAndCache dhallFilePath src = do let Dhall.Type {..} = genericPackageDescription - ( hash, normExpr ) <- parseAndHashGenericPackageDescriptionFromDhall - dhallFilePath src - cacheAndExtractGenericPackageDescriptionFromDhall hash normExpr dhallFilePath - -parseAndHashGenericPackageDescriptionFromDhall :: FilePath -> StrictText.Text - -> IO ( Crypto.Hash.Digest Crypto.Hash.SHA256 - , Dhall.Expr Dhall.Src Dhall.X - ) -parseAndHashGenericPackageDescriptionFromDhall dhallFilePath src = do + + ( hash, normExpr ) <- parseAndHash dhallFilePath src + + cacheAndExtract hash normExpr dhallFilePath + + +parseAndHash :: FilePath -> StrictText.Text + -> IO ( Crypto.Hash.Digest Crypto.Hash.SHA256 + , Dhall.Expr Dhall.Src Dhall.X + ) +parseAndHash dhallFilePath src = do let settings = Dhall.defaultInputSettings & Lens.set Dhall.rootDirectory ( takeDirectory dhallFilePath ) & Lens.set Dhall.sourceName dhallFilePath + expr <- Dhall.inputExprWithSettings settings src + let normExpr = Dhall.alphaNormalize expr hash = Dhall.hashExpression Dhall.defaultStandardVersion normExpr + return ( hash, normExpr ) -cacheAndExtractGenericPackageDescriptionFromDhall :: Crypto.Hash.Digest Crypto.Hash.SHA256 - -> Dhall.Expr Dhall.Src Dhall.X - -> FilePath - -> IO GenericPackageDescription -cacheAndExtractGenericPackageDescriptionFromDhall hash normExpr dhallFilePath = do - gpd <- extractGenericPackageDescriptionFromDhall normExpr +cacheAndExtract :: Crypto.Hash.Digest Crypto.Hash.SHA256 + -> Dhall.Expr Dhall.Src Dhall.X + -> FilePath + -> IO GenericPackageDescription +cacheAndExtract hash normExpr dhallFilePath = do + gpd <- extract normExpr + writeDhallToCache hash normExpr writeFileWithDhallHash hash dhallFilePath + return gpd -extractGenericPackageDescriptionFromDhall :: Dhall.Expr Dhall.Src Dhall.X - -> IO GenericPackageDescription -extractGenericPackageDescriptionFromDhall expr = do +extract :: Dhall.Expr Dhall.Src Dhall.X -> IO GenericPackageDescription +extract expr = do let Dhall.Type {..} = genericPackageDescription annot = ( ( Dhall.Annot expr expected ) :: Dhall.Expr Dhall.Src Dhall.X ) + _ <- throws ( Dhall.typeWith Dhall.Context.empty annot ) + return $ fixGPDConstraints ( fromMaybe ( error "Empty extracted GenericPackageDescription" ) ( extract expr ) ) + where throws = either Control.Exception.throwIO return @@ -194,45 +206,61 @@ writeDhallToCache :: Crypto.Hash.Digest Crypto.Hash.SHA256 -> Dhall.Expr Dhall.Src Dhall.X -> IO () writeDhallToCache hash expr = do - let status = Lens.set Dhall.Import.standardVersion - Dhall.defaultStandardVersion (Dhall.emptyStatus ".") + let status = + Lens.set + Dhall.Import.standardVersion + Dhall.defaultStandardVersion (Dhall.emptyStatus ".") newImportHashed = - Dhall.ImportHashed { Dhall.hash = Just hash - , Dhall.importType = Dhall.Missing - } + Dhall.ImportHashed + { Dhall.hash = Just hash + , Dhall.importType = Dhall.Missing + } newImport = - Dhall.Import { Dhall.importHashed = newImportHashed - , Dhall.importMode = Dhall.Code - } + Dhall.Import + { Dhall.importHashed = newImportHashed + , Dhall.importMode = Dhall.Code + } + State.evalStateT (Dhall.exprToImport newImport expr) status + writeFileWithDhallHash :: Crypto.Hash.Digest Crypto.Hash.SHA256 -> FilePath -> IO () writeFileWithDhallHash hash dhallFilePath = do path <- getFileWithDhallHashFilePath dhallFilePath + createDirectoryIfMissing True $ takeDirectory path StrictText.writeFile path ( StrictText.pack ( show hash ) ) + getFileWithDhallHashFilePath :: FilePath -> IO FilePath getFileWithDhallHashFilePath dhallFilePath = do let cacheDir = takeDirectory dhallFilePath "dist" "cache" + hashFileName <- getFileWithDhallHashFileName dhallFilePath return $ cacheDir hashFileName + getFileWithDhallHashFileName :: FilePath -> IO FilePath getFileWithDhallHashFileName dhallFilePath = do canonPath <- canonicalizePath dhallFilePath + let hash = Hashable.hash canonPath + return $ showHex ( ( fromIntegral hash ) :: Word64 ) "" + writeDerivedCabalFile :: Verbosity -> FilePath -> GenericPackageDescription -> IO () writeDerivedCabalFile verbosity path genPkg = do info verbosity $ "Writing derived cabal file from dhall file: " ++ path + let dir = takeDirectory path + createDirectoryIfMissingVerbose verbosity True dir writeGenericPackageDescription path genPkg + -- TODO: Pick Lens modules from Cabal if we need them in more places condLibrary' :: Lens' GenericPackageDescription (Maybe (CondTree ConfVar [Dependency] Library)) condLibrary' f s = fmap (\x -> s { condLibrary = x }) (f (condLibrary s)) diff --git a/etlas/Distribution/Client/ProjectConfig.hs b/etlas/Distribution/Client/ProjectConfig.hs index abdfc82..bdada3c 100644 --- a/etlas/Distribution/Client/ProjectConfig.hs +++ b/etlas/Distribution/Client/ProjectConfig.hs @@ -1005,11 +1005,10 @@ readSourcePackage verbosity distDirLayout readSourcePackage verbosity _distDirLayout (ProjectPackageLocalDhallDirectory dir dhallFile) = do root <- askRoot - let dhallPath = dir dhallFile + let dhallPath = dhallFile fileMonitorDhall = monitorFileHashed $ root dhallPath monitorFiles [ fileMonitorDhall ] - pkgdesc <- - liftIO $ Dhall.readAndCacheGenericPackageDescriptionFromDhall verbosity dhallPath + pkgdesc <- liftIO $ Dhall.readAndCache verbosity dhallPath return $ SpecificSourcePackage SourcePackage { packageInfoId = packageId pkgdesc, packageDescription = pkgdesc, diff --git a/etlas/Distribution/Client/Targets.hs b/etlas/Distribution/Client/Targets.hs index 0da3f44..0475069 100644 --- a/etlas/Distribution/Client/Targets.hs +++ b/etlas/Distribution/Client/Targets.hs @@ -95,8 +95,9 @@ import Distribution.Simple.Utils import qualified Data.ByteString.Lazy.Char8 as BS.Char8 #endif import Distribution.Client.PackageDescription.Dhall - ( readGenericPackageDescription, parseGenericPackageDescriptionFromDhall ) - + ( readGenericPackageDescription ) +import qualified Distribution.Client.PackageDescription.Dhall as PackageDescription.Dhall + ( parse ) -- import Data.List ( find, nub ) import Data.Either ( partitionEithers ) @@ -539,7 +540,7 @@ readPackageTarget verbosity = traverse modifyLocation -> IO (Maybe GenericPackageDescription) parsePackageDescription' filePath content = if takeExtension filePath == ".dhall" - then fmap Just $ parseGenericPackageDescriptionFromDhall filePath + then fmap Just $ PackageDescription.Dhall.parse filePath $ StrictText.decodeUtf8 $ BS.toStrict content else return $ #ifdef CABAL_PARSEC From a5170750b4cc8c47d598ecfcda6879955c9fcb23 Mon Sep 17 00:00:00 2001 From: jneira Date: Tue, 29 Jan 2019 06:36:39 +0100 Subject: [PATCH 09/11] Remove unused var --- etlas/Distribution/Client/PackageDescription/Dhall.hs | 3 --- 1 file changed, 3 deletions(-) diff --git a/etlas/Distribution/Client/PackageDescription/Dhall.hs b/etlas/Distribution/Client/PackageDescription/Dhall.hs index bc1513c..2526fbd 100644 --- a/etlas/Distribution/Client/PackageDescription/Dhall.hs +++ b/etlas/Distribution/Client/PackageDescription/Dhall.hs @@ -151,10 +151,7 @@ readAndCache verbosity dhallFilePath = do parseAndCache :: FilePath -> StrictText.Text -> IO GenericPackageDescription parseAndCache dhallFilePath src = do - let Dhall.Type {..} = genericPackageDescription - ( hash, normExpr ) <- parseAndHash dhallFilePath src - cacheAndExtract hash normExpr dhallFilePath From 6a11d9b72921703cfb2c4f4c417761fc73bc69f9 Mon Sep 17 00:00:00 2001 From: jneira Date: Tue, 29 Jan 2019 11:20:19 +0100 Subject: [PATCH 10/11] Set default cabal-version to 1.12 --- etlas/Distribution/Client/Init.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/etlas/Distribution/Client/Init.hs b/etlas/Distribution/Client/Init.hs index b5ffd4e..8da0927 100644 --- a/etlas/Distribution/Client/Init.hs +++ b/etlas/Distribution/Client/Init.hs @@ -844,7 +844,7 @@ generateCabalFile fileName c = (Just "Extra files to be distributed with the package, such as examples or a README.") True - , field "cabal-version" (Flag $ orLaterVersion (mkVersion [1,10])) + , field "cabal-version" (Flag $ mkVersion [1,12]) (Just "Constraint on the version of Cabal needed to build this package.") False From 059d38aef3838d47a87bea94442005463ca84c3e Mon Sep 17 00:00:00 2001 From: jneira Date: Tue, 29 Jan 2019 12:08:38 +0100 Subject: [PATCH 11/11] Use last version of 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 240191c..4c0ec00 160000 --- a/dhall-to-etlas +++ b/dhall-to-etlas @@ -1 +1 @@ -Subproject commit 240191c377dcfb61793609280b6c53600cb53862 +Subproject commit 4c0ec00b6abff31c3e1edaef5feec0c5b014fab7