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