{-# language ApplicativeDo #-}
{-# language BlockArguments #-}
{-# language FlexibleContexts #-}
{-# language LambdaCase #-}
{-# language NamedFieldPuns #-}
{-# language OverloadedStrings #-}

-- | This module provides an entry point to the Weeder executable.

module Weeder.Main ( main, mainWithConfig ) where

-- base
import Control.Monad ( guard, unless )
import Control.Monad.IO.Class ( liftIO )
import Data.Bool
import Data.Foldable
import Data.Version ( showVersion )
import Text.Printf ( printf )
import System.Exit ( exitFailure )

-- bytestring
import qualified Data.ByteString.Char8 as BS

-- containers
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set

-- text
import qualified Data.Text as T

-- dhall
import qualified Dhall

-- directory
import System.Directory ( canonicalizePath, doesDirectoryExist, doesFileExist, doesPathExist, listDirectory, withCurrentDirectory )

-- filepath
import System.FilePath ( isExtensionOf )

-- ghc
import HieBin ( HieFileResult( HieFileResult, hie_file_result ), readHieFileWithVersion )
import HieTypes ( HieFile, hieVersion )
import Module ( moduleName, moduleNameString )
import NameCache ( initNameCache, NameCache )
import OccName ( occNameString )
import SrcLoc ( realSrcSpanStart, srcLocCol, srcLocLine )
import UniqSupply ( mkSplitUniqSupply )

-- regex-tdfa
import Text.Regex.TDFA ( (=~) )

-- optparse-applicative
import Options.Applicative

-- transformers
import Control.Monad.Trans.State.Strict ( execStateT )

-- weeder
import Weeder
import Weeder.Config
import Paths_weeder (version)


-- | Parse command line arguments and into a 'Config' and run 'mainWithConfig'.
main :: IO ()
main :: IO ()
main = do
  (Text
configExpr, [FilePath]
hieDirectories) <-
    ParserInfo (Text, [FilePath]) -> IO (Text, [FilePath])
forall a. ParserInfo a -> IO a
execParser (ParserInfo (Text, [FilePath]) -> IO (Text, [FilePath]))
-> ParserInfo (Text, [FilePath]) -> IO (Text, [FilePath])
forall a b. (a -> b) -> a -> b
$
      Parser (Text, [FilePath])
-> InfoMod (Text, [FilePath]) -> ParserInfo (Text, [FilePath])
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (Text, [FilePath])
optsP Parser (Text, [FilePath])
-> Parser ((Text, [FilePath]) -> (Text, [FilePath]))
-> Parser (Text, [FilePath])
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser ((Text, [FilePath]) -> (Text, [FilePath]))
forall a. Parser (a -> a)
helper Parser (Text, [FilePath])
-> Parser ((Text, [FilePath]) -> (Text, [FilePath]))
-> Parser (Text, [FilePath])
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser ((Text, [FilePath]) -> (Text, [FilePath]))
forall a. Parser (a -> a)
versionP) InfoMod (Text, [FilePath])
forall a. Monoid a => a
mempty

  Decoder Config -> Text -> IO Config
forall a. Decoder a -> Text -> IO a
Dhall.input Decoder Config
config Text
configExpr IO Config -> (Config -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [FilePath] -> Config -> IO ()
mainWithConfig [FilePath]
hieDirectories
  where
    optsP :: Parser (Text, [FilePath])
optsP = (,)
        (Text -> [FilePath] -> (Text, [FilePath]))
-> Parser Text -> Parser ([FilePath] -> (Text, [FilePath]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields Text -> Parser Text
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
            ( FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"config"
                Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"A Dhall expression for Weeder's configuration. Can either be a file path (a Dhall import) or a literal Dhall expression."
                Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> Text -> Mod OptionFields Text
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Text
"./weeder.dhall"
                Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"<weeder.dhall>"
                Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> (Text -> FilePath) -> Mod OptionFields Text
forall a (f :: * -> *). (a -> FilePath) -> Mod f a
showDefaultWith Text -> FilePath
T.unpack
            )
        Parser ([FilePath] -> (Text, [FilePath]))
-> Parser [FilePath] -> Parser (Text, [FilePath])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser FilePath -> Parser [FilePath]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (
            Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
                ( FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"hie-directory"
                    Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"A directory to look for .hie files in. Maybe specified multiple times. Default ./."
                )
            )

    versionP :: Parser (a -> a)
versionP = FilePath -> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a. FilePath -> Mod OptionFields (a -> a) -> Parser (a -> a)
infoOption (Version -> FilePath
showVersion Version
version)
        ( FilePath -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"version" Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Show version" )


-- | Run Weeder in the current working directory with a given 'Config'.
--
-- This will recursively find all @.hie@ files in the current directory, perform
-- analysis, and report all unused definitions according to the 'Config'.
mainWithConfig :: [FilePath] -> Config -> IO ()
mainWithConfig :: [FilePath] -> Config -> IO ()
mainWithConfig [FilePath]
hieDirectories Config{ Set FilePath
rootPatterns :: Config -> Set FilePath
rootPatterns :: Set FilePath
rootPatterns, Bool
typeClassRoots :: Config -> Bool
typeClassRoots :: Bool
typeClassRoots } = do
  [FilePath]
hieFilePaths <-
    [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      (FilePath -> IO [FilePath]) -> [FilePath] -> IO [[FilePath]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FilePath -> IO [FilePath]
getHieFilesIn
        ( if [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
hieDirectories
          then [FilePath
"./."]
          else [FilePath]
hieDirectories
        )

  NameCache
nameCache <- do
    UniqSupply
uniqSupply <- Char -> IO UniqSupply
mkSplitUniqSupply Char
'z'
    return ( UniqSupply -> [Name] -> NameCache
initNameCache UniqSupply
uniqSupply [] )

  Analysis
analysis <-
    (StateT Analysis IO () -> Analysis -> IO Analysis)
-> Analysis -> StateT Analysis IO () -> IO Analysis
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT Analysis IO () -> Analysis -> IO Analysis
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT Analysis
emptyAnalysis do
      [FilePath]
-> (FilePath -> StateT Analysis IO ()) -> StateT Analysis IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [FilePath]
hieFilePaths \FilePath
hieFilePath -> do
        HieFile
hieFileResult <- IO HieFile -> StateT Analysis IO HieFile
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ( NameCache -> FilePath -> IO HieFile
readCompatibleHieFileOrExit NameCache
nameCache FilePath
hieFilePath )
        HieFile -> StateT Analysis IO ()
forall (m :: * -> *). MonadState Analysis m => HieFile -> m ()
analyseHieFile HieFile
hieFileResult

  let
    roots :: Set Declaration
roots =
      (Declaration -> Bool) -> Set Declaration -> Set Declaration
forall a. (a -> Bool) -> Set a -> Set a
Set.filter
        ( \Declaration
d ->
            (FilePath -> Bool) -> Set FilePath -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any
              ( ( ModuleName -> FilePath
moduleNameString ( Module -> ModuleName
moduleName ( Declaration -> Module
declModule Declaration
d ) ) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"." FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> OccName -> FilePath
occNameString ( Declaration -> OccName
declOccName Declaration
d ) ) FilePath -> FilePath -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ )
              Set FilePath
rootPatterns
        )
        ( Analysis -> Set Declaration
allDeclarations Analysis
analysis )

    reachableSet :: Set Declaration
reachableSet =
      Analysis -> Set Root -> Set Declaration
reachable
        Analysis
analysis
        ( (Declaration -> Root) -> Set Declaration -> Set Root
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Declaration -> Root
DeclarationRoot Set Declaration
roots Set Root -> Set Root -> Set Root
forall a. Semigroup a => a -> a -> a
<> Set Root -> Set Root -> Bool -> Set Root
forall a. a -> a -> Bool -> a
bool Set Root
forall a. Monoid a => a
mempty ( (Declaration -> Root) -> Set Declaration -> Set Root
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Declaration -> Root
DeclarationRoot ( Analysis -> Set Declaration
implicitRoots Analysis
analysis ) ) Bool
typeClassRoots )

    dead :: Set Declaration
dead =
      Analysis -> Set Declaration
allDeclarations Analysis
analysis Set Declaration -> Set Declaration -> Set Declaration
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set Declaration
reachableSet

    warnings :: Map FilePath [((RealSrcLoc, [(Int, ByteString)]), Declaration)]
warnings =
      ([((RealSrcLoc, [(Int, ByteString)]), Declaration)]
 -> [((RealSrcLoc, [(Int, ByteString)]), Declaration)]
 -> [((RealSrcLoc, [(Int, ByteString)]), Declaration)])
-> [Map
      FilePath [((RealSrcLoc, [(Int, ByteString)]), Declaration)]]
-> Map FilePath [((RealSrcLoc, [(Int, ByteString)]), Declaration)]
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Map.unionsWith [((RealSrcLoc, [(Int, ByteString)]), Declaration)]
-> [((RealSrcLoc, [(Int, ByteString)]), Declaration)]
-> [((RealSrcLoc, [(Int, ByteString)]), Declaration)]
forall a. [a] -> [a] -> [a]
(++) ([Map FilePath [((RealSrcLoc, [(Int, ByteString)]), Declaration)]]
 -> Map FilePath [((RealSrcLoc, [(Int, ByteString)]), Declaration)])
-> [Map
      FilePath [((RealSrcLoc, [(Int, ByteString)]), Declaration)]]
-> Map FilePath [((RealSrcLoc, [(Int, ByteString)]), Declaration)]
forall a b. (a -> b) -> a -> b
$
      (Declaration
 -> [Map
       FilePath [((RealSrcLoc, [(Int, ByteString)]), Declaration)]])
-> Set Declaration
-> [Map
      FilePath [((RealSrcLoc, [(Int, ByteString)]), Declaration)]]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
        ( \Declaration
d ->
            Maybe
  [Map FilePath [((RealSrcLoc, [(Int, ByteString)]), Declaration)]]
-> [Map
      FilePath [((RealSrcLoc, [(Int, ByteString)]), Declaration)]]
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Maybe
   [Map FilePath [((RealSrcLoc, [(Int, ByteString)]), Declaration)]]
 -> [Map
       FilePath [((RealSrcLoc, [(Int, ByteString)]), Declaration)]])
-> Maybe
     [Map FilePath [((RealSrcLoc, [(Int, ByteString)]), Declaration)]]
-> [Map
      FilePath [((RealSrcLoc, [(Int, ByteString)]), Declaration)]]
forall a b. (a -> b) -> a -> b
$ do
              FilePath
moduleFilePath <- Module -> Map Module FilePath -> Maybe FilePath
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ( Declaration -> Module
declModule Declaration
d ) ( Analysis -> Map Module FilePath
modulePaths Analysis
analysis )
              ByteString
moduleSource <- Module -> Map Module ByteString -> Maybe ByteString
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ( Declaration -> Module
declModule Declaration
d ) ( Analysis -> Map Module ByteString
moduleSource Analysis
analysis )

              Set RealSrcSpan
spans <- Declaration
-> Map Declaration (Set RealSrcSpan) -> Maybe (Set RealSrcSpan)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Declaration
d ( Analysis -> Map Declaration (Set RealSrcSpan)
declarationSites Analysis
analysis )
              Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Set RealSrcSpan -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set RealSrcSpan
spans

              let snippets :: [(RealSrcLoc, [(Int, ByteString)])]
snippets = do
                    RealSrcSpan
srcSpan <- Set RealSrcSpan -> [RealSrcSpan]
forall a. Set a -> [a]
Set.toList Set RealSrcSpan
spans

                    let start :: RealSrcLoc
start = RealSrcSpan -> RealSrcLoc
realSrcSpanStart RealSrcSpan
srcSpan
                    let firstLine :: Int
firstLine = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 ( RealSrcLoc -> Int
srcLocLine RealSrcLoc
start Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3 )

                    (RealSrcLoc, [(Int, ByteString)])
-> [(RealSrcLoc, [(Int, ByteString)])]
forall (m :: * -> *) a. Monad m => a -> m a
return ( RealSrcLoc
start, Int -> [(Int, ByteString)] -> [(Int, ByteString)]
forall a. Int -> [a] -> [a]
take Int
5 ([(Int, ByteString)] -> [(Int, ByteString)])
-> [(Int, ByteString)] -> [(Int, ByteString)]
forall a b. (a -> b) -> a -> b
$ Int -> [(Int, ByteString)] -> [(Int, ByteString)]
forall a. Int -> [a] -> [a]
drop Int
firstLine ([(Int, ByteString)] -> [(Int, ByteString)])
-> [(Int, ByteString)] -> [(Int, ByteString)]
forall a b. (a -> b) -> a -> b
$ [Int] -> [ByteString] -> [(Int, ByteString)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] ([ByteString] -> [(Int, ByteString)])
-> [ByteString] -> [(Int, ByteString)]
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
BS.lines ByteString
moduleSource )

              return [ FilePath
-> [((RealSrcLoc, [(Int, ByteString)]), Declaration)]
-> Map FilePath [((RealSrcLoc, [(Int, ByteString)]), Declaration)]
forall k a. k -> a -> Map k a
Map.singleton FilePath
moduleFilePath ( ((RealSrcLoc, [(Int, ByteString)])
 -> Declaration -> ((RealSrcLoc, [(Int, ByteString)]), Declaration))
-> [(RealSrcLoc, [(Int, ByteString)])]
-> [Declaration]
-> [((RealSrcLoc, [(Int, ByteString)]), Declaration)]
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) [(RealSrcLoc, [(Int, ByteString)])]
snippets (Declaration -> [Declaration]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Declaration
d) ) ]
        )
        Set Declaration
dead

  [(FilePath, [((RealSrcLoc, [(Int, ByteString)]), Declaration)])]
-> ((FilePath, [((RealSrcLoc, [(Int, ByteString)]), Declaration)])
    -> IO ())
-> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ( Map FilePath [((RealSrcLoc, [(Int, ByteString)]), Declaration)]
-> [(FilePath, [((RealSrcLoc, [(Int, ByteString)]), Declaration)])]
forall k a. Map k a -> [(k, a)]
Map.toList Map FilePath [((RealSrcLoc, [(Int, ByteString)]), Declaration)]
warnings ) \( FilePath
path, [((RealSrcLoc, [(Int, ByteString)]), Declaration)]
declarations ) ->
    [((RealSrcLoc, [(Int, ByteString)]), Declaration)]
-> (((RealSrcLoc, [(Int, ByteString)]), Declaration) -> IO ())
-> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [((RealSrcLoc, [(Int, ByteString)]), Declaration)]
declarations \( ( RealSrcLoc
start, [(Int, ByteString)]
snippet ), Declaration
d ) -> do
      FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
        [FilePath] -> FilePath
unwords
          [ (FilePath -> FilePath) -> [FilePath] -> FilePath
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ( FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
":" ) [ FilePath
path, Int -> FilePath
forall a. Show a => a -> FilePath
show ( RealSrcLoc -> Int
srcLocLine RealSrcLoc
start ), Int -> FilePath
forall a. Show a => a -> FilePath
show ( RealSrcLoc -> Int
srcLocCol RealSrcLoc
start ) ]
          , FilePath
"error:"
          , OccName -> FilePath
occNameString ( Declaration -> OccName
declOccName Declaration
d )
          , FilePath
"is unused"
          ]

      FilePath -> IO ()
putStrLn FilePath
""
      [(Int, ByteString)] -> ((Int, ByteString) -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [(Int, ByteString)]
snippet \( Int
n, ByteString
line ) ->
        FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
             Int -> Char -> FilePath
forall a. Int -> a -> [a]
replicate Int
4 Char
' '
          FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Int -> FilePath
forall r. PrintfType r => FilePath -> r
printf FilePath
"% 4d" ( Int
n :: Int )
          FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" ┃ "
          FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> ByteString -> FilePath
BS.unpack ByteString
line
      FilePath -> IO ()
putStrLn FilePath
""

      FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
           Int -> Char -> FilePath
forall a. Int -> a -> [a]
replicate Int
4 Char
' '
        FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"Delete this definition or add ‘"
        FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> ModuleName -> FilePath
moduleNameString ( Module -> ModuleName
moduleName ( Declaration -> Module
declModule Declaration
d ) )
        FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"."
        FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> OccName -> FilePath
occNameString ( Declaration -> OccName
declOccName Declaration
d )
        FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"’ as a root to fix this error."
      FilePath -> IO ()
putStrLn FilePath
""
      FilePath -> IO ()
putStrLn FilePath
""

  FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Weeds detected: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall a. Show a => a -> FilePath
show ( Map FilePath Int -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ( [((RealSrcLoc, [(Int, ByteString)]), Declaration)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([((RealSrcLoc, [(Int, ByteString)]), Declaration)] -> Int)
-> Map FilePath [((RealSrcLoc, [(Int, ByteString)]), Declaration)]
-> Map FilePath Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map FilePath [((RealSrcLoc, [(Int, ByteString)]), Declaration)]
warnings ) )

  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ( Map FilePath [((RealSrcLoc, [(Int, ByteString)]), Declaration)]
-> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map FilePath [((RealSrcLoc, [(Int, ByteString)]), Declaration)]
warnings ) IO ()
forall a. IO a
exitFailure


-- | Recursively search for .hie files in given directory
getHieFilesIn :: FilePath -> IO [FilePath]
getHieFilesIn :: FilePath -> IO [FilePath]
getHieFilesIn FilePath
path = do
  Bool
exists <-
    FilePath -> IO Bool
doesPathExist FilePath
path

  if Bool
exists
    then do
      Bool
isFile <-
        FilePath -> IO Bool
doesFileExist FilePath
path

      if Bool
isFile Bool -> Bool -> Bool
&& FilePath
"hie" FilePath -> FilePath -> Bool
`isExtensionOf` FilePath
path
        then do
          FilePath
path' <-
            FilePath -> IO FilePath
canonicalizePath FilePath
path

          return [ FilePath
path' ]

        else do
          Bool
isDir <-
            FilePath -> IO Bool
doesDirectoryExist FilePath
path

          if Bool
isDir
            then do
              [FilePath]
cnts <-
                FilePath -> IO [FilePath]
listDirectory FilePath
path

              FilePath -> IO [FilePath] -> IO [FilePath]
forall a. FilePath -> IO a -> IO a
withCurrentDirectory FilePath
path ( (FilePath -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap FilePath -> IO [FilePath]
getHieFilesIn [FilePath]
cnts )

            else
              [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return []

    else
      [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return []


-- | Read a .hie file, exiting if it's an incompatible version.
readCompatibleHieFileOrExit :: NameCache -> FilePath -> IO HieFile
readCompatibleHieFileOrExit :: NameCache -> FilePath -> IO HieFile
readCompatibleHieFileOrExit NameCache
nameCache FilePath
path = do
  Either HieHeader (HieFileResult, NameCache)
res <- (HieHeader -> Bool)
-> NameCache
-> FilePath
-> IO (Either HieHeader (HieFileResult, NameCache))
readHieFileWithVersion (\ (Integer
v, ByteString
_) -> Integer
v Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
hieVersion) NameCache
nameCache FilePath
path
  case Either HieHeader (HieFileResult, NameCache)
res of
    Right ( HieFileResult{ HieFile
hie_file_result :: HieFile
hie_file_result :: HieFileResult -> HieFile
hie_file_result }, NameCache
_ ) ->
      HieFile -> IO HieFile
forall (m :: * -> *) a. Monad m => a -> m a
return HieFile
hie_file_result
    Left ( Integer
v, ByteString
_ghcVersion ) -> do
      FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"incompatible hie file: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
path
      FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"    expected .hie file version " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
hieVersion FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" but got " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
v
      FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"    weeder must be built with the same GHC version"
               FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" as the project it is used on"
      IO HieFile
forall a. IO a
exitFailure