{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Internal.FixWarnings
  ( fixWarning
  , fixRedundancyWarning
  , RedundancyWarn(..)
  ) where

import           Control.Applicative ((<|>))
import           Control.Monad
import           Control.Monad.IO.Class
import           Control.Monad.Trans.State
import           Data.Bifunctor (first)
import qualified Data.ByteString.Char8 as BS
import           Data.Char (isSpace)
import           Data.Maybe (isJust)
import           Data.Monoid (Alt(..))
import qualified Data.Map.Strict as M
import qualified System.Directory as Dir
import qualified Text.ParserCombinators.ReadP as P

import qualified Internal.GhcFacade as Ghc
import           Internal.Types

-- | Fixes applicable warning
fixWarning :: ModuleFile -> WarningsWithModDate -> IO WarningsWithModDate
fixWarning :: String -> WarningsWithModDate -> IO WarningsWithModDate
fixWarning String
modFile
           warns :: WarningsWithModDate
warns@MkWarningsWithModDate
             { lastUpdated :: WarningsWithModDate -> UTCTime
lastUpdated = UTCTime
modifiedAt
             , warningsMap :: WarningsWithModDate -> MonoidMap SrcSpanKey (Set Warning)
warningsMap = MonoidMap Map SrcSpanKey (Set Warning)
warnMap
             } = do

  UTCTime
lastModification <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO UTCTime
Dir.getModificationTime String
modFile

  -- Do not attempt to edit if file has been touched since last reload
  if UTCTime
lastModification forall a. Eq a => a -> a -> Bool
/= UTCTime
modifiedAt
  then do
    String -> IO ()
putStrLn
      forall a b. (a -> b) -> a -> b
$ String
"'" forall a. Semigroup a => a -> a -> a
<> String
modFile
      forall a. Semigroup a => a -> a -> a
<> String
"' has been modified since last compiled. Reload and try again."
    forall (f :: * -> *) a. Applicative f => a -> f a
pure WarningsWithModDate
warns

  else do
    [ByteString]
curSrcLines <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> [ByteString]
BS.lines forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
BS.readFile String
modFile

    -- State is used to keep the contents of the source file in memory while
    -- warnings for the file are fixed.
    ([(SrcSpanKey, Set Warning)]
pairs, [ByteString]
newFileContents) <- (forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
`runStateT` [ByteString]
curSrcLines)
             forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
M.toList Map SrcSpanKey (Set Warning)
warnMap) forall a b. (a -> b) -> a -> b
$ \case
      ((RealSrcLoc
start, RealSrcLoc
_), Set Warning
warnSet)
        | Alt (Just RedundancyWarn
reWarn) -- Take the first redundancy warning parsed
            <- forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall {k} (f :: k -> *) (a :: k). f a -> Alt f a
Alt forall b c a. (b -> c) -> (a -> b) -> a -> c
. Warning -> Maybe RedundancyWarn
parseRedundancyWarn) Set Warning
warnSet
        -> do
          [ByteString]
srcLines <- forall (m :: * -> *) s. Monad m => StateT s m s
get

          -- attempt to fix the warning
          let startLine :: Int
startLine = RealSrcLoc -> Int
Ghc.srcLocLine RealSrcLoc
start
              mNewSrcLines :: Maybe [ByteString]
mNewSrcLines =
                Int -> RedundancyWarn -> [ByteString] -> Maybe [ByteString]
fixRedundancyWarning Int
startLine RedundancyWarn
reWarn [ByteString]
srcLines

          case Maybe [ByteString]
mNewSrcLines of
            Maybe [ByteString]
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True

            Just [ByteString]
newSrcLines -> do
              forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put [ByteString]
newSrcLines
              forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False

      (SrcSpanKey, Set Warning)
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True

    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Int
length [(SrcSpanKey, Set Warning)]
pairs forall a. Eq a => a -> a -> Bool
/= forall (t :: * -> *) a. Foldable t => t a -> Int
length Map SrcSpanKey (Set Warning)
warnMap) forall a b. (a -> b) -> a -> b
$ do
      -- write the changes to the file
      String -> ByteString -> IO ()
BS.writeFile String
modFile forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BS.unlines [ByteString]
newFileContents
      String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"'" forall a. Semigroup a => a -> a -> a
<> String
modFile forall a. Semigroup a => a -> a -> a
<> String
"' has been edited"

    forall (f :: * -> *) a. Applicative f => a -> f a
pure MkWarningsWithModDate
           { lastUpdated :: UTCTime
lastUpdated = UTCTime
lastModification
           , warningsMap :: MonoidMap SrcSpanKey (Set Warning)
warningsMap = forall k a. Map k a -> MonoidMap k a
MonoidMap forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(SrcSpanKey, Set Warning)]
pairs
           }

-- | Attempt to fix redundant import warning.
-- Returns 'Nothing' if incapable of fixing.
fixRedundancyWarning :: Int
                     -> RedundancyWarn
                     -> [BS.ByteString]
                     -> Maybe [BS.ByteString]
fixRedundancyWarning :: Int -> RedundancyWarn -> [ByteString] -> Maybe [ByteString]
fixRedundancyWarning Int
startLine RedundancyWarn
warn [ByteString]
srcLines = do
  -- The span for redundant errors is only ever a single line. This means we
  -- must search for the end of the import statement. If this a warning about a
  -- single import thing, the span line may not encompass the start of the
  -- import statement so we must search for that as well.

  ([ByteString]
before, ByteString
stmt : [ByteString]
after) <- forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> ([a], [a])
splitAt (Int
startLine forall a. Num a => a -> a -> a
- Int
1) [ByteString]
srcLines

  let isStart :: ByteString -> Bool
isStart ByteString
bs = ByteString
"import" ByteString -> ByteString -> Bool
`BS.isPrefixOf` ByteString -> ByteString
BS.dropSpace ByteString
bs

  -- If the first line is not the start of the import declaration, search for
  -- it in the preceding lines.
  ([ByteString]
before', [ByteString]
stmt') <-
    if ByteString -> Bool
isStart ByteString
stmt
       then forall a. a -> Maybe a
Just ([ByteString]
before, [ByteString
stmt])
       else do
         ([ByteString]
inS, ByteString
st : [ByteString]
rs) <- forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> ([a], [a])
break ByteString -> Bool
isStart forall a b. (a -> b) -> a -> b
$ ByteString
stmt forall a. a -> [a] -> [a]
: forall a. [a] -> [a]
reverse [ByteString]
before
         forall a. a -> Maybe a
Just (forall a. [a] -> [a]
reverse [ByteString]
rs, ByteString
st forall a. a -> [a] -> [a]
: forall a. [a] -> [a]
reverse [ByteString]
inS)

  let ([ByteString]
stmt'', [ByteString]
after') = [ByteString] -> ([ByteString], [ByteString])
splitAtImportEnd forall a b. (a -> b) -> a -> b
$ [ByteString]
stmt' forall a. Semigroup a => a -> a -> a
<> [ByteString]
after

      hasExplicitList :: Bool
hasExplicitList
        -- Check the next line to see if it contains an explicit import list
        | ByteString
a : [ByteString]
_ <- [ByteString]
after
        , ByteString -> Int
BS.length ((Char -> Bool) -> ByteString -> ByteString
BS.takeWhile Char -> Bool
isSpace ByteString
a)
            forall a. Ord a => a -> a -> Bool
> ByteString -> Int
BS.length ((Char -> Bool) -> ByteString -> ByteString
BS.takeWhile Char -> Bool
isSpace ByteString
stmt)
        , Int -> ByteString -> ByteString
BS.take Int
1 (ByteString -> ByteString
BS.dropSpace ByteString
a) forall a. Eq a => a -> a -> Bool
== ByteString
"("
          = Bool
True
        | Bool
otherwise = forall a. Maybe a -> Bool
isJust (Char -> ByteString -> Maybe Int
BS.elemIndex Char
'(' ByteString
stmt)

  case RedundancyWarn
warn of
    RedundancyWarn
WholeModule
      | Bool
hasExplicitList -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [ByteString]
before forall a. Semigroup a => a -> a -> a
<> [ByteString]
after'
      | Bool
otherwise       -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [ByteString]
before forall a. Semigroup a => a -> a -> a
<> [ByteString]
after

    IndividualThings [String]
things ->
      (forall a. Semigroup a => a -> a -> a
<> [ByteString]
after') forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([ByteString]
before' forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BS.lines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ByteString -> String -> Maybe ByteString
fixRedundantThing
              ([ByteString] -> ByteString
BS.unlines [ByteString]
stmt'')
              [String]
things

-- | Splits at the end of an import with an explicit list by counting the
-- number of opening and closing parens. If the main parens is closed, then
-- that marks the end of the import.
splitAtImportEnd :: [BS.ByteString] -> ([BS.ByteString], [BS.ByteString])
splitAtImportEnd :: [ByteString] -> ([ByteString], [ByteString])
splitAtImportEnd [ByteString]
ls = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> ([ByteString], [ByteString])
-> ([ByteString], [ByteString])
go Int
0 Int
0 ([], [ByteString]
ls) where
  go :: Int
-> Int
-> ([ByteString], [ByteString])
-> ([ByteString], [ByteString])
go Int
o Int
c ([ByteString], [ByteString])
acc
    | Int
o forall a. Eq a => a -> a -> Bool
/= Int
0 , Int
o forall a. Eq a => a -> a -> Bool
== Int
c
    = ([ByteString], [ByteString])
acc
  go Int
_ Int
_ acc :: ([ByteString], [ByteString])
acc@([ByteString]
_, []) = ([ByteString], [ByteString])
acc -- shouldn't happen
  go Int
o Int
c ([ByteString]
stmt, ByteString
r:[ByteString]
rest) =
    let addO :: Int
addO = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ Char -> ByteString -> [Int]
BS.elemIndices Char
'(' ByteString
r
        addC :: Int
addC = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ Char -> ByteString -> [Int]
BS.elemIndices Char
')' ByteString
r
     in Int
-> Int
-> ([ByteString], [ByteString])
-> ([ByteString], [ByteString])
go (Int
o forall a. Num a => a -> a -> a
+ Int
addO) (Int
c forall a. Num a => a -> a -> a
+ Int
addC) (ByteString
r forall a. a -> [a] -> [a]
: [ByteString]
stmt, [ByteString]
rest)

-- | Removes a particular thing from an import list without disrupting the
-- formatting. Returns 'Nothing' if the thing doesn't exist or appears more
-- than once.
--
-- Edges cases not handled:
-- - Comments interspersed in the statement that mention the thing
-- - Semicolon layout
fixRedundantThing :: BS.ByteString -> String -> Maybe BS.ByteString
fixRedundantThing :: ByteString -> String -> Maybe ByteString
fixRedundantThing ByteString
stmt String
thing
  -- Bail if there is more than one valid candidate
  | [(ByteString
start, ByteString
match)] <- forall a. (a -> Bool) -> [a] -> [a]
filter (ByteString, ByteString) -> Bool
isValidCandidate forall a b. (a -> b) -> a -> b
$ ByteString -> [(ByteString, ByteString)]
findCandidates ByteString
stmt

    -- 1) remove the needle
    -- 2) remove enclosing parens
    -- 3) remove stuff to the right (..) etc.
    -- 4) if there's a comma to the right, remove it as well

    -- preserve the whitespace immediately after the ',' or '('
  , let start' :: ByteString
start' = let (ByteString
s, ByteString
e) = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS.breakEnd (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
',', Char
'(']) ByteString
start
                  in ByteString
s forall a. Semigroup a => a -> a -> a
<> (Char -> Bool) -> ByteString -> ByteString
BS.takeWhile Char -> Bool
isSpace ByteString
e

        end :: ByteString
end = Int -> ByteString -> ByteString
BS.drop Int
thingLen ByteString
match
  = do
    (ByteString
start'', ByteString
end') <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ByteString -> Maybe ByteString
removeAssociatedIds
                     forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> (ByteString, ByteString)
removeEnclosingParens ByteString
start' ByteString
end
    ByteString -> Maybe (Char, ByteString)
BS.uncons ByteString
end' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      -- Don't do this if the removed thing was an associated constructor
      (Char
',', ByteString
end'')
        | Just (ByteString
_, Char
e) <- ByteString -> Maybe (ByteString, Char)
BS.unsnoc forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ByteString -> ByteString
BS.dropWhileEnd Char -> Bool
isSpace ByteString
start''
        , Char
e forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
',', Char
'('] -- Check if the target thing was not an associated constructor/method
        -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ByteString
start'' forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
BS.dropSpace ByteString
end''
        | Bool
otherwise -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ByteString
start'' forall a. Semigroup a => a -> a -> a
<> ByteString
end'
      -- If bound on the right by ')', remove the suffix containing ',' from start
      (Char
')', ByteString
_) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ByteString -> ByteString
BS.dropWhileEnd (forall a. Eq a => a -> a -> Bool
== Char
',') ByteString
startTrim forall a. Semigroup a => a -> a -> a
<> ByteString
end'
        where
          startTrim :: ByteString
startTrim = (Char -> Bool) -> ByteString -> ByteString
BS.dropWhileEnd Char -> Bool
isSpace ByteString
start''
      (Char, ByteString)
_ -> forall a. Maybe a
Nothing

  | Bool
otherwise = forall a. Maybe a
Nothing
  where
    thingBS :: ByteString
thingBS = String -> ByteString
BS.pack String
thing
    thingLen :: Int
thingLen = ByteString -> Int
BS.length ByteString
thingBS

    -- A list of substring matches where each element is a pair of the prefix
    -- with the match and remaining suffix.
    findCandidates :: ByteString -> [(ByteString, ByteString)]
findCandidates ByteString
"" = []
    findCandidates ByteString
inp =
    -- first isolate the portion that is within an open parens, otherwise
    -- if the module name is the same as the target then the search will fail.
      let (ByteString
beforeParen, ByteString
inp') = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS.break (\Char
c -> Char
c forall a. Eq a => a -> a -> Bool
== Char
'(' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
',') ByteString
inp
          (ByteString
pre, ByteString
match) = ByteString -> ByteString -> (ByteString, ByteString)
BS.breakSubstring ByteString
thingBS ByteString
inp'
       in (ByteString
beforeParen forall a. Semigroup a => a -> a -> a
<> ByteString
pre, ByteString
match) forall a. a -> [a] -> [a]
:
            ( forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((ByteString
beforeParen forall a. Semigroup a => a -> a -> a
<> ByteString
pre forall a. Semigroup a => a -> a -> a
<> ByteString
thingBS) forall a. Semigroup a => a -> a -> a
<>)
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> [(ByteString, ByteString)]
findCandidates (Int -> ByteString -> ByteString
BS.drop Int
thingLen ByteString
match)
            )

    -- Test if a match pair is valid by checking that the match is not a
    -- substring of a different identifier
    isValidCandidate :: (ByteString, ByteString) -> Bool
isValidCandidate (ByteString
start, ByteString
match) =
      Bool -> Bool
not (ByteString -> Bool
BS.null ByteString
match)
      Bool -> Bool -> Bool
&& ByteString -> Bool
isSeparator (Int -> ByteString -> ByteString
BS.drop Int
thingLen ByteString
match)
      Bool -> Bool -> Bool
&& ByteString -> Bool
isCellStart (ByteString -> ByteString
BS.reverse ByteString
start)

    isSeparator :: ByteString -> Bool
isSeparator = (Char -> Bool) -> ByteString -> Bool
headPred forall a b. (a -> b) -> a -> b
$ \Char
c -> Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
',', Char
'(', Char
')']
    isCellStart :: ByteString -> Bool
isCellStart = (Char -> Bool) -> ByteString -> Bool
headPred forall a b. (a -> b) -> a -> b
$ \Char
c -> Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
',', Char
'(']
    headPred :: (Char -> Bool) -> BS.ByteString -> Bool
    headPred :: (Char -> Bool) -> ByteString -> Bool
headPred Char -> Bool
p = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Char -> Bool
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (Char, ByteString)
BS.uncons

    -- If dealing with an operator, there will be enclosing parens with possible
    -- whitespace surrounding the operator.
    removeEnclosingParens :: ByteString -> ByteString -> (ByteString, ByteString)
removeEnclosingParens ByteString
startBS (ByteString -> ByteString
BS.dropSpace -> ByteString
endBS)
      | Just (Char
')', ByteString
end') <- ByteString -> Maybe (Char, ByteString)
BS.uncons ByteString
endBS
      , Just (ByteString
start', Char
'(') <- ByteString -> Maybe (ByteString, Char)
BS.unsnoc forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ByteString -> ByteString
BS.dropWhileEnd Char -> Bool
isSpace ByteString
startBS
      -- recurse because it could be an associated constructor that is an operator,
      -- i.e. NonEmpty((:|))
      = ByteString -> ByteString -> (ByteString, ByteString)
removeEnclosingParens ByteString
start' ByteString
end'
      | Bool
otherwise = (ByteString
startBS, ByteString
endBS)

-- | Remove list of associated constructors of a type or methods of a class
-- and any space up until the next cell terminator.
removeAssociatedIds :: BS.ByteString -> Maybe BS.ByteString
removeAssociatedIds :: ByteString -> Maybe ByteString
removeAssociatedIds = ByteString -> Maybe ByteString
checkForParens
  where
    checkForParens :: ByteString -> Maybe ByteString
checkForParens ByteString
bs =
      let bs' :: ByteString
bs' = ByteString -> ByteString
BS.dropSpace ByteString
bs
       in case ByteString -> Maybe (Char, ByteString)
BS.uncons ByteString
bs' of
            Maybe (Char, ByteString)
Nothing -> forall a. a -> Maybe a
Just ByteString
""
            Just (Char
c, ByteString
r)
              | Char
c forall a. Eq a => a -> a -> Bool
== Char
'(' -> Int -> ByteString -> Maybe ByteString
removeParens Int
1 ByteString
r
            Maybe (Char, ByteString)
_ -> forall a. a -> Maybe a
Just ByteString
bs'

    -- counts the depth of nested parens to handle the case of an operator
    -- appearing in the list.
    removeParens :: Int -> BS.ByteString -> Maybe BS.ByteString
    removeParens :: Int -> ByteString -> Maybe ByteString
removeParens Int
0 ByteString
bs = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BS.dropSpace ByteString
bs
    removeParens !Int
n ByteString
bs =
      let bs' :: ByteString
bs' = (Char -> Bool) -> ByteString -> ByteString
BS.dropWhile (\Char
x -> Char
x forall a. Eq a => a -> a -> Bool
/= Char
'(' Bool -> Bool -> Bool
&& Char
x forall a. Eq a => a -> a -> Bool
/= Char
')') ByteString
bs
       in case ByteString -> Maybe (Char, ByteString)
BS.uncons ByteString
bs' of
            Just (Char
c, ByteString
r)
              | Char
c forall a. Eq a => a -> a -> Bool
== Char
'(' -> Int -> ByteString -> Maybe ByteString
removeParens (forall a. Enum a => a -> a
succ Int
n) ByteString
r
              | Char
c forall a. Eq a => a -> a -> Bool
== Char
')' -> Int -> ByteString -> Maybe ByteString
removeParens (forall a. Enum a => a -> a
pred Int
n) ByteString
r
            Maybe (Char, ByteString)
_ -> forall a. Maybe a
Nothing

--------------------------------------------------------------------------------
-- Parsing
--------------------------------------------------------------------------------

-- | Redundant import warnings
data RedundancyWarn
  = WholeModule
  | IndividualThings [String]
  deriving Int -> RedundancyWarn -> ShowS
[RedundancyWarn] -> ShowS
RedundancyWarn -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RedundancyWarn] -> ShowS
$cshowList :: [RedundancyWarn] -> ShowS
show :: RedundancyWarn -> String
$cshow :: RedundancyWarn -> String
showsPrec :: Int -> RedundancyWarn -> ShowS
$cshowsPrec :: Int -> RedundancyWarn -> ShowS
Show

parseRedundancyWarn :: Warning -> Maybe RedundancyWarn
parseRedundancyWarn :: Warning -> Maybe RedundancyWarn
parseRedundancyWarn Warning
warn =
  case forall a. ReadP a -> ReadS a
P.readP_to_S ReadP RedundancyWarn
redundancyWarnParser (Warning -> String
showWarning Warning
warn) of
    [(RedundancyWarn
w, String
"")] -> forall a. a -> Maybe a
Just RedundancyWarn
w
    [(RedundancyWarn, String)]
_ -> forall a. Maybe a
Nothing

redundancyWarnParser :: P.ReadP RedundancyWarn
redundancyWarnParser :: ReadP RedundancyWarn
redundancyWarnParser = do
  String
_ <- String -> ReadP String
P.string String
"The import of ‘"
   forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> ReadP String
P.string String
"The qualified import of ‘"

  [String]
inQuotes <-
    forall a sep. ReadP a -> ReadP sep -> ReadP [a]
P.sepBy1 ((Char -> Bool) -> ReadP String
P.munch1 forall a b. (a -> b) -> a -> b
$ \Char
c -> Bool -> Bool
not (Char -> Bool
isSpace Char
c) Bool -> Bool -> Bool
&& Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char
',', Char
'’'])
             (Char -> ReadP Char
P.char Char
',' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ReadP ()
P.skipSpaces)

  Char
_ <- Char -> ReadP Char
P.char Char
'’'

  let terms :: ReadP RedundancyWarn
terms
        = [String] -> RedundancyWarn
IndividualThings [String]
inQuotes
         forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ( ReadP ()
P.skipSpaces
           forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> ReadP String
P.string String
"from module ‘"
           forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> ReadP String
P.munch1 (forall a. Eq a => a -> a -> Bool
/= Char
'’')
           forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> ReadP String
P.string String
"’ is redundant"
            )

      wholeMod :: ReadP RedundancyWarn
wholeMod = RedundancyWarn
WholeModule
              forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (ReadP ()
P.skipSpaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> ReadP String
P.string String
"is redundant")

  RedundancyWarn
result <- forall a. [ReadP a] -> ReadP a
P.choice [ReadP RedundancyWarn
terms, ReadP RedundancyWarn
wholeMod]

  String
_ <- (Char -> Bool) -> ReadP String
P.munch (forall a b. a -> b -> a
const Bool
True)

  forall (f :: * -> *) a. Applicative f => a -> f a
pure RedundancyWarn
result