mirror of
https://github.com/ocharles/weeder.git
synced 2024-11-25 21:04:26 +03:00
Compare commits
2 Commits
9732ba1e28
...
e39cd7d986
Author | SHA1 | Date | |
---|---|---|---|
|
e39cd7d986 | ||
|
d8df2df683 |
3
.gitignore
vendored
3
.gitignore
vendored
@ -1,5 +1,8 @@
|
|||||||
*.hi
|
*.hi
|
||||||
*.hie
|
*.hie
|
||||||
*.o
|
*.o
|
||||||
|
*.dot
|
||||||
|
*.png
|
||||||
|
*.ps
|
||||||
dist-newstyle
|
dist-newstyle
|
||||||
cabal.project.local
|
cabal.project.local
|
||||||
|
@ -10,13 +10,13 @@ module Weeder.Main ( main, mainWithConfig ) where
|
|||||||
|
|
||||||
-- base
|
-- base
|
||||||
import Control.Exception ( throwIO )
|
import Control.Exception ( throwIO )
|
||||||
import Control.Monad ( guard, unless, when )
|
import Control.Monad ( guard, when )
|
||||||
import Control.Monad.IO.Class ( liftIO )
|
import Control.Monad.IO.Class ( liftIO )
|
||||||
import Data.Bool
|
import Data.Bool
|
||||||
import Data.Foldable
|
import Data.Foldable
|
||||||
import Data.List ( isSuffixOf )
|
import Data.List ( isSuffixOf, sortOn )
|
||||||
import Data.Version ( showVersion )
|
import Data.Version ( showVersion )
|
||||||
import System.Exit ( exitFailure )
|
import System.Exit ( exitFailure, ExitCode(..), exitWith )
|
||||||
|
|
||||||
-- containers
|
-- containers
|
||||||
import qualified Data.Map.Strict as Map
|
import qualified Data.Map.Strict as Map
|
||||||
@ -64,9 +64,12 @@ main = do
|
|||||||
execParser $
|
execParser $
|
||||||
info (optsP <**> helper <**> versionP) mempty
|
info (optsP <**> helper <**> versionP) mempty
|
||||||
|
|
||||||
TOML.decodeFile (T.unpack configExpr)
|
(exitCode, _) <-
|
||||||
>>= either throwIO pure
|
TOML.decodeFile (T.unpack configExpr)
|
||||||
>>= mainWithConfig hieExt hieDirectories requireHsFiles
|
>>= either throwIO pure
|
||||||
|
>>= mainWithConfig hieExt hieDirectories requireHsFiles
|
||||||
|
|
||||||
|
exitWith exitCode
|
||||||
where
|
where
|
||||||
optsP = (,,,)
|
optsP = (,,,)
|
||||||
<$> strOption
|
<$> strOption
|
||||||
@ -104,7 +107,7 @@ main = do
|
|||||||
--
|
--
|
||||||
-- This will recursively find all files with the given extension in the given directories, perform
|
-- This will recursively find all files with the given extension in the given directories, perform
|
||||||
-- analysis, and report all unused definitions according to the 'Config'.
|
-- analysis, and report all unused definitions according to the 'Config'.
|
||||||
mainWithConfig :: String -> [FilePath] -> Bool -> Config -> IO ()
|
mainWithConfig :: String -> [FilePath] -> Bool -> Config -> IO (ExitCode, Analysis)
|
||||||
mainWithConfig hieExt hieDirectories requireHsFiles Config{ rootPatterns, typeClassRoots } = do
|
mainWithConfig hieExt hieDirectories requireHsFiles Config{ rootPatterns, typeClassRoots } = do
|
||||||
hieFilePaths <-
|
hieFilePaths <-
|
||||||
concat <$>
|
concat <$>
|
||||||
@ -162,10 +165,12 @@ mainWithConfig hieExt hieDirectories requireHsFiles Config{ rootPatterns, typeCl
|
|||||||
dead
|
dead
|
||||||
|
|
||||||
for_ ( Map.toList warnings ) \( path, declarations ) ->
|
for_ ( Map.toList warnings ) \( path, declarations ) ->
|
||||||
for_ declarations \( start, d ) ->
|
for_ (sortOn (srcLocLine . fst) declarations) \( start, d ) ->
|
||||||
putStrLn $ showWeed path start d
|
putStrLn $ showWeed path start d
|
||||||
|
|
||||||
unless ( null warnings ) exitFailure
|
let exitCode = if null warnings then ExitSuccess else ExitFailure 1
|
||||||
|
|
||||||
|
pure (exitCode, analysis)
|
||||||
|
|
||||||
showWeed :: FilePath -> RealSrcLoc -> Declaration -> String
|
showWeed :: FilePath -> RealSrcLoc -> Declaration -> String
|
||||||
showWeed path start d =
|
showWeed path start d =
|
||||||
|
64
test/Spec.hs
Normal file
64
test/Spec.hs
Normal file
@ -0,0 +1,64 @@
|
|||||||
|
import qualified Weeder.Main
|
||||||
|
import qualified Weeder
|
||||||
|
import qualified TOML
|
||||||
|
|
||||||
|
import Algebra.Graph.Export.Dot
|
||||||
|
import GHC.Types.Name.Occurrence (occNameString)
|
||||||
|
import System.Directory
|
||||||
|
import System.Environment (getArgs, withArgs)
|
||||||
|
import System.FilePath
|
||||||
|
import System.Process
|
||||||
|
import System.IO.Silently (hCapture_)
|
||||||
|
import System.IO (stdout, stderr, hPrint)
|
||||||
|
import Test.Hspec
|
||||||
|
import Control.Monad (zipWithM_, when)
|
||||||
|
import Control.Exception ( throwIO, IOException, handle )
|
||||||
|
|
||||||
|
main :: IO ()
|
||||||
|
main = do
|
||||||
|
args <- getArgs
|
||||||
|
stdoutFiles <- discoverIntegrationTests
|
||||||
|
let hieDirectories = map dropExtension stdoutFiles
|
||||||
|
drawDots = mapM_ (drawDot . (<.> ".dot")) hieDirectories
|
||||||
|
graphviz = "--graphviz" `elem` args
|
||||||
|
withArgs (filter (/="--graphviz") args) $
|
||||||
|
hspec $ afterAll_ (when graphviz drawDots) $ do
|
||||||
|
describe "Weeder.Main" $
|
||||||
|
describe "mainWithConfig" $
|
||||||
|
zipWithM_ integrationTestSpec stdoutFiles hieDirectories
|
||||||
|
where
|
||||||
|
-- Draw a dotfile via graphviz
|
||||||
|
drawDot f = callCommand $ "dot -Tpng " ++ f ++ " -o " ++ (f -<.> ".png")
|
||||||
|
|
||||||
|
-- | Run weeder on hieDirectory, comparing the output to stdoutFile
|
||||||
|
-- The directory containing hieDirectory must also have a .toml file
|
||||||
|
-- with the same name as hieDirectory
|
||||||
|
integrationTestSpec :: FilePath -> FilePath -> Spec
|
||||||
|
integrationTestSpec stdoutFile hieDirectory = do
|
||||||
|
it ("produces the expected output for " ++ hieDirectory) $ do
|
||||||
|
expectedOutput <- readFile stdoutFile
|
||||||
|
actualOutput <- integrationTestOutput hieDirectory
|
||||||
|
actualOutput `shouldBe` expectedOutput
|
||||||
|
|
||||||
|
-- | Returns detected .stdout files in ./test/Spec
|
||||||
|
discoverIntegrationTests :: IO [FilePath]
|
||||||
|
discoverIntegrationTests = do
|
||||||
|
contents <- listDirectory "./test/Spec"
|
||||||
|
pure . map ("./test/Spec" </>) $ filter (".stdout" `isExtensionOf`) contents
|
||||||
|
|
||||||
|
-- | Run weeder on the given directory for .hie files, returning stdout
|
||||||
|
-- Also creates a dotfile containing the dependency graph as seen by Weeder
|
||||||
|
integrationTestOutput :: FilePath -> IO String
|
||||||
|
integrationTestOutput hieDirectory = hCapture_ [stdout] $ do
|
||||||
|
isEmpty <- not . any (".hie" `isExtensionOf`) <$> listDirectory hieDirectory
|
||||||
|
when isEmpty $ fail "No .hie files found in directory, this is probably unintended"
|
||||||
|
(_, analysis) <-
|
||||||
|
TOML.decodeFile configExpr
|
||||||
|
>>= either throwIO pure
|
||||||
|
>>= Weeder.Main.mainWithConfig ".hie" [hieDirectory] True
|
||||||
|
let graph = Weeder.dependencyGraph analysis
|
||||||
|
graph' = export (defaultStyle (occNameString . Weeder.declOccName)) graph
|
||||||
|
handle (\e -> hPrint stderr (e :: IOException)) $
|
||||||
|
writeFile (hieDirectory <.> ".dot") graph'
|
||||||
|
where
|
||||||
|
configExpr = hieDirectory <.> ".toml"
|
1
test/Spec/BasicExample.stdout
Normal file
1
test/Spec/BasicExample.stdout
Normal file
@ -0,0 +1 @@
|
|||||||
|
test/Spec/BasicExample/BasicExample.hs:4: unrelated
|
3
test/Spec/BasicExample.toml
Normal file
3
test/Spec/BasicExample.toml
Normal file
@ -0,0 +1,3 @@
|
|||||||
|
roots = [ "Spec.BasicExample.BasicExample.root" ]
|
||||||
|
|
||||||
|
type-class-roots = true
|
10
test/Spec/BasicExample/BasicExample.hs
Normal file
10
test/Spec/BasicExample/BasicExample.hs
Normal file
@ -0,0 +1,10 @@
|
|||||||
|
module Spec.BasicExample.BasicExample where
|
||||||
|
|
||||||
|
unrelated :: Int
|
||||||
|
unrelated = 3
|
||||||
|
|
||||||
|
dependency :: Int
|
||||||
|
dependency = 1
|
||||||
|
|
||||||
|
root :: Int
|
||||||
|
root = dependency + 1
|
29
weeder.cabal
29
weeder.cabal
@ -15,6 +15,9 @@ category: Development
|
|||||||
extra-doc-files:
|
extra-doc-files:
|
||||||
README.md
|
README.md
|
||||||
CHANGELOG.md
|
CHANGELOG.md
|
||||||
|
extra-source-files:
|
||||||
|
test/Spec/*.toml
|
||||||
|
test/Spec/*.stdout
|
||||||
|
|
||||||
library
|
library
|
||||||
build-depends:
|
build-depends:
|
||||||
@ -61,3 +64,29 @@ executable weeder
|
|||||||
hs-source-dirs: exe-weeder
|
hs-source-dirs: exe-weeder
|
||||||
ghc-options: -Wall -fwarn-incomplete-uni-patterns
|
ghc-options: -Wall -fwarn-incomplete-uni-patterns
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
||||||
|
test-suite weeder-test
|
||||||
|
build-depends:
|
||||||
|
, aeson
|
||||||
|
, algebraic-graphs
|
||||||
|
, base
|
||||||
|
, directory
|
||||||
|
, filepath
|
||||||
|
, ghc
|
||||||
|
, hspec
|
||||||
|
, process
|
||||||
|
, silently
|
||||||
|
, text
|
||||||
|
, toml-reader
|
||||||
|
, weeder
|
||||||
|
type: exitcode-stdio-1.0
|
||||||
|
main-is: Spec.hs
|
||||||
|
hs-source-dirs: test
|
||||||
|
autogen-modules:
|
||||||
|
Paths_weeder
|
||||||
|
other-modules:
|
||||||
|
Paths_weeder
|
||||||
|
-- Tests
|
||||||
|
Spec.BasicExample.BasicExample
|
||||||
|
ghc-options: -Wall -fwarn-incomplete-uni-patterns -fwrite-ide-info -hiedir ./test
|
||||||
|
default-language: Haskell2010
|
||||||
|
Loading…
Reference in New Issue
Block a user