git.iko.soy/stackage
on 52ca2cc help sign in
stackage/Stackage/ServerFiles.hs
93 lines 3.1 kB history raw
1-- | Create the files necessary for Stackage server.
2module Stackage.ServerFiles
3 ( createHackageFile
4 ) where
6import Stackage.Util
7import Stackage.Types
8import qualified Data.Map as Map
9import Control.Exception (throwIO)
10import qualified Codec.Archive.Tar as Tar
11import qualified Data.ByteString.Lazy as L
12import Control.Arrow (second)
13import Distribution.Text (display)
14import System.Directory (doesFileExist)
15import System.FilePath ((</>), (<.>))
16import System.IO (Handle, hPutStrLn, hPutStr)
18createHackageFile :: Bool -- ^ inclusive?
19 -> InstallInfo
20 -> String -- ^ GHC version
21 -> String -- ^ date
22 -> Handle -- ^ hackage
23 -> Handle -- ^ tarballs
24 -> IO ()
25createHackageFile isInc ii ghcVer date hackageH tarballH = do
26 let stackageFP = concat
27 [ "../ghc-"
28 , ghcVer
29 , "-"
30 , date
31 , if isInc then "-inclusive" else "-exclusive"
32 , ".stackage"
33 hPutStr tarballH $ concat
34 [ "#!/bin/bash -ex\n\ntar czfv "
35 , stackageFP
36 , " hackage desc"
37 ]
38 indextargz <- getTarballName
39 indexLBS <- L.readFile indextargz
40 loop $ Tar.read indexLBS
41 hPutStrLn tarballH ""
42 hPutStrLn tarballH $ concat
43 [ "runghc ../stackage-upload.hs "
44 , stackageFP
45 , " unstable-ghc"
46 , filter (/= '.') ghcVer
47 , if isInc then "-inclusive" else "-exclusive"
48 ]
49 where
50 selected = Map.fromList . map toStrs . Map.toList $
51 fmap spiVersion (iiPackages ii)
52 `Map.union` iiOptionalCore ii
53 `Map.union` Map.mapMaybe id (iiCore ii)
55 toStrs (PackageName name, version) = (name, display version)
57 loop Tar.Done = return ()
58 loop (Tar.Fail e) = throwIO e
59 loop (Tar.Next e es) = go e >> loop es
61 go e =
62 case parsePair $ Tar.entryPath e of
63 Nothing -> return ()
64 Just (name, version) ->
65 case Map.lookup name selected of
66 Just version'
67 | version == version' -> emit True name version
68 | otherwise -> return ()
69 Nothing
70 | isInc -> emit False name version
71 | otherwise -> return ()
73 emit usePatch name version = do
74 exists <- if usePatch then doesFileExist tarball else return False
75 if exists
76 then hPutStr tarballH $ ' ' : ".." </> tarball
77 else hPutStrLn hackageH base
78 where
79 base = concat [name, "-", version]
80 tarball = "patching" </> "tarballs" </> base <.> "tar" <.> "gz"
82parsePair :: String -> Maybe (String, String)
83parsePair s =
84 case splitOn '/' s of
85 [name, version, cabal] | name ++ ".cabal" == cabal -> Just (name, version)
86 _ -> Nothing
88splitOn :: Eq a => a -> [a] -> [[a]]
89splitOn _ [] = []
90splitOn c x =
91 y : splitOn c z
92 where
93 (y, z) = second (drop 1) $ break (== c) x