{-# LANGUAGE NoImplicitPrelude, OverloadedStrings, FlexibleContexts #-}

module IHaskell.BrokenPackages (getBrokenPackages) where

import           IHaskellPrelude
import qualified Data.Text as T

import           Text.Parsec
import           Text.Parsec.String

import           Shelly

data BrokenPackage = BrokenPackage String [String]

instance Show BrokenPackage where
  show :: BrokenPackage -> String
show (BrokenPackage String
packageID [String]
_) = String
packageID

-- | Get a list of broken packages. This function internally shells out to `ghc-pkg`, and parses the
-- output in order to determine what packages are broken.
getBrokenPackages :: IO [String]
getBrokenPackages :: IO [String]
getBrokenPackages = forall (m :: * -> *) a. MonadIO m => Sh a -> m a
shelly forall a b. (a -> b) -> a -> b
$ do
  Text
_ <- forall a. Sh a -> Sh a
silently forall a b. (a -> b) -> a -> b
$ forall a. Bool -> Sh a -> Sh a
errExit Bool
False forall a b. (a -> b) -> a -> b
$ String -> [Text] -> Sh Text
run String
"ghc-pkg" [Text
"check"]
  Text
checkOut <- Sh Text
lastStderr

  -- Get rid of extraneous things
  let rightStart :: String -> Bool
rightStart String
str = String
"There are problems" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
str Bool -> Bool -> Bool
||
                       String
"  dependency" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
str
      ghcPkgOutput :: String
ghcPkgOutput = [String] -> String
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
rightStart forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
checkOut

  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
    case forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many Parser BrokenPackage
check) String
"ghc-pkg output" String
ghcPkgOutput of
      Left ParseError
_     -> []
      Right [BrokenPackage]
pkgs -> forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [BrokenPackage]
pkgs

check :: Parser BrokenPackage
check :: Parser BrokenPackage
check = forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"There are problems in package "
        forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> [String] -> BrokenPackage
BrokenPackage forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String
ident forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
":\n" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 Parser String
dependency

ident :: Parser String
ident :: Parser String
ident = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"-.")

dependency :: Parser String
dependency :: Parser String
dependency = forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"  dependency \"" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser String
ident forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\" doesn't exist\n"