Merge pull request typelead#80 from jneira/dhall

Use last dhall version 1.18.0

etlas/Distribution/Client/PackageDescription/Dhall.hs

@@ -10,34 +10,42 @@ import qualified Dhall
 import DhallToCabal (dhallToCabal)
 
 import Distribution.Verbosity
-import Distribution.PackageDescription
 import Distribution.PackageDescription.PrettyPrint
-         (showGenericPackageDescription, 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)
+import Distribution.PackageDescription
+import Distribution.Types.Dependency
+import Distribution.Types.ForeignLib
+import Distribution.Types.UnqualComponentName
+import Distribution.Types.CondTree
 
-import Lens.Micro (set)
+import qualified Lens.Micro as Lens
+import Lens.Micro (Lens')
+import qualified Lens.Micro.Extras as Lens
 
 import System.Directory (doesFileExist)
 import System.FilePath (takeDirectory, takeExtension, (</>))
-
+import System.CPUTime (getCPUTime)
 import Control.Monad    (unless)
 
-readGenericPackageDescription :: Verbosity -> FilePath -> IO GenericPackageDescription
+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 -> FilePath
+                                   -> IO GenericPackageDescription
 readDhallGenericPackageDescription verbosity dhallFilePath = do
   exists <- doesFileExist dhallFilePath
   unless exists $
@@ -46,23 +54,17 @@ readDhallGenericPackageDescription verbosity dhallFilePath = do
 
   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
+  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
+  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
@@ -74,12 +76,12 @@ parseCabalGenericPackageDescription content =
 #endif
 
 parseGenericPackageDescriptionFromDhall :: FilePath -> StrictText.Text
-                                             -> IO GenericPackageDescription  
+                                        -> IO GenericPackageDescription  
 parseGenericPackageDescriptionFromDhall dhallFilePath content = do
   let settings = Dhall.defaultInputSettings
-         & set Dhall.rootDirectory ( takeDirectory dhallFilePath )
-         & set Dhall.sourceName dhallFilePath
-  dhallToCabal settings content
+         & Lens.set Dhall.rootDirectory ( takeDirectory dhallFilePath )
+         & Lens.set Dhall.sourceName dhallFilePath
+  fmap fixGPDConstraints $ dhallToCabal settings content
 
 
 writeDerivedCabalFile :: Verbosity -> FilePath
@@ -89,4 +91,75 @@ writeDerivedCabalFile verbosity dir genPkg = do
   info verbosity $ "Writing derived cabal file from dhall file: " ++ path
   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))
+condLibrary' f s = fmap (\x -> s { condLibrary = x }) (f (condLibrary s))
+
+condSubLibraries' :: Lens' GenericPackageDescription [(UnqualComponentName,(CondTree ConfVar [Dependency] Library))]
+condSubLibraries' f s = fmap (\x -> s { condSubLibraries = x }) (f (condSubLibraries s))
+
+condForeignLibs' :: Lens' GenericPackageDescription [(UnqualComponentName,(CondTree ConfVar [Dependency] ForeignLib))]
+condForeignLibs' f s = fmap (\x -> s { condForeignLibs = x }) (f (condForeignLibs s))
+
+condExecutables' :: Lens' GenericPackageDescription [(UnqualComponentName,(CondTree ConfVar [Dependency] Executable))]
+condExecutables' f s = fmap (\x -> s { condExecutables = x }) (f (condExecutables s))
+
+condTestSuites' :: Lens' GenericPackageDescription [(UnqualComponentName,(CondTree ConfVar [Dependency] TestSuite))]
+condTestSuites' f s = fmap (\x -> s { condTestSuites = x }) (f (condTestSuites s))
+
+condBenchmarks' :: Lens' GenericPackageDescription [(UnqualComponentName,(CondTree ConfVar [Dependency] Benchmark))]
+condBenchmarks' f s = fmap (\x -> s { condBenchmarks = x }) (f (condBenchmarks s))
+
+fixGPDConstraints
+  :: GenericPackageDescription
+  -> GenericPackageDescription
+fixGPDConstraints
+  = Lens.over ( condBenchmarks' . traverse . Lens._2 ) fixCondTreeConstraints
+  . Lens.over ( condExecutables' . traverse . Lens._2 ) fixCondTreeConstraints
+  . Lens.over ( condForeignLibs' . traverse . Lens._2 ) fixCondTreeConstraints
+  . Lens.over ( condLibrary' . traverse ) fixCondTreeConstraints
+  . Lens.over ( condSubLibraries' . traverse . Lens._2 ) fixCondTreeConstraints
+  . Lens.over ( condTestSuites' . traverse . Lens._2 ) fixCondTreeConstraints
+
+class HasBuildInfo a where
+   buildInfo' :: Lens' a BuildInfo
+   targetBuildDepends' :: Lens' a [Dependency]
+   targetBuildDepends' = buildInfo' . targetBuildDepends'
+
+instance HasBuildInfo BuildInfo where
+   buildInfo' = id
+   targetBuildDepends' f s = fmap (\x -> s { targetBuildDepends = x }) (f (targetBuildDepends s))
+
+instance HasBuildInfo Benchmark where
+    buildInfo' f (Benchmark x1 x2 x3) = fmap (\y1 -> Benchmark x1 x2 y1) (f x3)
+
+instance HasBuildInfo Executable where
+    buildInfo' f l = (\x -> l { buildInfo = x }) <$> f (buildInfo l)
+
+instance HasBuildInfo ForeignLib where
+    buildInfo' f l = (\x -> l { foreignLibBuildInfo = x }) <$> f (foreignLibBuildInfo l)
+
+instance HasBuildInfo Library where
+    buildInfo' f l = (\x -> l { libBuildInfo = x }) <$> f (libBuildInfo l)
+
+instance HasBuildInfo TestSuite where
+    buildInfo' f l = (\x -> l { testBuildInfo = x }) <$> f (testBuildInfo l)
+
+fixCondTreeConstraints
+  :: ( HasBuildInfo a )
+  => CondTree v cs a
+  -> CondTree v [Dependency] a
+fixCondTreeConstraints ( CondNode a _ branches ) =
+  CondNode a deps ( fixCondBranchConstraints <$> branches )
+  where
+  deps = Lens.view ( buildInfo' . targetBuildDepends' ) a
+
+fixCondBranchConstraints
+  :: ( HasBuildInfo a )
+  => CondBranch v cs a
+  -> CondBranch v [Dependency] a
+fixCondBranchConstraints ( CondBranch cond true falseMay ) =
+  CondBranch cond
+    ( fixCondTreeConstraints true )
+    ( fixCondTreeConstraints <$> falseMay )

etlas/Distribution/Client/SetupWrapper.hs

@@ -84,18 +84,18 @@ import qualified System.Process as Process
 import Distribution.Client.Compat.ExecutablePath  ( getExecutablePath )
 import System.IO
 import Distribution.Simple.PackageIndex
+
 #ifdef mingw32_HOST_OS
 import Distribution.Simple.Utils
          ( withTempDirectory )
-
 import Control.Exception   ( bracket )
-import System.FilePath     ( takeDirectory, (</>), (<.>) )
-import System.Directory    ( doesDirectoryExist, doesFileExist )
 import qualified System.Win32 as Win32
-#else
+import System.FilePath     ( takeDirectory, (<.>) )
+import System.Directory    ( doesDirectoryExist )
+#endif
+
 import System.FilePath     ( (</>) )
 import System.Directory    ( doesFileExist )
-#endif
 
 -- | @Setup@ encapsulates the outcome of configuring a setup method to build a
 -- particular package.

etlas/etlas.cabal

@@ -201,7 +201,7 @@ library
         binary     >= 0.5      && < 0.9,
         bytestring >= 0.9      && < 1,
         etlas-cabal >= 1.0,
-        dhall      >= 1.17.0   && < 1.18,         
+        dhall      >= 1.18.0   && < 1.19,         
         dhall-to-etlas >= 1.3,
         containers >= 0.4      && < 0.6,
         cryptohash-sha256 >= 0.11 && < 0.12,

stack.yaml

@@ -4,13 +4,13 @@ extra-deps:
 - ed25519-0.0.5.0
 - mintty-0.1.1
 - parsec-3.1.13.0
-- dhall-1.17.0
+- dhall-1.18.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
+- megaparsec-7.0.1
+- parser-combinators-1.0.0
 - optparse-generic-1.3.0
 - optparse-applicative-0.14.0.0
 - Only-0.1
@@ -21,9 +21,8 @@ extra-deps:
 - directory-1.2.7.1
 - foundation-0.0.19
 - process-1.2.3.0
-- repline-0.1.7.0
+- repline-0.2.0.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