git.iko.soy/stackage
on 8801ebe help sign in
stackage/Stackage2/ServerBundle.hs
63 lines 2.1 kB history raw
1-- | Create a bundle to be uploaded to Stackage Server.
2{-# LANGUAGE NoImplicitPrelude #-}
3{-# LANGUAGE OverloadedStrings #-}
4{-# LANGUAGE RecordWildCards #-}
5module Stackage2.ServerBundle
6 ( serverBundle
7 , epochTime
8 , bpAllPackages
9 ) where
11import qualified Codec.Archive.Tar as Tar
12import qualified Codec.Archive.Tar.Entry as Tar
13import qualified Codec.Compression.GZip as GZip
14import qualified Data.Yaml as Y
15import Foreign.C.Types (CTime (CTime))
16import Stackage2.BuildConstraints
17import Stackage2.BuildPlan
18import Stackage2.Prelude
19import qualified System.PosixCompat.Time as PC
21-- | Get current time
22epochTime :: IO Tar.EpochTime
23epochTime = (\(CTime t) -> t) <$> PC.epochTime
25-- | All package/versions in a build plan, including core packages.
26--
27-- Note that this may include packages not available on Hackage.
28bpAllPackages :: BuildPlan -> Map PackageName Version
29bpAllPackages BuildPlan {..} =
30 siCorePackages bpSystemInfo ++ map ppVersion bpPackages
32serverBundle :: Tar.EpochTime
33 -> Text -- ^ title
34 -> Text -- ^ slug
35 -> BuildPlan
36 -> LByteString
37serverBundle time title slug bp@BuildPlan {..} = GZip.compress $ Tar.write
38 [ fe "build-plan.yaml" (fromStrict $ Y.encode bp)
39 , fe "hackage" hackage
40 , fe "slug" (fromStrict $ encodeUtf8 slug)
41 , fe "desc" (fromStrict $ encodeUtf8 title)
42 ]
43 where
44 fe name contents =
45 case Tar.toTarPath False name of
46 Left s -> error s
47 Right name' -> (Tar.fileEntry name' contents)
48 { Tar.entryTime = time
49 }
50 hackage = builderToLazy $ foldMap goPair $ mapToList packageMap
52 -- need to remove some packages that don't exist on Hackage
53 packageMap = foldr deleteMap (bpAllPackages bp) $ map PackageName
54 [ "bin-package-db"
55 , "ghc"
56 , "rts"
57 ]
59 goPair (name, version) =
60 toBuilder (display name) ++
61 toBuilder (asText "-") ++
62 toBuilder (display version) ++
63 toBuilder (asText "\n")