git.iko.soy/stackage
on 62064dc help sign in
stackage/Stackage/ServerFiles.hs
94 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 ]
34 hPutStr tarballH $ concat
35 [ "#!/bin/bash -ex\n\ntar czfv "
36 , stackageFP
37 , " hackage desc"
38 ]
39 indextargz <- getTarballName
40 indexLBS <- L.readFile indextargz
41 loop $ Tar.read indexLBS
42 hPutStrLn tarballH ""
43 hPutStrLn tarballH $ concat
44 [ "runghc ../stackage-upload.hs "
45 , stackageFP
46 , " unstable-ghc"
47 , filter (/= '.') ghcVer
48 , if isInc then "-inclusive" else "-exclusive"
49 ]
50 where
51 selected = Map.fromList . map toStrs . Map.toList $
52 fmap spiVersion (iiPackages ii)
53 `Map.union` iiOptionalCore ii
54 `Map.union` Map.mapMaybe id (iiCore ii)
56 toStrs (PackageName name, version) = (name, display version)
58 loop Tar.Done = return ()
59 loop (Tar.Fail e) = throwIO e
60 loop (Tar.Next e es) = go e >> loop es
62 go e =
63 case parsePair $ Tar.entryPath e of
64 Nothing -> return ()
65 Just (name, version) ->
66 case Map.lookup name selected of
67 Just version'
68 | version == version' -> emit True name version
69 | otherwise -> return ()
70 Nothing
71 | isInc -> emit False name version
72 | otherwise -> return ()
74 emit usePatch name version = do
75 exists <- if usePatch then doesFileExist tarball else return False
76 if exists
77 then hPutStr tarballH $ ' ' : ".." </> tarball
78 else hPutStrLn hackageH base
79 where
80 base = concat [name, "-", version]
81 tarball = "patching" </> "tarballs" </> base <.> "tar" <.> "gz"
83parsePair :: String -> Maybe (String, String)
84parsePair s =
85 case splitOn '/' s of
86 [name, version, cabal] | name ++ ".cabal" == cabal -> Just (name, version)
87 _ -> Nothing
89splitOn :: Eq a => a -> [a] -> [[a]]
90splitOn _ [] = []
91splitOn c x =
92 y : splitOn c z
93 where
94 (y, z) = second (drop 1) $ break (== c) x