module Pier.Build.Package ( getPackageSourceDir , configurePackage , parseCabalFileInDir ) where import Data.List.NonEmpty (NonEmpty(..)) import Data.Semigroup import Development.Shake import Development.Shake.FilePath import Distribution.Compiler import Distribution.Package import Distribution.PackageDescription import Distribution.PackageDescription.Parsec import Distribution.System (buildOS, buildArch) import Distribution.Text (display) import Distribution.Types.CondTree (CondBranch(..)) import Distribution.Version (withinRange) import qualified Data.HashMap.Strict as HM import Pier.Build.Stackage import Pier.Core.Artifact import Pier.Core.Download downloadCabalPackage :: PackageIdentifier -> Action Artifact downloadCabalPackage pkg = do let n = display pkg askDownload Download { downloadName = n <.> "tar.gz" , downloadUrlPrefix = "https://hackage.haskell.org/package/" ++ n } getPackageSourceDir :: PackageIdentifier -> Action Artifact getPackageSourceDir pkg = do tarball <- downloadCabalPackage pkg runCommandOutput outDir $ message ("Unpacking " ++ display pkg) <> prog "tar" ["-xzf", pathIn tarball, "-C", takeDirectory outDir] <> input tarball where outDir = "package/raw" display pkg configurePackage :: BuildPlan -> Flags -> Artifact -> Action (PackageDescription, Artifact) configurePackage plan flags packageSourceDir = do gdesc <- parseCabalFileInDir packageSourceDir let desc = flattenToDefaultFlags plan flags gdesc let name = display (packageName desc) case buildType desc of Configure -> do let configuredDir = name configuredPackage <- runCommandOutput configuredDir $ shadow packageSourceDir configuredDir <> message ("Configuring " ++ name) <> withCwd configuredDir (progTemp (configuredDir "configure") []) let buildInfoFile = configuredPackage /> (name <.> "buildinfo") buildInfoExists <- doesArtifactExist buildInfoFile desc' <- if buildInfoExists then do hookedBI <- readHookedBuildInfoA buildInfoFile return $ updatePackageDescription hookedBI desc else return desc return (desc', configuredPackage) -- Best effort: ignore custom setup scripts. _ -> return (desc, packageSourceDir) parseCabalFileInDir :: Artifact -> Action GenericPackageDescription parseCabalFileInDir dir = do cabalFile <- findCabalFile dir cabalContents <- readArtifactB cabalFile -- TODO: better error message when parse fails; and maybe warnings too? case runParseResult $ parseGenericPackageDescription cabalContents of (_, Right pkg) -> return pkg e -> error $ show e ++ "\n" ++ show cabalContents readHookedBuildInfoA :: Artifact -> Action HookedBuildInfo readHookedBuildInfoA file = do hookedBIParse <- parseHookedBuildInfo <$> readArtifactB file case runParseResult hookedBIParse of (_,Right hookedBI) -> return hookedBI e -> error $ "Error reading buildinfo " ++ show file ++ ": " ++ show e findCabalFile :: Artifact -> Action Artifact findCabalFile dir = do cabalFiles <- matchArtifactGlob dir "*.cabal" case cabalFiles of [f] -> return (dir /> f) [] -> error $ "No *.cabal files found in " ++ show dir _ -> error $ "Multiple *.cabal files found: " ++ show cabalFiles flattenToDefaultFlags :: BuildPlan -> Flags -> GenericPackageDescription -> PackageDescription flattenToDefaultFlags plan planFlags gdesc = let desc0 = packageDescription gdesc -- Bias towards plan flags (since they override the defaults) flags = planFlags `HM.union` HM.fromList [(flagName f, flagDefault f) | f <- genPackageFlags gdesc ] in desc0 -- TODO: Nothing vs Nothing? { library = resolve plan flags <$> condLibrary gdesc , executables = map (\(n, e) -> (resolve plan flags e) { exeName = n }) $ condExecutables gdesc , testSuites = map (\(n, s) -> (resolve plan flags s) { testName = n }) $ condTestSuites gdesc } resolve :: Semigroup a => BuildPlan -> HM.HashMap FlagName Bool -> CondTree ConfVar [Dependency] a -> a resolve plan flags node = sconcat $ condTreeData node :| [ resolve plan flags t | CondBranch cond ifTrue ifFalse <- condTreeComponents node , Just t <- [if isTrue plan flags cond then Just ifTrue else ifFalse]] isTrue :: BuildPlan -> HM.HashMap FlagName Bool -> Condition ConfVar -> Bool isTrue plan flags = loop where loop (Var (Flag f)) | Just x <- HM.lookup f flags = x | otherwise = error $ "Unknown flag: " ++ show f loop (Var (Impl GHC range)) = withinRange (ghcVersion plan) range loop (Var (Impl _ _)) = False loop (Var (OS os)) = os == buildOS loop (Var (Arch arch)) = arch == buildArch loop (Lit x) = x loop (CNot x) = not $ loop x loop (COr x y) = loop x || loop y loop (CAnd x y) = loop x && loop y