Upload as a Hackage distribution

Stackage/BuildPlan.hs

@@ -4,6 +4,7 @@
 module Stackage.BuildPlan
     ( readBuildPlan
     , writeBuildPlan
+    , writeBuildPlanCsv
     ) where
 
 import qualified Data.Map          as Map
@@ -155,3 +156,26 @@ getSection title orig =
         if null z
             then return y
             else Left $ "Unconsumed input on line: " ++ x
+
+-- | Used for Hackage distribution purposes.
+writeBuildPlanCsv :: FilePath -> BuildPlan -> IO ()
+writeBuildPlanCsv fp bp =
+    -- Obviously a proper CSV library should be used... but we're minimizing
+    -- deps
+    System.IO.UTF8.writeFile fp $ unlines $ map toRow $ Map.toList fullMap
+  where
+    fullMap = Map.unions
+        [ fmap spiVersion $ bpPackages bp
+        , Map.mapMaybe id $ bpCore bp
+        , bpOptionalCore bp
+        ]
+
+    toRow (PackageName name, version) = concat
+        [ "\""
+        , name
+        , "\",\""
+        , display version
+        , "\",\"http://www.stackage.org/package/"
+        , name
+        , "\""
+        ]

app/stackage.hs

@@ -1,7 +1,7 @@
 {-# LANGUAGE RecordWildCards #-}
 import           Data.Set           (fromList)
 import           Stackage.Build     (build, defaultBuildSettings)
-import           Stackage.BuildPlan (readBuildPlan, writeBuildPlan)
+import           Stackage.BuildPlan (readBuildPlan, writeBuildPlan, writeBuildPlanCsv)
 import           Stackage.CheckPlan (checkPlan)
 import           Stackage.GhcPkg (getGhcVersion)
 import           Stackage.Init      (stackageInit)
@@ -20,6 +20,7 @@ data SelectArgs = SelectArgs
     , onlyPermissive :: Bool
     , allowed        :: [String]
     , buildPlanDest  :: FilePath
+    , buildPlanCsvDest  :: FilePath
     , globalDB       :: Bool
     }
 
@@ -32,6 +33,7 @@ parseSelectArgs =
         , onlyPermissive = False
         , allowed = []
         , buildPlanDest = defaultBuildPlan
+        , buildPlanCsvDest = defaultBuildPlanCsv
         , globalDB = False
         }
   where
@@ -43,6 +45,7 @@ parseSelectArgs =
     loop x ("--only-permissive":rest) = loop x { onlyPermissive = True } rest
     loop x ("--allow":y:rest) = loop x { allowed = y : allowed x } rest
     loop x ("--build-plan":y:rest) = loop x { buildPlanDest = y } rest
+    loop x ("--build-plan-csv":y:rest) = loop x { buildPlanCsvDest = y } rest
     loop x ("--use-global-db":rest) = loop x { globalDB = True } rest
     loop _ (y:_) = error $ "Did not understand argument: " ++ y
 
@@ -78,6 +81,9 @@ parseBuildArgs version =
 defaultBuildPlan :: FilePath
 defaultBuildPlan = "build-plan.txt"
 
+defaultBuildPlanCsv :: FilePath
+defaultBuildPlanCsv = "build-plan.csv"
+
 withBuildSettings :: [String] -> (BuildSettings -> BuildPlan -> IO a) -> IO a
 withBuildSettings args f = do
     version <- getGhcVersion
@@ -114,6 +120,7 @@ main = do
                     , useGlobalDatabase = globalDB
                     }
             writeBuildPlan buildPlanDest bp
+            writeBuildPlanCsv buildPlanCsvDest bp
         ("check":rest) -> withBuildSettings rest checkPlan
         ("build":rest) -> withBuildSettings rest build
         ("test":rest) -> withBuildSettings rest runTestSuites

stackage-upload.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 import           Control.Monad                         (filterM, when)
 import qualified Data.ByteString.Char8                 as S8
+import qualified Data.ByteString.Lazy                  as L
 import           Data.List                             (isInfixOf, isPrefixOf,
                                                         sort)
 import           Network.HTTP.Client
@@ -32,6 +33,7 @@ main = withManager defaultManagerSettings $ \m -> do
                 exitFailure
 
     let uploadDocs = "exclusive" `isInfixOf` alias
+        uploadHackageDistro = alias == "unstable-ghc78-exclusive"
 
     putStrLn $ concat
         [ "Uploading "
@@ -103,6 +105,15 @@ main = withManager defaultManagerSettings $ \m -> do
                 }
         httpLbs req3 m >>= print
 
+    when uploadHackageDistro $ do
+        lbs <- L.readFile $ takeDirectory filepath </> "build-plan.csv"
+        let req = "http://hackage.haskell.org/distro/Stackage/packages.csv"
+                { requestHeaders = [("Content-Type", "text/csv")]
+                , requestBody = RequestBodyLBS lbs
+                , checkStatus = \_ _ _ -> Nothing
+                }
+        httpLbs req m >>= print
+
 mkIndex :: String -> [String] -> String
 mkIndex snapid dirs = concat
     [ "<!DOCTYPE html>\n<html lang='en'><head><title>Haddocks index</title>"