git.iko.soy/stackage
on f90bccf help sign in
stackage/Stackage/HaskellPlatform.hs
69 lines 2.4 kB history raw
1module Stackage.HaskellPlatform
2 ( loadHaskellPlatform
3 ) where
5import Control.Monad (guard)
6import Data.Char (isSpace)
7import Data.List (foldl', isInfixOf, isPrefixOf, stripPrefix)
8import Data.Maybe (mapMaybe)
9import Data.Monoid (Monoid (..))
10import Data.Set (singleton)
11import Distribution.Text (simpleParse)
12import Stackage.Types
13import System.Directory (doesFileExist)
14import System.FilePath ((</>))
16loadHaskellPlatform :: SelectSettings -> IO (Maybe HaskellPlatform)
17loadHaskellPlatform ss = do
18 e <- doesFileExist fp
19 if e
20 then fmap (Just . parseHP) $ readFile fp
21 else return Nothing
22 where
23 GhcMajorVersion x y = selectGhcVersion ss
25 fp = haskellPlatformDir ss </> (concat
26 [ "haskell-platform-"
27 , show x
28 , "."
29 , show y
30 , ".cabal"
31 ])
33data HPLine = HPLPackage PackageIdentifier
34 | HPLBeginCore
35 | HPLEndCore
36 | HPLBeginPlatform
37 | HPLEndPlatform
38 deriving Show
40toHPLine :: String -> Maybe HPLine
41toHPLine s
42 | "begin core packages" `isInfixOf` s = Just HPLBeginCore
43 | "end core packages" `isInfixOf` s = Just HPLEndCore
44 | "begin platform packages" `isInfixOf` s = Just HPLBeginPlatform
45 | "end platform packages" `isInfixOf` s = Just HPLEndPlatform
46 | otherwise = do
47 let s1 = dropWhile isSpace s
48 guard $ not $ "--" `isPrefixOf` s1
49 guard $ not $ null s1
50 guard $ "==" `isInfixOf` s1
51 let (package', s2) = break (== '=') s1
52 package = takeWhile (not . isSpace) package'
53 s3 <- stripPrefix "==" s2
54 version <- simpleParse $ takeWhile (/= ',') s3
55 Just $ HPLPackage $ PackageIdentifier (PackageName package) version
57parseHP :: String -> HaskellPlatform
58parseHP =
59 snd . foldl' addLine (notInBlock, mempty) . mapMaybe toHPLine . lines
60 where
61 notInBlock _ = mempty
62 inCore x = HaskellPlatform (singleton x) mempty
63 inPlatform x = HaskellPlatform mempty (singleton x)
65 addLine (fromPackage, hp) (HPLPackage vp) = (fromPackage, fromPackage vp `mappend` hp)
66 addLine (_, hp) HPLBeginCore = (inCore, hp)
67 addLine (_, hp) HPLEndCore = (notInBlock, hp)
68 addLine (_, hp) HPLBeginPlatform = (inPlatform, hp)
69 addLine (_, hp) HPLEndPlatform = (notInBlock, hp)