{-# language ApplicativeDo #-}
{-# language BlockArguments #-}
{-# language FlexibleContexts #-}
{-# language NamedFieldPuns #-}
{-# language OverloadedStrings #-}
{-# language LambdaCase #-}
{-# language RecordWildCards #-}
module Weeder.Main ( main, mainWithConfig, getHieFiles ) where
import Control.Concurrent.Async ( async, link, ExceptionInLinkedThread ( ExceptionInLinkedThread ) )
import Control.Exception ( Exception, throwIO, displayException, catches, Handler ( Handler ), SomeException ( SomeException ) )
import Control.Concurrent ( getChanContents, newChan, writeChan, setNumCapabilities )
import Control.Monad ( unless, when )
import Data.Foldable
import Data.List ( isSuffixOf )
import Data.Maybe ( isJust, catMaybes )
import Data.Version ( showVersion )
import System.Exit ( ExitCode(..), exitWith )
import System.IO ( stderr, hPutStrLn )
import qualified TOML
import System.Directory ( canonicalizePath, doesDirectoryExist, doesFileExist, doesPathExist, listDirectory, withCurrentDirectory )
import System.FilePath ( isExtensionOf )
import GHC.Iface.Ext.Binary ( HieFileResult( HieFileResult, hie_file_result ), readHieFileWithVersion )
import GHC.Iface.Ext.Types ( HieFile( hie_hs_file ), hieVersion )
import GHC.Types.Name.Cache ( initNameCache, NameCache )
import Options.Applicative
import qualified Data.Text.IO as T
import Weeder.Run
import Weeder.Config
import Paths_weeder (version)
data WeederException
= ExitNoHieFilesFailure
| ExitHieVersionFailure
FilePath
Integer
| ExitConfigFailure
String
| ExitWeedsFound
deriving Int -> WeederException -> ShowS
[WeederException] -> ShowS
WeederException -> FilePath
(Int -> WeederException -> ShowS)
-> (WeederException -> FilePath)
-> ([WeederException] -> ShowS)
-> Show WeederException
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WeederException -> ShowS
showsPrec :: Int -> WeederException -> ShowS
$cshow :: WeederException -> FilePath
show :: WeederException -> FilePath
$cshowList :: [WeederException] -> ShowS
showList :: [WeederException] -> ShowS
Show
weederExitCode :: WeederException -> ExitCode
weederExitCode :: WeederException -> ExitCode
weederExitCode = \case
WeederException
ExitWeedsFound -> Int -> ExitCode
ExitFailure Int
228
ExitHieVersionFailure FilePath
_ Integer
_ -> Int -> ExitCode
ExitFailure Int
2
ExitConfigFailure FilePath
_ -> Int -> ExitCode
ExitFailure Int
3
WeederException
ExitNoHieFilesFailure -> Int -> ExitCode
ExitFailure Int
4
instance Exception WeederException where
displayException :: WeederException -> FilePath
displayException = \case
WeederException
ExitNoHieFilesFailure -> FilePath
noHieFilesFoundMessage
ExitHieVersionFailure FilePath
path Integer
v -> FilePath -> Integer -> FilePath
forall {a}. Show a => FilePath -> a -> FilePath
hieVersionMismatchMessage FilePath
path Integer
v
ExitConfigFailure FilePath
s -> FilePath
s
WeederException
ExitWeedsFound -> FilePath
forall a. Monoid a => a
mempty
where
noHieFilesFoundMessage :: FilePath
noHieFilesFoundMessage =
FilePath
"No HIE files found: check that the directory is correct "
FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
"and that the -fwrite-ide-info compilation flag is set."
hieVersionMismatchMessage :: FilePath -> a -> FilePath
hieVersionMismatchMessage FilePath
path a
v = [FilePath] -> FilePath
unlines
[ FilePath
"incompatible hie file: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
path
, FilePath
" this version of weeder was compiled with GHC version "
FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
hieVersion
, FilePath
" the hie files in this project were generated with GHC version "
FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> FilePath
forall a. Show a => a -> FilePath
show a
v
, FilePath
" weeder must be built with the same GHC version"
FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
" as the project it is used on"
]
handleWeederException :: IO a -> IO a
handleWeederException :: forall a. IO a -> IO a
handleWeederException IO a
a = IO a -> [Handler a] -> IO a
forall a. IO a -> [Handler a] -> IO a
catches IO a
a [Handler a]
forall {a}. [Handler a]
handlers
where
handlers :: [Handler a]
handlers = [ (WeederException -> IO a) -> Handler a
forall a e. Exception e => (e -> IO a) -> Handler a
Handler WeederException -> IO a
forall {b}. WeederException -> IO b
rethrowExits
, (ExceptionInLinkedThread -> IO a) -> Handler a
forall a e. Exception e => (e -> IO a) -> Handler a
Handler ExceptionInLinkedThread -> IO a
forall {a}. ExceptionInLinkedThread -> IO a
unwrapLinks
]
rethrowExits :: WeederException -> IO b
rethrowExits WeederException
w = do
Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (WeederException -> FilePath
forall e. Exception e => e -> FilePath
displayException WeederException
w)
ExitCode -> IO b
forall a. ExitCode -> IO a
exitWith (WeederException -> ExitCode
weederExitCode WeederException
w)
unwrapLinks :: ExceptionInLinkedThread -> IO a
unwrapLinks (ExceptionInLinkedThread Async a
_ (SomeException e
w)) =
e -> IO a
forall e a. Exception e => e -> IO a
throwIO e
w
data CLIArguments = CLIArguments
{ CLIArguments -> FilePath
configPath :: FilePath
, CLIArguments -> FilePath
hieExt :: String
, CLIArguments -> [FilePath]
hieDirectories :: [FilePath]
, CLIArguments -> Bool
requireHsFiles :: Bool
, CLIArguments -> Bool
writeDefaultConfig :: Bool
, CLIArguments -> Bool
noDefaultFields :: Bool
, CLIArguments -> Maybe Int
capabilities :: Maybe Int
}
parseCLIArguments :: Parser CLIArguments
parseCLIArguments :: Parser CLIArguments
parseCLIArguments = do
FilePath
configPath <- 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
"config"
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 file path for Weeder's configuration."
Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value FilePath
"./weeder.toml"
Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"<weeder.toml>"
)
FilePath
hieExt <- 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-extension"
Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value FilePath
".hie"
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
"Extension of HIE files"
Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields FilePath
forall a (f :: * -> *). Show a => Mod f a
showDefault
)
[FilePath]
hieDirectories <- Parser FilePath -> Parser [FilePath]
forall a. Parser a -> Parser [a]
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 ./."
)
)
Bool
requireHsFiles <- Mod FlagFields Bool -> Parser Bool
switch
( FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"require-hs-files"
Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Skip stale .hie files with no matching .hs modules"
)
Bool
writeDefaultConfig <- Mod FlagFields Bool -> Parser Bool
switch
( FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"write-default-config"
Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Write a default configuration file if the one specified by --config does not exist"
)
Bool
noDefaultFields <- Mod FlagFields Bool -> Parser Bool
switch
( FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"no-default-fields"
Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Do not use default field values for missing fields in the configuration."
)
Maybe Int
capabilities <- Parser (Maybe Int)
forall {a}. Parser (Maybe a)
nParser Parser (Maybe Int) -> Parser (Maybe Int) -> Parser (Maybe Int)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Maybe Int)
jParser
pure CLIArguments{Bool
FilePath
[FilePath]
Maybe Int
configPath :: FilePath
hieExt :: FilePath
hieDirectories :: [FilePath]
requireHsFiles :: Bool
writeDefaultConfig :: Bool
noDefaultFields :: Bool
capabilities :: Maybe Int
configPath :: FilePath
hieExt :: FilePath
hieDirectories :: [FilePath]
requireHsFiles :: Bool
writeDefaultConfig :: Bool
noDefaultFields :: Bool
capabilities :: Maybe Int
..}
where
jParser :: Parser (Maybe Int)
jParser = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Parser Int -> Parser (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Int
forall a. Read a => ReadM a
auto
( Char -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'j'
Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Int -> Mod OptionFields Int
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Int
1
Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Int
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Number of cores to use."
Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Int
forall a (f :: * -> *). Show a => Mod f a
showDefault)
nParser :: Parser (Maybe a)
nParser = Maybe a -> Mod FlagFields (Maybe a) -> Parser (Maybe a)
forall a. a -> Mod FlagFields a -> Parser a
flag' Maybe a
forall a. Maybe a
Nothing
( Char -> Mod FlagFields (Maybe a)
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'N'
Mod FlagFields (Maybe a)
-> Mod FlagFields (Maybe a) -> Mod FlagFields (Maybe a)
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields (Maybe a)
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Use all available cores."
)
main :: IO ()
main :: IO ()
main = IO () -> IO ()
forall a. IO a -> IO a
handleWeederException do
CLIArguments{Bool
FilePath
[FilePath]
Maybe Int
configPath :: CLIArguments -> FilePath
hieExt :: CLIArguments -> FilePath
hieDirectories :: CLIArguments -> [FilePath]
requireHsFiles :: CLIArguments -> Bool
writeDefaultConfig :: CLIArguments -> Bool
noDefaultFields :: CLIArguments -> Bool
capabilities :: CLIArguments -> Maybe Int
configPath :: FilePath
hieExt :: FilePath
hieDirectories :: [FilePath]
requireHsFiles :: Bool
writeDefaultConfig :: Bool
noDefaultFields :: Bool
capabilities :: Maybe Int
..} <-
ParserInfo CLIArguments -> IO CLIArguments
forall a. ParserInfo a -> IO a
execParser (ParserInfo CLIArguments -> IO CLIArguments)
-> ParserInfo CLIArguments -> IO CLIArguments
forall a b. (a -> b) -> a -> b
$
Parser CLIArguments
-> InfoMod CLIArguments -> ParserInfo CLIArguments
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser CLIArguments
parseCLIArguments Parser CLIArguments
-> Parser (CLIArguments -> CLIArguments) -> Parser CLIArguments
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (CLIArguments -> CLIArguments)
forall a. Parser (a -> a)
helper Parser CLIArguments
-> Parser (CLIArguments -> CLIArguments) -> Parser CLIArguments
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (CLIArguments -> CLIArguments)
forall a. Parser (a -> a)
versionP) InfoMod CLIArguments
forall a. Monoid a => a
mempty
(Int -> IO ()) -> Maybe Int -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Int -> IO ()
setNumCapabilities Maybe Int
capabilities
Bool
configExists <-
FilePath -> IO Bool
doesFileExist FilePath
configPath
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
writeDefaultConfig Bool -> Bool -> Bool
==> Bool
configExists) do
Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Did not find config: wrote default config to " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
configPath
FilePath -> FilePath -> IO ()
writeFile FilePath
configPath (ConfigParsed -> FilePath
configToToml ConfigParsed
defaultConfig)
Bool -> FilePath -> IO (Either TOMLError Config)
decodeConfig Bool
noDefaultFields FilePath
configPath
IO (Either TOMLError Config)
-> (Either TOMLError Config -> IO Config) -> IO Config
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (TOMLError -> IO Config)
-> (Config -> IO Config) -> Either TOMLError Config -> IO Config
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either TOMLError -> IO Config
forall {a} {a}. Show a => a -> IO a
throwConfigError Config -> IO Config
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
IO Config -> (Config -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> [FilePath] -> Bool -> Config -> IO ()
mainWithConfig FilePath
hieExt [FilePath]
hieDirectories Bool
requireHsFiles
where
throwConfigError :: a -> IO a
throwConfigError a
e =
WeederException -> IO a
forall e a. Exception e => e -> IO a
throwIO (WeederException -> IO a) -> WeederException -> IO a
forall a b. (a -> b) -> a -> b
$ FilePath -> WeederException
ExitConfigFailure (a -> FilePath
forall a. Show a => a -> FilePath
show a
e)
decodeConfig :: Bool -> FilePath -> IO (Either TOMLError Config)
decodeConfig Bool
noDefaultFields =
if Bool
noDefaultFields
then (Text -> Either TOMLError Config)
-> IO Text -> IO (Either TOMLError Config)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Decoder Config -> Text -> Either TOMLError Config
forall a. Decoder a -> Text -> Either TOMLError a
TOML.decodeWith Decoder Config
decodeNoDefaults) (IO Text -> IO (Either TOMLError Config))
-> (FilePath -> IO Text)
-> FilePath
-> IO (Either TOMLError Config)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO Text
T.readFile
else FilePath -> IO (Either TOMLError Config)
forall a. DecodeTOML a => FilePath -> IO (Either TOMLError a)
TOML.decodeFile
versionP :: Parser (a -> a)
versionP = FilePath -> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a. FilePath -> Mod OptionFields (a -> a) -> Parser (a -> a)
infoOption ( FilePath
"weeder version "
FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> Version -> FilePath
showVersion Version
version
FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
"\nhie version "
FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
hieVersion )
( 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" )
mainWithConfig :: String -> [FilePath] -> Bool -> Config -> IO ()
mainWithConfig :: FilePath -> [FilePath] -> Bool -> Config -> IO ()
mainWithConfig FilePath
hieExt [FilePath]
hieDirectories Bool
requireHsFiles Config
weederConfig = IO () -> IO ()
forall a. IO a -> IO a
handleWeederException do
[HieFile]
hieFiles <-
FilePath -> [FilePath] -> Bool -> IO [HieFile]
getHieFiles FilePath
hieExt [FilePath]
hieDirectories Bool
requireHsFiles
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([HieFile] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HieFile]
hieFiles) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ WeederException -> IO ()
forall e a. Exception e => e -> IO a
throwIO WeederException
ExitNoHieFilesFailure
let
([Weed]
weeds, Analysis
_) =
Config -> [HieFile] -> ([Weed], Analysis)
runWeeder Config
weederConfig [HieFile]
hieFiles
(Weed -> IO ()) -> [Weed] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> (Weed -> FilePath) -> Weed -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Weed -> FilePath
formatWeed) [Weed]
weeds
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Weed] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Weed]
weeds) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ WeederException -> IO ()
forall e a. Exception e => e -> IO a
throwIO WeederException
ExitWeedsFound
getHieFiles :: String -> [FilePath] -> Bool -> IO [HieFile]
getHieFiles :: FilePath -> [FilePath] -> Bool -> IO [HieFile]
getHieFiles FilePath
hieExt [FilePath]
hieDirectories Bool
requireHsFiles = 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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ( FilePath -> FilePath -> IO [FilePath]
getFilesIn FilePath
hieExt )
( if [FilePath] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
hieDirectories
then [FilePath
"./."]
else [FilePath]
hieDirectories
)
[FilePath]
hsFilePaths <-
if Bool
requireHsFiles
then FilePath -> FilePath -> IO [FilePath]
getFilesIn FilePath
".hs" FilePath
"./."
else [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
Chan (Maybe HieFile)
hieFileResultsChan <- IO (Chan (Maybe HieFile))
forall a. IO (Chan a)
newChan
NameCache
nameCache <-
Char -> [Name] -> IO NameCache
initNameCache Char
'z' []
Async ()
a <- IO () -> IO (Async ())
forall a. IO a -> IO (Async a)
async (IO () -> IO (Async ())) -> IO () -> IO (Async ())
forall a b. (a -> b) -> a -> b
$ IO () -> IO ()
forall a. IO a -> IO a
handleWeederException do
NameCache
-> [FilePath] -> Chan (Maybe HieFile) -> [FilePath] -> IO ()
forall {t :: * -> *} {t :: * -> *}.
(Foldable t, Foldable t) =>
NameCache
-> t FilePath -> Chan (Maybe HieFile) -> t FilePath -> IO ()
readHieFiles NameCache
nameCache [FilePath]
hieFilePaths Chan (Maybe HieFile)
hieFileResultsChan [FilePath]
hsFilePaths
Chan (Maybe HieFile) -> Maybe HieFile -> IO ()
forall a. Chan a -> a -> IO ()
writeChan Chan (Maybe HieFile)
hieFileResultsChan Maybe HieFile
forall a. Maybe a
Nothing
Async () -> IO ()
forall a. Async a -> IO ()
link Async ()
a
[Maybe HieFile] -> [HieFile]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe HieFile] -> [HieFile])
-> ([Maybe HieFile] -> [Maybe HieFile])
-> [Maybe HieFile]
-> [HieFile]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe HieFile -> Bool) -> [Maybe HieFile] -> [Maybe HieFile]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Maybe HieFile -> Bool
forall a. Maybe a -> Bool
isJust ([Maybe HieFile] -> [HieFile])
-> IO [Maybe HieFile] -> IO [HieFile]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Chan (Maybe HieFile) -> IO [Maybe HieFile]
forall a. Chan a -> IO [a]
getChanContents Chan (Maybe HieFile)
hieFileResultsChan
where
readHieFiles :: NameCache
-> t FilePath -> Chan (Maybe HieFile) -> t FilePath -> IO ()
readHieFiles NameCache
nameCache t FilePath
hieFilePaths Chan (Maybe HieFile)
hieFileResultsChan t FilePath
hsFilePaths =
t FilePath -> (FilePath -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ t FilePath
hieFilePaths \FilePath
hieFilePath -> do
HieFile
hieFileResult <-
NameCache -> FilePath -> IO HieFile
readCompatibleHieFileOrExit NameCache
nameCache FilePath
hieFilePath
let hsFileExists :: Bool
hsFileExists = (FilePath -> Bool) -> t FilePath -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ( HieFile -> FilePath
hie_hs_file HieFile
hieFileResult FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` ) t FilePath
hsFilePaths
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
requireHsFiles Bool -> Bool -> Bool
==> Bool
hsFileExists) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Chan (Maybe HieFile) -> Maybe HieFile -> IO ()
forall a. Chan a -> a -> IO ()
writeChan Chan (Maybe HieFile)
hieFileResultsChan (HieFile -> Maybe HieFile
forall a. a -> Maybe a
Just HieFile
hieFileResult)
getFilesIn
:: String
-> FilePath
-> IO [FilePath]
getFilesIn :: FilePath -> FilePath -> IO [FilePath]
getFilesIn FilePath
ext 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
ext 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 m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ( FilePath -> FilePath -> IO [FilePath]
getFilesIn FilePath
ext ) [FilePath]
cnts )
else
[FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
else
[FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
readCompatibleHieFileOrExit :: NameCache -> FilePath -> IO HieFile
readCompatibleHieFileOrExit :: NameCache -> FilePath -> IO HieFile
readCompatibleHieFileOrExit NameCache
nameCache FilePath
path = do
Either HieHeader HieFileResult
res <- (HieHeader -> Bool)
-> NameCache -> FilePath -> IO (Either HieHeader HieFileResult)
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
res of
Right HieFileResult{ HieFile
hie_file_result :: HieFileResult -> HieFile
hie_file_result :: HieFile
hie_file_result } ->
HieFile -> IO HieFile
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return HieFile
hie_file_result
Left ( Integer
v, ByteString
_ghcVersion ) ->
WeederException -> IO HieFile
forall e a. Exception e => e -> IO a
throwIO (WeederException -> IO HieFile) -> WeederException -> IO HieFile
forall a b. (a -> b) -> a -> b
$ FilePath -> Integer -> WeederException
ExitHieVersionFailure FilePath
path Integer
v
infixr 5 ==>
(==>) :: Bool -> Bool -> Bool
Bool
True ==> :: Bool -> Bool -> Bool
==> Bool
x = Bool
x
Bool
False ==> Bool
_ = Bool
True