git.iko.soy/stackage
on d51181a help sign in
stackage/Stackage/ServerFiles.hs
101 lines 3.3 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 Control.Monad (unless)
14import Distribution.Text (display)
15import System.Directory (doesFileExist)
16import System.FilePath ((</>), (<.>))
17import System.IO (Handle, hPutStrLn, hPutStr)
19createHackageFile :: Bool -- ^ inclusive?
20 -> InstallInfo
21 -> String -- ^ GHC version
22 -> String -- ^ date
23 -> Handle -- ^ hackage
24 -> Handle -- ^ tarballs
25 -> IO ()
26createHackageFile isInc ii ghcVer date hackageH tarballH = do
27 let stackageFP = concat
28 [ "../ghc-"
29 , ghcVer
30 , "-"
31 , date
32 , if isInc then "-inclusive" else "-exclusive"
33 , ".stackage"
34 ]
35 hPutStr tarballH $ concat
36 [ "#!/bin/bash -ex\n\ntar czfv "
37 , stackageFP
38 , " hackage desc"
39 ]
40 indextargz <- getTarballName
41 indexLBS <- L.readFile indextargz
42 loop $ Tar.read indexLBS
43 hPutStrLn tarballH ""
44 hPutStrLn tarballH $ concat
45 [ "runghc ../stackage-upload.hs "
46 , stackageFP
47 , " unstable-ghc"
48 , filter (/= '.') ghcVer
49 , if isInc then "-inclusive" else "-exclusive"
50 ]
52 unless isInc $ do
53 -- Add in some OS-specific package/version combos to work with
54 -- non-Linux systems.
55 hPutStrLn hackageH "hfsevents-0.1.5"
56 hPutStrLn hackageH "Win32-notify-0.3"
57 where
58 selected = Map.fromList . map toStrs . Map.toList $
59 fmap spiVersion (iiPackages ii)
60 `Map.union` iiOptionalCore ii
61 `Map.union` Map.mapMaybe id (iiCore ii)
63 toStrs (PackageName name, version) = (name, display version)
65 loop Tar.Done = return ()
66 loop (Tar.Fail e) = throwIO e
67 loop (Tar.Next e es) = go e >> loop es
69 go e =
70 case parsePair $ Tar.entryPath e of
71 Nothing -> return ()
72 Just (name, version) ->
73 case Map.lookup name selected of
74 Just version'
75 | version == version' -> emit True name version
76 | otherwise -> return ()
77 Nothing
78 | isInc -> emit False name version
79 | otherwise -> return ()
81 emit usePatch name version = do
82 exists <- if usePatch then doesFileExist tarball else return False
83 if exists
84 then hPutStr tarballH $ ' ' : ".." </> tarball
85 else hPutStrLn hackageH base
86 where
87 base = concat [name, "-", version]
88 tarball = "patching" </> "tarballs" </> base <.> "tar" <.> "gz"
90parsePair :: String -> Maybe (String, String)
91parsePair s =
92 case splitOn '/' s of
93 [name, version, cabal] | name ++ ".cabal" == cabal -> Just (name, version)
94 _ -> Nothing
96splitOn :: Eq a => a -> [a] -> [[a]]
97splitOn _ [] = []
98splitOn c x =
99 y : splitOn c z
100 where
101 (y, z) = second (drop 1) $ break (== c) x