module Stackage.CorePackages
( getCorePackages
, getCoreExecutables
, getGhcVersion
) where
import Control.Monad.State.Strict (StateT, execStateT, get, modify,
put)
import qualified Data.Map.Lazy as Map
import Filesystem (listDirectory)
import qualified Filesystem.Path.CurrentOS as F
import Stackage.Prelude
import System.Directory (findExecutable)
import System.FilePath (takeDirectory, takeFileName)
addDeepDepends :: PackageName -> StateT (Map PackageName Version) IO ()
addDeepDepends name@(PackageName name') = do
m <- get
case lookup name m of
Just _ -> return ()
Nothing -> do
put $ Map.insert name (error "Version prematurely forced") m
let cp = proc "ghc-pkg" ["--no-user-package-conf", "describe", name']
version <- withCheckedProcess cp $ \ClosedStream src Inherited ->
src $$ decodeUtf8C =$ linesUnboundedC =$ getZipSink (
ZipSink (dependsConduit =$ dependsSink)
*> ZipSink versionSink)
modify $ insertMap name version
where
versionSink =
loop
where
loop = await >>= maybe (error "version: not found") go
go t =
case stripPrefix "version: " t of
Nothing -> loop
Just x -> simpleParse x
dependsConduit = do
dropWhileC $ not . ("depends:" `isPrefixOf`)
takeWhileC isGood =$= concatMapC sanitize
where
isGood t = "depends:" `isPrefixOf` t || " " `isPrefixOf` t
sanitize t1
| null t2 = Nothing
| t2 == "builtin_rts" = Nothing
| otherwise = Just t2
where
t2 = dropPrefixMaybe "builtin_rts " $ dropPrefixMaybe "depends:" t1
dropPrefixMaybe x y' =
fromMaybe y $ stripPrefix x y
where
y = dropWhile (== ' ') y'
dependsSink = mapM_C $ \t -> do
pn <- simpleParse $ getPackageName t
addDeepDepends pn
getPackageName =
reverse . dropSeg . dropSeg . reverse . dropWhile (== ' ')
where
dropSeg = drop 1 . dropWhile (/= '-')
getCorePackages :: IO (Map PackageName Version)
getCorePackages = flip execStateT mempty $ mapM_ (addDeepDepends . PackageName)
[ "ghc"
]
getCoreExecutables :: IO (Set ExeName)
getCoreExecutables = do
mfp <- findExecutable "ghc"
dir <-
case mfp of
Nothing -> error "No ghc executable found on PATH"
Just fp -> return $ takeDirectory fp
(setFromList . map (ExeName . pack . takeFileName . F.encodeString)) <$> listDirectory (fromString dir)
getGhcVersion :: IO Version
getGhcVersion = do
withCheckedProcess (proc "ghc" ["--numeric-version"]) $
\ClosedStream src Inherited ->
(src $$ decodeUtf8C =$ foldC) >>= simpleParse