git.iko.soy/stackage
on master help sign in
Start of Stackage2: CorePackages
97949ebMichael Snoyman
Stackage2/CorePackages.hsnew file+32
compare with master
unifiedsplit
@@ -0,0 +1,32 @@
1+{-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-}
2+module Stackage2.CorePackages
3+ ( getCorePackages
4+ ) where
5+
6+import Stackage2.Prelude
7+import qualified Data.Text as T
8+
9+-- | Get a @Map@ of all of the core packages. Core packages are defined as
10+-- packages which ship with GHC itself.
11+--
12+-- Precondition: GHC global package database has only core packages, and GHC
13+-- ships with just a single version of each packages.
14+getCorePackages :: IO (Map PackageName Version)
15+getCorePackages =
16+ withCheckedProcess cp $ \ClosedStream src Inherited ->
17+ src $$ decodeUtf8C =$ linesUnboundedC =$ foldMapMC parsePackage
18+ where
19+ cp = proc "ghc-pkg" ["--no-user-package-conf", "list"]
20+ parsePackage t
21+ | ":" `isInfixOf` t = return mempty
22+ | Just p <- stripSuffix "-" p' = singletonMap
23+ <$> simpleParse p
24+ <*> simpleParse v
25+ | otherwise = return mempty
26+ where
27+ (p', v) = T.breakOnEnd "-" $ dropParens $ T.strip t
28+
29+ dropParens s
30+ | length s > 2 && headEx s == '(' && lastEx s == ')' =
31+ initEx $ tailEx s
32+ | otherwise = s
Stackage2/Prelude.hsnew file+73
@@ -0,0 +1,73 @@
1+{-# LANGUAGE DeriveDataTypeable #-}
2+{-# LANGUAGE NoImplicitPrelude #-}
3+{-# LANGUAGE OverloadedStrings #-}
4+{-# LANGUAGE TypeFamilies #-}
5+module Stackage2.Prelude
6+ ( module X
7+ , module Stackage2.Prelude
8+ ) where
9+
10+import ClassyPrelude.Conduit as X
11+import Data.Conduit.Process as X
12+import Data.Typeable (TypeRep, typeOf)
13+import Distribution.Package as X (PackageName (PackageName))
14+import qualified Distribution.Text as DT
15+import Distribution.Version as X (Version (..))
16+import System.Exit (ExitCode (ExitSuccess))
17+
18+unPackageName :: PackageName -> Text
19+unPackageName (PackageName str) = pack str
20+
21+mkPackageName :: Text -> PackageName
22+mkPackageName = PackageName . unpack
23+
24+display :: (IsString text, Element text ~ Char, DT.Text a) => a -> text
25+display = fromString . DT.display
26+
27+simpleParse :: (MonadThrow m, DT.Text a, Typeable a, MonoFoldable text, Element text ~ Char)
28+ => text -> m a
29+simpleParse orig = withTypeRep $ \rep ->
30+ case DT.simpleParse str of
31+ Nothing -> throwM (ParseFailed rep (pack str))
32+ Just v -> return v
33+ where
34+ str = unpack orig
35+
36+ withTypeRep :: Typeable a => (TypeRep -> m a) -> m a
37+ withTypeRep f =
38+ res
39+ where
40+ res = f (typeOf (unwrap res))
41+
42+ unwrap :: m a -> a
43+ unwrap _ = error "unwrap"
44+
45+data ParseFailed = ParseFailed TypeRep Text
46+ deriving (Show, Typeable)
47+instance Exception ParseFailed
48+
49+data ProcessExitedUnsuccessfully = ProcessExitedUnsuccessfully CreateProcess ExitCode
50+ deriving Typeable
51+instance Show ProcessExitedUnsuccessfully where
52+ show (ProcessExitedUnsuccessfully cp ec) = concat
53+ [ "Process exited with "
54+ , show ec
55+ , ": "
56+ , showCmdSpec (cmdspec cp)
57+ ]
58+ where
59+ showCmdSpec (ShellCommand str) = str
60+ showCmdSpec (RawCommand x xs) = unwords (x:xs)
61+instance Exception ProcessExitedUnsuccessfully
62+
63+checkExitCode :: MonadThrow m => CreateProcess -> ExitCode -> m ()
64+checkExitCode _ ExitSuccess = return ()
65+checkExitCode cp ec = throwM $ ProcessExitedUnsuccessfully cp ec
66+
67+-- FIXME move into streaming-commons?
68+withCheckedProcess cp f = do
69+ (x, y, z, sph) <- streamingProcess cp
70+ res <- f x y z
71+ ec <- waitForStreamingProcess sph
72+ checkExitCode cp ec
73+ return res
stackage.cabal+20
@@ -29,6 +29,9 @@ library
29 Stackage.Select
29 Stackage.Select
30 Stackage.GhcPkg
30 Stackage.GhcPkg
31 Stackage.ServerFiles
31 Stackage.ServerFiles
32+
33+ Stackage2.Prelude
34+ Stackage2.CorePackages
32 build-depends: base >= 4 && < 5
35 build-depends: base >= 4 && < 5
33 , containers
36 , containers
34 , Cabal >= 1.14
37 , Cabal >= 1.14
@@ -43,6 +46,10 @@ library
43 , time
46 , time
44 , utf8-string
47 , utf8-string
45
48
49+ , conduit-extra
50+ , classy-prelude-conduit
51+ , text
52+
46executable stackage
53executable stackage
47 hs-source-dirs: app
54 hs-source-dirs: app
48 main-is: stackage.hs
55 main-is: stackage.hs
@@ -50,6 +57,19 @@ executable stackage
50 , stackage
57 , stackage
51 , containers
58 , containers
52
59
60+test-suite spec
61+ type: exitcode-stdio-1.0
62+ default-language: Haskell2010
63+ hs-source-dirs: test
64+ main-is: Spec.hs
65+ other-modules: Stackage2.CorePackagesSpec
66+ build-depends: base
67+ , stackage
68+ , hspec
69+ , QuickCheck
70+ , text
71+ , classy-prelude-conduit
72+
53source-repository head
73source-repository head
54 type: git
74 type: git
55 location: https://github.com/fpco/stackage
75 location: https://github.com/fpco/stackage
test/Spec.hsnew file+1
@@ -0,0 +1 @@
1+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
test/Stackage2/CorePackagesSpec.hsnew file+14
@@ -0,0 +1,14 @@
1+{-# LANGUAGE OverloadedStrings, NoImplicitPrelude #-}
2+module Stackage2.CorePackagesSpec (spec) where
3+
4+import Stackage2.CorePackages
5+import Stackage2.Prelude
6+import Test.Hspec
7+
8+spec :: Spec
9+spec = do
10+ it "works" $ void getCorePackages
11+ it "contains known core packages" $ do
12+ m <- getCorePackages
13+ forM_ (words "ghc containers base") $ \p ->
14+ m `shouldSatisfy` (member (PackageName p))