module Main where
import qualified Flatpak
import qualified Generate
import qualified Package
import qualified Retrieve
import qualified Cabal.Plan as Plan
import qualified Crypto.Hash.SHA256 as SHA256
import qualified System.Path.Directory as PathDir
import qualified System.Path as Path
import qualified System.Directory as Dir
import System.Path ((</>))
import qualified Option
import qualified Options.Applicative as OP
import qualified Shell.Utility.ParseArgument as ParseArg
import qualified Shell.Utility.Verbosity as Verbosity
import qualified Shell.Utility.Log as Log
import Control.Monad (when)
import Control.Applicative ((<$>))
import Control.Arrow ((&&&))
import qualified Data.Aeson as Json
import qualified Data.Yaml as Yaml
import qualified Data.ByteString.Lazy.Char8 as BL
import qualified Data.ByteString.Char8 as B
import qualified Data.Text as Text
import qualified Data.Char as Char
import qualified Data.Traversable as Trav
import qualified Data.Graph as Graph
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.List.HT as ListHT
import Data.Tuple.HT (snd3)
import Data.Map (Map)
import Data.Set (Set)
import Text.Printf (printf)
topSort :: Ord a => Map a (Set a) -> [a]
topSort m =
reverse $
(\(graph, lookupVertex, _) ->
map (snd3 . lookupVertex) $ Graph.topSort graph) $
Graph.graphFromEdges $ Map.elems $
Map.mapWithKey (\k v -> ((), k, Set.toList v)) m
isYamlFileName :: Path.File absRel -> Bool
isYamlFileName path =
case map Char.toLower $ Path.takeExtension path of
".yaml" -> True
".yml" -> True
_ -> False
findCabalDir :: IO Path.AbsDir
findCabalDir = do
xdgDir <- Dir.getXdgDirectory Dir.XdgCache "cabal"
xdgExists <- Dir.doesDirectoryExist xdgDir
if xdgExists
then return $ Path.absDir xdgDir
else do
appDir <- PathDir.getAppUserDataDirectory "cabal"
appExists <- PathDir.doesDirectoryExist appDir
if appExists
then return appDir
else
fail $
"Cabal cache directory not found under one these directories: "
++
printf "%s, %s" xdgDir (Path.toString appDir)
{- |
Cabal operates on units.
A package can have multiple units,
for example a library unit and multiple executable units.
Each of those units can have its own set of library and executable dependencies.
However, when downloading packages in Flatpak
we don't differentiate between the units
and treat all units belonging to the same package as one.
The below heuristic
merges all units belonging to the same package into one package
and topologically sorts the packages.
This heuristic can be completely skipped when using the --cabal-install option,
because in this mode all we need to do is to download all necessary packages
in any order and cabal will determine the correct order of the units by itself.
The heuristic goes as follows:
1. Build a map between the unit IDs and the package ID that contains it
2. Get the dependency graph using the cabal-plan API
3. Group all units belonging to the same package
and merge their dependencies to obtain package dependencies
4. Topologically sort the packages
5. Take one representative unit for each package
and use them in the flatpak.json generation process.
This is safe to do as long as the rest of the generator
uses information that is common to all units in the same package.
Those are: uPId, uSha256, uCabalSha256 and uType.
In certain situations
this heuristic can still fail to produce a buildable sequence.
For example, we can have two packages as such:
Pkg1@(lib1, exe1) and Pkg2@(lib2)
where the unit lib2 depends on lib1 and exe1 depends on lib2.
Unit-wise, it is possible to sequence the builds of the units
that avoids cyclical dependencies.
But package-wise, it is not possible.
In such cases and in general
it is better to enable the --cabal-install option which avoids this problem.
It is also not possible to use the qualified name of the component
for the 'configure' stage
and build a package in multiple parts in multiple Flatpak modules.
This is because the Plan.uComps is not precise enough,
as the documentation states that in certain situations
that field may contain more than one value.
In that case it is impossible to determine the precise component name.
-}
getSortedUnits :: Plan.PlanJson -> [Plan.Unit]
getSortedUnits plan =
let
allUnits = Plan.pjUnits plan
-- Build a mapping from unit ID to package ID
unitIdToPkgId unitId = Plan.uPId $ allUnits Map.! unitId
-- Here we take one representative unit for a given package.
pkgIdToUnit = Map.fromList $ map (Plan.uPId &&& id) $ Map.elems allUnits
in filter ((Plan.UnitTypeBuiltin /=) . Plan.uType) $
map (pkgIdToUnit Map.!) $ topSort $
-- Merge unit groups into packages, merging their dependencies.
Map.mapKeysWith Set.union unitIdToPkgId $
Map.map (Set.map unitIdToPkgId) $ Plan.planJsonIdGraph plan
main :: IO ()
main = do
opt <- OP.execParser Option.info
dir <-
maybe (fmap Path.toAbsRel PathDir.getCurrentDirectory) return $
Option.projectDir opt
plan <-
Plan.findAndDecodePlanJson $
Plan.ProjectRelativeToDir $ Path.toString dir
projectJson <-
if isYamlFileName $ Option.input opt
then Yaml.decodeFileThrow (Path.toString $ Option.input opt)
else
either fail return =<<
(Json.eitherDecodeFileStrict' $ Path.toString $ Option.input opt)
{-
Only cabal >= 2.4.1.0 provides the SHA 256 hashes.
see: https://hackage.haskell.org/package/cabal-plan-0.5.0.0/docs/Cabal-Plan.html#v:uCabalSha256
-}
let minVersion = Plan.Ver [2,4,1,0]
curVersion = Plan.pjCabalVersion plan
when (curVersion < minVersion) $ Log.warn Verbosity.normal $
printf
("plan.json is from Cabal-%s, " ++
"but only version %s and higher provide SHA256 hashes for Cabal files.\n")
(Retrieve.formatVersion curVersion)
(Retrieve.formatVersion minVersion)
let matchExe name comp =
case comp of Plan.CompNameExe nameExe -> name == nameExe; _ -> False
let matchExeUnit name unit =
any (matchExe name) $ Map.keys $ Plan.uComps unit
let mainExe = Text.pack $ Flatpak.command $ Flatpak.base projectJson
let mainPackage = Flatpak.mainPackage projectJson
mainUnit <-
case filter (matchExeUnit mainExe) $ Map.elems $ Plan.pjUnits plan of
[x] -> return x
[] -> fail "main package not found in build plan"
_ -> fail "main package found multiple times in build plan"
let units = getSortedUnits plan
archs <-
case Option.archs opt of
[] ->
let archStr = Text.unpack $ Plan.pjArch plan
in maybe
(fail $ printf "unsupported architecture: %s" archStr)
(return . (:[])) $
ParseArg.enumMaybe Retrieve.archGHC archStr
archs -> return archs
archHashes <- do
let compiler = Plan.pjCompilerId plan
sha256Map <- Retrieve.ghcHashes compiler
either fail return $
Trav.forM archs $ \arch -> do
sha256 <- Retrieve.ghcHash sha256Map compiler arch
return (arch, sha256)
cabalDir <- findCabalDir
let hackageDir =
cabalDir </> Path.dir "packages" </> Path.dir "hackage.haskell.org"
let mainVersion = case mainUnit of
Plan.Unit{Plan.uPId = Plan.PkgId _pkg ver} ->
Retrieve.formatVersion ver
(revisions, mainCabalHash) <- do
tar <- Package.readTar $ hackageDir </> Path.file "01-index.tar.gz"
either fail return $
Package.scanIndex tar (mainPackage, mainVersion) $
Package.unitsMapFromList units
mainTarHash <-
fmap SHA256.hashlazy $ BL.readFile $ Path.toString $
hackageDir
</> Path.dir mainPackage
</> Path.dir mainVersion
</> Path.file (printf "%s-%s.tar.gz" mainPackage mainVersion)
let (revisedUnits, unrevisedUnits) =
ListHT.partitionMaybe
(\unit -> (,) unit <$> Map.lookup (Plan.uPId unit) revisions) $
map
(\unit ->
if Generate.matchName mainPackage unit
then unit{
Plan.uSha256 = Plan.sha256FromByteString mainTarHash,
Plan.uCabalSha256 = Plan.sha256FromByteString mainCabalHash
}
else unit) $
units
when (not $ null unrevisedUnits) $ fail $ unlines $
"units without a SHA256 hash for the Cabal file:" :
map (Text.unpack . Plan.dispPkgId . Plan.uPId) unrevisedUnits
(if isYamlFileName $ Option.output opt
then
B.writeFile (Path.toString $ Option.output opt) .
Flatpak.encodeYaml
else
BL.writeFile (Path.toString $ Option.output opt) .
Flatpak.encodeJson) $
if Option.cabalInstall opt
then Generate.manifestCabalInstall
plan archHashes revisedUnits projectJson
else Generate.manifest
plan archHashes revisedUnits projectJson