git.iko.soy/stackage
on 045127a help sign in
stackage/Stackage/ServerFiles.hs
103 lines 3.4 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"
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 isInc then "-inclusive" else "-exclusive"
52 ]
54 unless isInc $ do
55 -- Add in some OS-specific package/version combos to work with
56 -- non-Linux systems.
57 hPutStrLn hackageH "hfsevents-0.1.5"
58 hPutStrLn hackageH "Win32-notify-0.3"
59 where
60 selected = Map.fromList . map toStrs . Map.toList $
61 fmap spiVersion (iiPackages ii)
62 `Map.union` iiOptionalCore ii
63 `Map.union` Map.mapMaybe id (iiCore ii)
65 toStrs (PackageName name, version) = (name, display version)
67 loop Tar.Done = return ()
68 loop (Tar.Fail e) = throwIO e
69 loop (Tar.Next e es) = go e >> loop es
71 go e =
72 case parsePair $ Tar.entryPath e of
73 Nothing -> return ()
74 Just (name, version) ->
75 case Map.lookup name selected of
76 Just version'
77 | version == version' -> emit True name version
78 | otherwise -> return ()
79 Nothing
80 | isInc -> emit False name version
81 | otherwise -> return ()
83 emit usePatch name version = do
84 exists <- if usePatch then doesFileExist tarball else return False
85 if exists
86 then hPutStr tarballH $ ' ' : ".." </> tarball
87 else hPutStrLn hackageH base
88 where
89 base = concat [name, "-", version]
90 tarball = "patching" </> "tarballs" </> base <.> "tar" <.> "gz"
92parsePair :: String -> Maybe (String, String)
93parsePair s =
94 case splitOn '/' s of
95 [name, version, cabal] | name ++ ".cabal" == cabal -> Just (name, version)
96 _ -> Nothing
98splitOn :: Eq a => a -> [a] -> [[a]]
99splitOn _ [] = []
100splitOn c x =
101 y : splitOn c z
102 where
103 (y, z) = second (drop 1) $ break (== c) x