diff --git a/src/Weeder.hs b/src/Weeder.hs index 924124c..3acd389 100644 --- a/src/Weeder.hs +++ b/src/Weeder.hs @@ -7,11 +7,12 @@ {-# language NoImplicitPrelude #-} {-# language OverloadedLabels #-} {-# language OverloadedStrings #-} +{-# language TupleSections #-} module Weeder ( -- * Analysis Analysis(..) - , analyseHieFile + , analyseHieFiles , emptyAnalysis , allDeclarations @@ -30,8 +31,10 @@ import Algebra.Graph.ToGraph ( dfs ) -- base import Control.Applicative ( Alternative ) -import Control.Monad ( guard, msum, when ) +import Control.Monad ( guard, msum, when, unless ) +import Data.Maybe ( mapMaybe ) import Data.Foldable ( for_, traverse_ ) +import Data.Function ( (&) ) import Data.List ( intercalate ) import Data.Monoid ( First( First ) ) import GHC.Generics ( Generic ) @@ -43,6 +46,8 @@ import qualified Data.Map.Strict as Map import Data.Sequence ( Seq ) import Data.Set ( Set ) import qualified Data.Set as Set +import Data.Tree (Tree) +import qualified Data.Tree as Tree -- generic-lens import Data.Generics.Labels () @@ -56,18 +61,31 @@ import GHC.Types.Avail import GHC.Types.FieldLabel ( FieldLabel( FieldLabel, flSelector ) ) import GHC.Iface.Ext.Types ( BindType( RegularBind ) - , ContextInfo( Decl, ValBind, PatternBind, Use, TyDecl, ClassTyDecl ) + , ContextInfo( Decl, ValBind, PatternBind, Use, TyDecl, ClassTyDecl, EvidenceVarBind ) , DeclType( DataDec, ClassDec, ConDec ) + , EvVarSource ( EvInstBind, cls ) , HieAST( Node, nodeChildren, nodeSpan, sourcedNodeInfo ) - , HieASTs( HieASTs ) - , HieFile( HieFile, hie_asts, hie_exports, hie_module, hie_hs_file ) - , IdentifierDetails( IdentifierDetails, identInfo ) + , HieASTs( HieASTs, getAsts ) + , HieFile( HieFile, hie_asts, hie_exports, hie_module, hie_hs_file, hie_types ) + , IdentifierDetails( IdentifierDetails, identInfo, identType ) , NodeAnnotation( NodeAnnotation, nodeAnnotType ) , NodeInfo( nodeIdentifiers, nodeAnnotations ) , Scope( ModuleScope ) + , TypeIndex , getSourcedNodeInfo ) +import GHC.Iface.Ext.Utils + ( EvidenceInfo( EvidenceInfo, evidenceVar ) + , RefMap + , findEvidenceUse + , getEvidenceTree + , generateReferencesMap + , hieTypeToIface + , recoverFullType + ) import GHC.Unit.Module ( Module, moduleStableString ) +import GHC.Utils.Outputable ( defaultSDocContext, showSDocOneLine ) +import GHC.Iface.Type ( ShowForAllFlag (ShowForAllWhen), pprIfaceSigmaType ) import GHC.Types.Name ( Name, nameModule_maybe, nameOccName , OccName @@ -85,9 +103,14 @@ import Control.Lens ( (%=) ) -- mtl import Control.Monad.State.Class ( MonadState ) +import Control.Monad.Reader.Class ( MonadReader, asks, ask) -- transformers import Control.Monad.Trans.Maybe ( runMaybeT ) +import Control.Monad.Trans.Reader ( runReaderT ) + +-- weeder +import Weeder.Config ( Config( Config, typeClassRoots ) ) data Declaration = @@ -133,28 +156,44 @@ data Analysis = -- We capture a set of spans, because a declaration may be defined in -- multiple locations, e.g., a type signature for a function separate -- from its definition. - , implicitRoots :: Set Declaration - -- ^ The Set of all Declarations that are always reachable. This is used - -- to capture knowledge not yet modelled in weeder, such as instance - -- declarations depending on top-level functions. + , implicitRoots :: Set Root + -- ^ Stores information on Declarations that may be automatically marked + -- as always reachable. This is used, for example, to capture knowledge + -- not yet modelled in weeder, or to mark all instances of a class as + -- roots. , exports :: Map Module ( Set Declaration ) -- ^ All exports for a given module. , modulePaths :: Map Module FilePath -- ^ A map from modules to the file path to the .hs file defining them. + , prettyPrintedType :: Map Declaration String + -- ^ Used to match against the types of instances and to replace the + -- appearance of declarations in the output } deriving ( Generic ) +data AnalysisInfo = + AnalysisInfo + { currentHieFile :: HieFile + , weederConfig :: Config + , refMap :: RefMap TypeIndex + } + + -- | The empty analysis - the result of analysing zero @.hie@ files. emptyAnalysis :: Analysis -emptyAnalysis = Analysis empty mempty mempty mempty mempty +emptyAnalysis = Analysis empty mempty mempty mempty mempty mempty -- | A root for reachability analysis. data Root = -- | A given declaration is a root. DeclarationRoot Declaration + | -- | We store extra information for instances in order to be able + -- to specify e.g. all instances of a class as roots. + InstanceRoot Declaration + OccName -- ^ Name of the parent class | -- | All exported declarations in a module are roots. ModuleRoot Module deriving @@ -170,6 +209,7 @@ reachable Analysis{ dependencyGraph, exports } roots = rootDeclarations = \case DeclarationRoot d -> [ d ] + InstanceRoot d _ -> [ d ] -- filter InstanceRoots in `Main.hs` ModuleRoot m -> foldMap Set.toList ( Map.lookup m exports ) @@ -180,8 +220,9 @@ allDeclarations Analysis{ dependencyGraph } = -- | Incrementally update 'Analysis' with information in a 'HieFile'. -analyseHieFile :: MonadState Analysis m => HieFile -> m () -analyseHieFile HieFile{ hie_asts = HieASTs hieASTs, hie_exports, hie_module, hie_hs_file } = do +analyseHieFile :: ( MonadState Analysis m, MonadReader AnalysisInfo m ) => m () +analyseHieFile = do + HieFile{ hie_asts = HieASTs hieASTs, hie_exports, hie_module, hie_hs_file } <- asks currentHieFile #modulePaths %= Map.insert hie_module hie_hs_file for_ hieASTs \ast -> do @@ -191,6 +232,30 @@ analyseHieFile HieFile{ hie_asts = HieASTs hieASTs, hie_exports, hie_module, hie for_ hie_exports ( analyseExport hie_module ) +lookupPprType :: MonadReader AnalysisInfo m => TypeIndex -> m String +lookupPprType t = do + HieFile{ hie_types } <- asks currentHieFile + pure . renderType $ recoverFullType t hie_types + + where + + renderType = showSDocOneLine defaultSDocContext . pprIfaceSigmaType ShowForAllWhen . hieTypeToIface + + +-- | Incrementally update 'Analysis' with information in every 'HieFile'. +analyseHieFiles :: (Foldable f, MonadState Analysis m) => Config -> f HieFile -> m () +analyseHieFiles weederConfig hieFiles = do + for_ hieFiles \hieFile -> do + let info = AnalysisInfo hieFile weederConfig rf + runReaderT analyseHieFile info + + where + + asts = concatMap (Map.elems . getAsts . hie_asts) hieFiles + + rf = generateReferencesMap asts + + analyseExport :: MonadState Analysis m => Module -> AvailInfo -> m () analyseExport m = \case Avail (NormalGreName name) -> @@ -223,7 +288,18 @@ addDependency x y = addImplicitRoot :: MonadState Analysis m => Declaration -> m () addImplicitRoot x = - #implicitRoots %= Set.insert x + #implicitRoots %= Set.insert (DeclarationRoot x) + + +addInstanceRoot :: ( MonadState Analysis m, MonadReader AnalysisInfo m ) => Declaration -> TypeIndex -> Name -> m () +addInstanceRoot x t cls = do + #implicitRoots %= Set.insert (InstanceRoot x (nameOccName cls)) + + -- since instances will not appear in the output if typeClassRoots is True + Config{ typeClassRoots } <- asks weederConfig + unless typeClassRoots $ do + str <- lookupPprType t + #prettyPrintedType %= Map.insert x str define :: MonadState Analysis m => Declaration -> RealSrcSpan -> m () @@ -245,15 +321,14 @@ addAllDeclarations n = do for_ ( findIdentifiers ( const True ) n ) addDeclaration -topLevelAnalysis :: MonadState Analysis m => HieAST a -> m () +topLevelAnalysis :: ( MonadState Analysis m, MonadReader AnalysisInfo m ) => HieAST TypeIndex -> m () topLevelAnalysis n@Node{ nodeChildren } = do analysed <- runMaybeT ( msum [ - -- analyseStandaloneDeriving n - -- , - analyseInstanceDeclaration n + analyseStandaloneDeriving n + , analyseInstanceDeclaration n , analyseBinding n , analyseRewriteRule n , analyseClassDeclaration n @@ -273,7 +348,7 @@ topLevelAnalysis n@Node{ nodeChildren } = do return () -analyseBinding :: ( Alternative m, MonadState Analysis m ) => HieAST a -> m () +analyseBinding :: ( Alternative m, MonadState Analysis m, MonadReader AnalysisInfo m ) => HieAST a -> m () analyseBinding n@Node{ nodeSpan, sourcedNodeInfo } = do let bindAnns = Set.fromList [("FunBind", "HsBindLR"), ("PatBind", "HsBindLR")] guard $ any (not . Set.disjoint bindAnns . Set.map unNodeAnnotation . nodeAnnotations) $ getSourcedNodeInfo sourcedNodeInfo @@ -281,6 +356,8 @@ analyseBinding n@Node{ nodeSpan, sourcedNodeInfo } = do for_ ( findDeclarations n ) \d -> do define d nodeSpan + followEvidenceUses n d + for_ ( uses n ) $ addDependency d @@ -291,19 +368,34 @@ analyseRewriteRule n@Node{ sourcedNodeInfo } = do for_ ( uses n ) addImplicitRoot -analyseInstanceDeclaration :: ( Alternative m, MonadState Analysis m ) => HieAST a -> m () -analyseInstanceDeclaration n@Node{ sourcedNodeInfo } = do +analyseInstanceDeclaration :: ( Alternative m, MonadState Analysis m, MonadReader AnalysisInfo m ) => HieAST TypeIndex -> m () +analyseInstanceDeclaration n@Node{ nodeSpan, sourcedNodeInfo } = do guard $ any (Set.member ("ClsInstD", "InstDecl") . Set.map unNodeAnnotation . nodeAnnotations) $ getSourcedNodeInfo sourcedNodeInfo - traverse_ addImplicitRoot ( uses n ) + for_ ( findEvInstBinds n ) \(d, cs, ids, _) -> do + -- This makes instance declarations show up in + -- the output if type-class-roots is set to False. + define d nodeSpan + + followEvidenceUses n d + + for_ ( uses n ) $ addDependency d + + case identType ids of + Just t -> for_ cs (addInstanceRoot d t) + Nothing -> pure () -analyseClassDeclaration :: ( Alternative m, MonadState Analysis m ) => HieAST a -> m () -analyseClassDeclaration n@Node{ sourcedNodeInfo } = do +analyseClassDeclaration :: ( Alternative m, MonadState Analysis m, MonadReader AnalysisInfo m ) => HieAST a -> m () +analyseClassDeclaration n@Node{ nodeSpan, sourcedNodeInfo } = do guard $ any (Set.member ("ClassDecl", "TyClDecl") . Set.map unNodeAnnotation . nodeAnnotations) $ getSourcedNodeInfo sourcedNodeInfo - for_ ( findIdentifiers isClassDeclaration n ) $ - for_ ( findIdentifiers ( const True ) n ) . addDependency + for_ ( findIdentifiers isClassDeclaration n ) $ \d -> do + define d nodeSpan + + followEvidenceUses n d + + (for_ ( findIdentifiers ( const True ) n ) . addDependency) d where @@ -316,7 +408,7 @@ analyseClassDeclaration n@Node{ sourcedNodeInfo } = do False -analyseDataDeclaration :: ( Alternative m, MonadState Analysis m ) => HieAST a -> m () +analyseDataDeclaration :: ( Alternative m, MonadState Analysis m, MonadReader AnalysisInfo m ) => HieAST TypeIndex -> m () analyseDataDeclaration n@Node{ sourcedNodeInfo } = do guard $ any (Set.member ("DataDecl", "TyClDecl") . Set.map unNodeAnnotation . nodeAnnotations) $ getSourcedNodeInfo sourcedNodeInfo @@ -332,6 +424,17 @@ analyseDataDeclaration n@Node{ sourcedNodeInfo } = do for_ ( uses constructor ) ( addDependency conDec ) + for_ ( derivedInstances n ) \(d, cs, ids, ast) -> do + define d (nodeSpan ast) + + followEvidenceUses ast d + + for_ ( uses ast ) $ addDependency d + + case identType ids of + Just t -> for_ cs (addInstanceRoot d t) + Nothing -> pure () + where isDataDec = \case @@ -351,12 +454,62 @@ constructors n@Node{ nodeChildren, sourcedNodeInfo } = else foldMap constructors nodeChildren + +derivedInstances :: HieAST a -> Seq (Declaration, Set Name, IdentifierDetails a, HieAST a) +derivedInstances n@Node{ nodeChildren, sourcedNodeInfo } = + if any (Set.member ("HsDerivingClause", "HsDerivingClause") . Set.map unNodeAnnotation . nodeAnnotations) $ getSourcedNodeInfo sourcedNodeInfo + then findEvInstBinds n + + else + foldMap derivedInstances nodeChildren + + +analyseStandaloneDeriving :: ( Alternative m, MonadState Analysis m, MonadReader AnalysisInfo m ) => HieAST TypeIndex -> m () +analyseStandaloneDeriving n@Node{ nodeSpan, sourcedNodeInfo } = do + guard $ any (Set.member ("DerivDecl", "DerivDecl") . Set.map unNodeAnnotation . nodeAnnotations) $ getSourcedNodeInfo sourcedNodeInfo + + for_ (findEvInstBinds n) \(d, cs, ids, _) -> do + define d nodeSpan + + followEvidenceUses n d + + for_ (uses n) $ addDependency d + + case identType ids of + Just t -> for_ cs (addInstanceRoot d t) + Nothing -> pure () + + analysePatternSynonyms :: ( Alternative m, MonadState Analysis m ) => HieAST a -> m () analysePatternSynonyms n@Node{ sourcedNodeInfo } = do guard $ any (Set.member ("PatSynBind", "HsBindLR") . Set.map unNodeAnnotation . nodeAnnotations) $ getSourcedNodeInfo sourcedNodeInfo for_ ( findDeclarations n ) $ for_ ( uses n ) . addDependency + +findEvInstBinds :: HieAST a -> Seq (Declaration, Set Name, IdentifierDetails a, HieAST a) +findEvInstBinds n = (\(d, ids, ast) -> (d, getClassNames ids, ids, ast)) <$> + findIdentifiers' + ( not + . Set.null + . getEvVarSources + ) n + + where + + getEvVarSources :: Set ContextInfo -> Set EvVarSource + getEvVarSources = foldMap (maybe mempty Set.singleton) . + Set.map \case + EvidenceVarBind a@EvInstBind{} ModuleScope _ -> Just a + _ -> Nothing + + getClassNames :: IdentifierDetails a -> Set Name + getClassNames = + Set.map cls + . getEvVarSources + . identInfo + + findDeclarations :: HieAST a -> Seq Declaration findDeclarations = findIdentifiers @@ -379,21 +532,31 @@ findIdentifiers :: ( Set ContextInfo -> Bool ) -> HieAST a -> Seq Declaration -findIdentifiers f Node{ sourcedNodeInfo, nodeChildren } = +findIdentifiers f = fmap (\(d, _, _) -> d) . findIdentifiers' f + + +-- | Version of findIdentifiers containing more information, +-- namely the IdentifierDetails of the declaration and the +-- node it was found in. +findIdentifiers' + :: ( Set ContextInfo -> Bool ) + -> HieAST a + -> Seq (Declaration, IdentifierDetails a, HieAST a) +findIdentifiers' f n@Node{ sourcedNodeInfo, nodeChildren } = foldMap - ( \case + (\case ( Left _, _ ) -> mempty - ( Right name, IdentifierDetails{ identInfo } ) -> + ( Right name, ids@IdentifierDetails{ identInfo } ) -> if f identInfo then - foldMap pure ( nameToDeclaration name ) + (, ids, n) <$> foldMap pure (nameToDeclaration name) else mempty ) (foldMap (Map.toList . nodeIdentifiers) (getSourcedNodeInfo sourcedNodeInfo)) - <> foldMap ( findIdentifiers f ) nodeChildren + <> foldMap ( findIdentifiers' f ) nodeChildren uses :: HieAST a -> Set Declaration @@ -410,3 +573,33 @@ nameToDeclaration name = do unNodeAnnotation :: NodeAnnotation -> (String, String) unNodeAnnotation (NodeAnnotation x y) = (unpackFS x, unpackFS y) + + +-- | Follow evidence uses under the given node back to their instance bindings, +-- and connect the declaration to those bindings. +followEvidenceUses :: ( MonadState Analysis m, MonadReader AnalysisInfo m ) => HieAST a -> Declaration -> m () +followEvidenceUses n d = do + Config{ typeClassRoots } <- asks weederConfig + AnalysisInfo{ refMap } <- ask + + let getEvidenceTrees = mapMaybe (getEvidenceTree refMap) + evidenceInfos = concatMap Tree.flatten (getEvidenceTrees names) + instanceEvidenceInfos = evidenceInfos & filter \case + EvidenceInfo _ _ _ (Just (EvInstBind _ _, ModuleScope, _)) -> True + _ -> False + + -- If type-class-roots flag is set then we don't need to follow evidence uses + -- as the binding sites will be roots anyway + unless typeClassRoots $ for_ instanceEvidenceInfos \ev -> do + let name = nameToDeclaration (evidenceVar ev) + mapM_ (addDependency d) name + + where + + names = concat . Tree.flatten $ evidenceUseTree n + + evidenceUseTree :: HieAST a -> Tree [Name] + evidenceUseTree Node{ sourcedNodeInfo, nodeChildren } = Tree.Node + { Tree.rootLabel = concatMap (findEvidenceUse . nodeIdentifiers) (getSourcedNodeInfo sourcedNodeInfo) + , Tree.subForest = map evidenceUseTree nodeChildren + } diff --git a/src/Weeder/Config.hs b/src/Weeder/Config.hs index ffb849e..d275fac 100644 --- a/src/Weeder/Config.hs +++ b/src/Weeder/Config.hs @@ -21,11 +21,21 @@ data Config = Config -- ^ If True, consider all declarations in a type class as part of the root -- set. Weeder is currently unable to identify whether or not a type class -- instance is used - enabling this option can prevent false positives. + , rootClasses :: Set String + -- ^ All instances of type classes matching these regular expressions will + -- be added to the root set. Note that this does not mark the class itself + -- as a root, so if the class has no instances then it will not be made + -- reachable. + , rootInstances :: Set String + -- ^ All instances with types matching these regular expressions will + -- be added to the root set. } instance TOML.DecodeTOML Config where tomlDecoder = do rootPatterns <- TOML.getField "roots" typeClassRoots <- TOML.getField "type-class-roots" + rootClasses <- TOML.getFieldOr mempty "root-classes" + rootInstances <- TOML.getFieldOr mempty "root-instances" return Config{..} diff --git a/src/Weeder/Main.hs b/src/Weeder/Main.hs index 81c6a5b..a55f31f 100644 --- a/src/Weeder/Main.hs +++ b/src/Weeder/Main.hs @@ -3,6 +3,7 @@ {-# language FlexibleContexts #-} {-# language NamedFieldPuns #-} {-# language OverloadedStrings #-} +{-# language LambdaCase #-} -- | This module provides an entry point to the Weeder executable. @@ -10,9 +11,7 @@ module Weeder.Main ( main, mainWithConfig ) where -- base import Control.Exception ( throwIO ) -import Control.Monad ( guard, when ) -import Control.Monad.IO.Class ( liftIO ) -import Data.Bool +import Control.Monad ( guard ) import Data.Foldable import Data.List ( isSuffixOf, sortOn ) import Data.Version ( showVersion ) @@ -108,7 +107,7 @@ main = do -- 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'. mainWithConfig :: String -> [FilePath] -> Bool -> Config -> IO (ExitCode, Analysis) -mainWithConfig hieExt hieDirectories requireHsFiles Config{ rootPatterns, typeClassRoots } = do +mainWithConfig hieExt hieDirectories requireHsFiles weederConfig@Config{ rootPatterns, typeClassRoots, rootInstances, rootClasses } = do hieFilePaths <- concat <$> traverse ( getFilesIn hieExt ) @@ -125,13 +124,16 @@ mainWithConfig hieExt hieDirectories requireHsFiles Config{ rootPatterns, typeCl nameCache <- initNameCache 'z' [] + hieFileResults <- + mapM ( readCompatibleHieFileOrExit nameCache ) hieFilePaths + + let + hieFileResults' = flip filter hieFileResults \hieFileResult -> + let hsFileExists = any ( hie_hs_file hieFileResult `isSuffixOf` ) hsFilePaths + in requireHsFiles ==> hsFileExists + analysis <- - flip execStateT emptyAnalysis do - for_ hieFilePaths \hieFilePath -> do - hieFileResult <- liftIO ( readCompatibleHieFileOrExit nameCache hieFilePath ) - let hsFileExists = any ( hie_hs_file hieFileResult `isSuffixOf` ) hsFilePaths - when (requireHsFiles ==> hsFileExists) do - analyseHieFile hieFileResult + execStateT ( analyseHieFiles weederConfig hieFileResults' ) emptyAnalysis let roots = @@ -146,7 +148,7 @@ mainWithConfig hieExt hieDirectories requireHsFiles Config{ rootPatterns, typeCl reachableSet = reachable analysis - ( Set.map DeclarationRoot roots <> bool mempty ( Set.map DeclarationRoot ( implicitRoots analysis ) ) typeClassRoots ) + ( Set.map DeclarationRoot roots <> filterImplicitRoots (prettyPrintedType analysis) ( implicitRoots analysis ) ) dead = allDeclarations analysis Set.\\ reachableSet @@ -166,18 +168,37 @@ mainWithConfig hieExt hieDirectories requireHsFiles Config{ rootPatterns, typeCl for_ ( Map.toList warnings ) \( path, declarations ) -> for_ (sortOn (srcLocLine . fst) declarations) \( start, d ) -> - putStrLn $ showWeed path start d + case Map.lookup d (prettyPrintedType analysis) of + Nothing -> putStrLn $ showWeed path start d + Just t -> putStrLn $ showPath path start <> "(Instance) :: " <> t let exitCode = if null warnings then ExitSuccess else ExitFailure 1 pure (exitCode, analysis) + where + + filterImplicitRoots printedTypeMap = Set.filter $ \case + DeclarationRoot _ -> True -- keep implicit roots for rewrite rules + ModuleRoot _ -> True + InstanceRoot d c -> typeClassRoots || any (occNameString c =~) rootClasses || matchingType + where + matchingType = case Map.lookup d printedTypeMap of + Just t -> any (t =~) rootInstances + Nothing -> False + + showWeed :: FilePath -> RealSrcLoc -> Declaration -> String showWeed path start d = - path <> ":" <> show ( srcLocLine start ) <> ": " + showPath path start <> occNameString ( declOccName d) +showPath :: FilePath -> RealSrcLoc -> String +showPath path start = + path <> ":" <> show ( srcLocLine start ) <> ": " + + -- | Recursively search for files with the given extension in given directory getFilesIn :: String diff --git a/test/Spec.hs b/test/Spec.hs index 6f3f6f6..040d177 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -13,38 +13,62 @@ import System.IO (stdout, stderr, hPrint) import Test.Hspec import Control.Monad (zipWithM_, when) import Control.Exception ( throwIO, IOException, handle ) +import Data.Maybe (isJust) +import Data.List (find, sortOn) main :: IO () main = do args <- getArgs - stdoutFiles <- discoverIntegrationTests - let hieDirectories = map dropExtension stdoutFiles + testOutputFiles <- fmap sortTests discoverIntegrationTests + let hieDirectories = map (dropExtension . snd) testOutputFiles 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 + zipWithM_ (uncurry integrationTestSpec) testOutputFiles hieDirectories where -- Draw a dotfile via graphviz drawDot f = callCommand $ "dot -Tpng " ++ f ++ " -o " ++ (f -<.> ".png") + -- Sort the output files such that the failing ones go last + sortTests = sortOn (isJust . fst) --- | 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 +-- | 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@. +-- +-- If @failingFile@ is @Just@, it is used as the expected output instead of +-- @stdoutFile@, and a different failure message is printed if the output +-- matches @stdoutFile@. +integrationTestSpec :: Maybe FilePath -> FilePath -> FilePath -> Spec +integrationTestSpec failingFile stdoutFile hieDirectory = do + it (integrationTestText ++ hieDirectory) $ do expectedOutput <- readFile stdoutFile actualOutput <- integrationTestOutput hieDirectory - actualOutput `shouldBe` expectedOutput + case failingFile of + Just f -> do + failingOutput <- readFile f + actualOutput `shouldNotBe` expectedOutput + actualOutput `shouldBe` failingOutput + Nothing -> + actualOutput `shouldBe` expectedOutput + where + integrationTestText = case failingFile of + Nothing -> "produces the expected output for " + Just _ -> "produces the expected (wrong) output for " --- | Returns detected .stdout files in ./test/Spec -discoverIntegrationTests :: IO [FilePath] +-- | Returns detected .failing and .stdout files in ./test/Spec +discoverIntegrationTests :: IO [(Maybe FilePath, FilePath)] discoverIntegrationTests = do - contents <- listDirectory "./test/Spec" - pure . map ("./test/Spec" ) $ filter (".stdout" `isExtensionOf`) contents + contents <- listDirectory testPath + let stdoutFiles = map (testPath ) $ + filter (".stdout" `isExtensionOf`) contents + pure . map (\s -> (findFailing s contents, s)) $ stdoutFiles + where + findFailing s = fmap (testPath ) . find (takeBaseName s <.> ".failing" ==) + testPath = "./test/Spec" -- | Run weeder on the given directory for .hie files, returning stdout -- Also creates a dotfile containing the dependency graph as seen by Weeder diff --git a/test/Spec/ApplicativeDo.failing b/test/Spec/ApplicativeDo.failing new file mode 100644 index 0000000..c7cc424 --- /dev/null +++ b/test/Spec/ApplicativeDo.failing @@ -0,0 +1,2 @@ +test/Spec/ApplicativeDo/ApplicativeDo.hs:6: (Instance) :: Functor Foo +test/Spec/ApplicativeDo/ApplicativeDo.hs:9: (Instance) :: Applicative Foo diff --git a/test/Spec/ApplicativeDo.stdout b/test/Spec/ApplicativeDo.stdout new file mode 100644 index 0000000..e69de29 diff --git a/test/Spec/ApplicativeDo.toml b/test/Spec/ApplicativeDo.toml new file mode 100644 index 0000000..3d15b41 --- /dev/null +++ b/test/Spec/ApplicativeDo.toml @@ -0,0 +1,3 @@ +roots = [ "Spec.ApplicativeDo.ApplicativeDo.root" ] + +type-class-roots = false diff --git a/test/Spec/ApplicativeDo/ApplicativeDo.hs b/test/Spec/ApplicativeDo/ApplicativeDo.hs new file mode 100644 index 0000000..dff9c63 --- /dev/null +++ b/test/Spec/ApplicativeDo/ApplicativeDo.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE ApplicativeDo #-} +module Spec.ApplicativeDo.ApplicativeDo where + +newtype Foo a = Foo a + +instance Functor Foo where + fmap f (Foo a) = Foo (f a) + +instance Applicative Foo where + pure = Foo + Foo f <*> Foo a = Foo (f a) + +root :: Foo Int +root = do + a <- Foo 1 + b <- Foo 2 + pure (a + b) diff --git a/test/Spec/DeriveGeneric.stdout b/test/Spec/DeriveGeneric.stdout new file mode 100644 index 0000000..7b2e665 --- /dev/null +++ b/test/Spec/DeriveGeneric.stdout @@ -0,0 +1 @@ +test/Spec/DeriveGeneric/DeriveGeneric.hs:12: (Instance) :: FromJSON T diff --git a/test/Spec/DeriveGeneric.toml b/test/Spec/DeriveGeneric.toml new file mode 100644 index 0000000..ffb8119 --- /dev/null +++ b/test/Spec/DeriveGeneric.toml @@ -0,0 +1,3 @@ +roots = [ "Spec.DeriveGeneric.DeriveGeneric.t" ] + +type-class-roots = false diff --git a/test/Spec/DeriveGeneric/DeriveGeneric.hs b/test/Spec/DeriveGeneric/DeriveGeneric.hs new file mode 100644 index 0000000..f27e228 --- /dev/null +++ b/test/Spec/DeriveGeneric/DeriveGeneric.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +module Spec.DeriveGeneric.DeriveGeneric where + +import GHC.Generics +import Data.Aeson + +newtype T = MkT Bool + -- Generic and ToJSON must not be detected as unused + -- but FromJSON should be detected as unused + deriving ( Generic, ToJSON + , FromJSON ) + +t :: Value +t = toJSON $ MkT True diff --git a/test/Spec/InstanceRootConstraint.stdout b/test/Spec/InstanceRootConstraint.stdout new file mode 100644 index 0000000..e69de29 diff --git a/test/Spec/InstanceRootConstraint.toml b/test/Spec/InstanceRootConstraint.toml new file mode 100644 index 0000000..6f12ff5 --- /dev/null +++ b/test/Spec/InstanceRootConstraint.toml @@ -0,0 +1,7 @@ +roots = [] + +type-class-roots = false + +root-classes = [] + +root-instances = [ 'Foo a => Foo \[a\]' ] diff --git a/test/Spec/InstanceRootConstraint/InstanceRootConstraint.hs b/test/Spec/InstanceRootConstraint/InstanceRootConstraint.hs new file mode 100644 index 0000000..318263c --- /dev/null +++ b/test/Spec/InstanceRootConstraint/InstanceRootConstraint.hs @@ -0,0 +1,13 @@ +module Spec.InstanceRootConstraint.InstanceRootConstraint where + +class Foo a where + foo :: a -> Char + +instance Foo Char where + foo = id + +instance Foo a => Foo [a] where + foo = const a + +a :: Char +a = foo 'a' diff --git a/test/Spec/InstanceTypeclass.stdout b/test/Spec/InstanceTypeclass.stdout new file mode 100644 index 0000000..5b03c94 --- /dev/null +++ b/test/Spec/InstanceTypeclass.stdout @@ -0,0 +1,2 @@ +test/Spec/InstanceTypeclass/InstanceTypeclass.hs:4: Foo +test/Spec/InstanceTypeclass/InstanceTypeclass.hs:10: (Instance) :: Foo Char diff --git a/test/Spec/InstanceTypeclass.toml b/test/Spec/InstanceTypeclass.toml new file mode 100644 index 0000000..bdcfae7 --- /dev/null +++ b/test/Spec/InstanceTypeclass.toml @@ -0,0 +1,5 @@ +roots = [] + +type-class-roots = false + +root-instances = [ "RootClass Char" ] diff --git a/test/Spec/InstanceTypeclass/InstanceTypeclass.hs b/test/Spec/InstanceTypeclass/InstanceTypeclass.hs new file mode 100644 index 0000000..ce85c48 --- /dev/null +++ b/test/Spec/InstanceTypeclass/InstanceTypeclass.hs @@ -0,0 +1,20 @@ +-- | Test for correct output of unreachable classes and instances +module Spec.InstanceTypeclass.InstanceTypeclass where + +class Foo a where + foo :: a -> Char + +-- this instance is not marked as root, +-- therefore class Foo will show up in the output +-- as well +instance Foo Char where + foo = id + +class RootClass a where + rootClass :: a -> Char + +-- this instance is explicitly marked as root, +-- hence RootClass will not show up in the output +-- (note the way it is written in InstanceTypeclass.toml) +instance RootClass Char where + rootClass = id diff --git a/test/Spec/Monads.failing b/test/Spec/Monads.failing new file mode 100644 index 0000000..d1fdca2 --- /dev/null +++ b/test/Spec/Monads.failing @@ -0,0 +1,3 @@ +test/Spec/Monads/Monads.hs:20: (Instance) :: Functor Identity' +test/Spec/Monads/Monads.hs:23: (Instance) :: Applicative Identity' +test/Spec/Monads/Monads.hs:27: (Instance) :: Monad Identity' diff --git a/test/Spec/Monads.stdout b/test/Spec/Monads.stdout new file mode 100644 index 0000000..e69de29 diff --git a/test/Spec/Monads.toml b/test/Spec/Monads.toml new file mode 100644 index 0000000..7f30f67 --- /dev/null +++ b/test/Spec/Monads.toml @@ -0,0 +1,3 @@ +roots = [ "Spec.Monads.Monads.foo", "Spec.Monads.Monads.bar" ] + +type-class-roots = false diff --git a/test/Spec/Monads/Monads.hs b/test/Spec/Monads/Monads.hs new file mode 100644 index 0000000..9b08ea0 --- /dev/null +++ b/test/Spec/Monads/Monads.hs @@ -0,0 +1,38 @@ +{-# OPTIONS_GHC -Wno-missing-signatures #-} +{-# OPTIONS_GHC -Wno-type-defaults #-} +module Spec.Monads.Monads where + +newtype Identity a = Identity { runIdentity :: a } + +instance Functor Identity where + fmap f (Identity x) = Identity (f x) + +instance Applicative Identity where + pure = Identity + Identity f <*> Identity x = Identity (f x) + +instance Monad Identity where + return = pure + Identity x >>= f = f x + +newtype Identity' a = Identity' { runIdentity' :: a} + +instance Functor Identity' where + fmap f (Identity' x) = Identity' (f x) + +instance Applicative Identity' where + pure = Identity' + Identity' f <*> Identity' x = Identity' (f x) + +instance Monad Identity' where + return = pure + Identity' x >>= f = f x + +foo = do + _x <- Identity 3 + Identity 4 + +bar :: Identity' Integer -- oh no (the type signature breaks the evidence variables) +bar = do + _x <- Identity' 3 + Identity' 4 diff --git a/test/Spec/NumInstance.stdout b/test/Spec/NumInstance.stdout new file mode 100644 index 0000000..e69de29 diff --git a/test/Spec/NumInstance.toml b/test/Spec/NumInstance.toml new file mode 100644 index 0000000..483518f --- /dev/null +++ b/test/Spec/NumInstance.toml @@ -0,0 +1,3 @@ +roots = [ "Spec.NumInstance.NumInstance.two" ] + +type-class-roots = false diff --git a/test/Spec/NumInstance/NumInstance.hs b/test/Spec/NumInstance/NumInstance.hs new file mode 100644 index 0000000..c75cea4 --- /dev/null +++ b/test/Spec/NumInstance/NumInstance.hs @@ -0,0 +1,17 @@ +{-# OPTIONS_GHC -Wno-missing-methods #-} +module Spec.NumInstance.NumInstance where + +data Modulo2 = Zero | One + +instance Num Modulo2 where + (+) = add + -- leave the rest undefined + +-- add should not be detected as unused +add :: Modulo2 -> Modulo2 -> Modulo2 +add One One = Zero +add Zero n = n +add n Zero = n + +two :: Modulo2 +two = One + One diff --git a/test/Spec/NumInstanceLiteral.failing b/test/Spec/NumInstanceLiteral.failing new file mode 100644 index 0000000..0d42ea6 --- /dev/null +++ b/test/Spec/NumInstanceLiteral.failing @@ -0,0 +1 @@ +test/Spec/NumInstanceLiteral/NumInstanceLiteral.hs:7: (Instance) :: Num Modulo1 diff --git a/test/Spec/NumInstanceLiteral.stdout b/test/Spec/NumInstanceLiteral.stdout new file mode 100644 index 0000000..e69de29 diff --git a/test/Spec/NumInstanceLiteral.toml b/test/Spec/NumInstanceLiteral.toml new file mode 100644 index 0000000..1e02dec --- /dev/null +++ b/test/Spec/NumInstanceLiteral.toml @@ -0,0 +1,3 @@ +roots = [ "Spec.NumInstanceLiteral.NumInstanceLiteral.zero" ] + +type-class-roots = false diff --git a/test/Spec/NumInstanceLiteral/NumInstanceLiteral.hs b/test/Spec/NumInstanceLiteral/NumInstanceLiteral.hs new file mode 100644 index 0000000..bacec18 --- /dev/null +++ b/test/Spec/NumInstanceLiteral/NumInstanceLiteral.hs @@ -0,0 +1,12 @@ +{-# OPTIONS_GHC -Wno-missing-methods #-} +module Spec.NumInstanceLiteral.NumInstanceLiteral where + +data Modulo1 = Zero + +-- $fNumModulo1 should not be detected as unused +instance Num Modulo1 where + fromInteger _ = Zero + -- leave the rest undefined + +zero :: Modulo1 +zero = 0 -- no evidence usage here at all in the HieAST (9.4.4 and 9.6.1) diff --git a/test/Spec/OverloadedLabels.stdout b/test/Spec/OverloadedLabels.stdout new file mode 100644 index 0000000..6b4ccd1 --- /dev/null +++ b/test/Spec/OverloadedLabels.stdout @@ -0,0 +1 @@ +test/Spec/OverloadedLabels/OverloadedLabels.hs:17: (Instance) :: Has Point "y" Int diff --git a/test/Spec/OverloadedLabels.toml b/test/Spec/OverloadedLabels.toml new file mode 100644 index 0000000..3cc0b9d --- /dev/null +++ b/test/Spec/OverloadedLabels.toml @@ -0,0 +1,3 @@ +roots = [ "Spec.OverloadedLabels.OverloadedLabels.root" ] + +type-class-roots = false diff --git a/test/Spec/OverloadedLabels/OverloadedLabels.hs b/test/Spec/OverloadedLabels/OverloadedLabels.hs new file mode 100644 index 0000000..04b5d3c --- /dev/null +++ b/test/Spec/OverloadedLabels/OverloadedLabels.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE DataKinds, KindSignatures, + FunctionalDependencies, FlexibleInstances, + OverloadedLabels, ScopedTypeVariables #-} +{-# OPTIONS_GHC -Wno-orphans #-} +module Spec.OverloadedLabels.OverloadedLabels where +import GHC.OverloadedLabels (IsLabel(..)) +import GHC.TypeLits (Symbol) + +data Label (l :: Symbol) = Get + +class Has a l b | a l -> b where + from :: a -> Label l -> b + +data Point = Point Int Int -- odd behaviour with dependencies between Point and Int + +instance Has Point "x" Int where from (Point x _) _ = x +instance Has Point "y" Int where from (Point _ y) _ = y + +instance Has a l b => IsLabel l (a -> b) where + fromLabel x = from x (Get :: Label l) + +root :: Int +root = #x (Point 1 2) + -- surprisingly OverloadedLabels works perfectly out of the box diff --git a/test/Spec/OverloadedLists.failing b/test/Spec/OverloadedLists.failing new file mode 100644 index 0000000..a1c1f30 --- /dev/null +++ b/test/Spec/OverloadedLists.failing @@ -0,0 +1 @@ +test/Spec/OverloadedLists/OverloadedLists.hs:9: (Instance) :: IsList (BetterList x) diff --git a/test/Spec/OverloadedLists.stdout b/test/Spec/OverloadedLists.stdout new file mode 100644 index 0000000..e69de29 diff --git a/test/Spec/OverloadedLists.toml b/test/Spec/OverloadedLists.toml new file mode 100644 index 0000000..c7c890b --- /dev/null +++ b/test/Spec/OverloadedLists.toml @@ -0,0 +1,3 @@ +roots = [ "Spec.OverloadedLists.OverloadedLists.root" ] + +type-class-roots = false diff --git a/test/Spec/OverloadedLists/OverloadedLists.hs b/test/Spec/OverloadedLists/OverloadedLists.hs new file mode 100644 index 0000000..96509d2 --- /dev/null +++ b/test/Spec/OverloadedLists/OverloadedLists.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE TypeFamilies #-} +module Spec.OverloadedLists.OverloadedLists where + +import GHC.IsList ( IsList(..) ) + +data BetterList x = Nil | Cons x (BetterList x) + +instance IsList (BetterList x) where + type Item (BetterList x) = x + fromList = foldr Cons Nil + toList Nil = [] + toList (Cons x xs) = x : toList xs + +root :: BetterList Int +root = [1, 2, 3] diff --git a/test/Spec/OverloadedStrings.failing b/test/Spec/OverloadedStrings.failing new file mode 100644 index 0000000..5f77a90 --- /dev/null +++ b/test/Spec/OverloadedStrings.failing @@ -0,0 +1 @@ +test/Spec/OverloadedStrings/OverloadedStrings.hs:10: (Instance) :: IsString BetterString diff --git a/test/Spec/OverloadedStrings.stdout b/test/Spec/OverloadedStrings.stdout new file mode 100644 index 0000000..e69de29 diff --git a/test/Spec/OverloadedStrings.toml b/test/Spec/OverloadedStrings.toml new file mode 100644 index 0000000..56a9cd2 --- /dev/null +++ b/test/Spec/OverloadedStrings.toml @@ -0,0 +1,3 @@ +roots = [ "Spec.OverloadedStrings.OverloadedStrings.root", "Spec.OverloadedStrings.OverloadedStrings.root'" ] + +type-class-roots = false diff --git a/test/Spec/OverloadedStrings/OverloadedStrings.hs b/test/Spec/OverloadedStrings/OverloadedStrings.hs new file mode 100644 index 0000000..c99dba4 --- /dev/null +++ b/test/Spec/OverloadedStrings/OverloadedStrings.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -Wno-missing-signatures #-} +module Spec.OverloadedStrings.OverloadedStrings where + +import Data.String ( IsString(fromString) ) + +newtype BetterString = BetterString String + +-- $fIsStringBetterString should not be detected as unused +instance IsString BetterString where + fromString = BetterString + +newtype BetterString' = BetterString' String + +instance IsString BetterString' where + fromString = BetterString' + +-- Thought: this problem might be similar to RebindableSyntax, QualifiedDo, etc +root :: BetterString +root = "Hello World" -- no evidence variable usage here + +root' = "Hello World" :: BetterString' -- evidence usage present diff --git a/test/Spec/RangeEnum.failing b/test/Spec/RangeEnum.failing new file mode 100644 index 0000000..679e2dc --- /dev/null +++ b/test/Spec/RangeEnum.failing @@ -0,0 +1 @@ +test/Spec/RangeEnum/RangeEnum.hs:14: (Instance) :: Enum Colour diff --git a/test/Spec/RangeEnum.stdout b/test/Spec/RangeEnum.stdout new file mode 100644 index 0000000..e69de29 diff --git a/test/Spec/RangeEnum.toml b/test/Spec/RangeEnum.toml new file mode 100644 index 0000000..f6f31b7 --- /dev/null +++ b/test/Spec/RangeEnum.toml @@ -0,0 +1,7 @@ +roots = [ "Spec.RangeEnum.RangeEnum.planets" + , "Spec.RangeEnum.RangeEnum.letters" + , "Spec.RangeEnum.RangeEnum.shapes" + , "Spec.RangeEnum.RangeEnum.colours" + ] + +type-class-roots = false diff --git a/test/Spec/RangeEnum/RangeEnum.hs b/test/Spec/RangeEnum/RangeEnum.hs new file mode 100644 index 0000000..837706b --- /dev/null +++ b/test/Spec/RangeEnum/RangeEnum.hs @@ -0,0 +1,26 @@ +{-# OPTIONS_GHC -Wno-missing-signatures #-} +module Spec.RangeEnum.RangeEnum where + +data Planet = Mercury | Venus | Earth + deriving (Enum, Bounded) + +data Letter = A | B | C + deriving (Enum, Bounded, Show) + +data Shape = Circle | Square | Triangle + deriving (Enum, Bounded) + +data Colour = Red | Green | Blue + deriving (Enum, Bounded) + +planets = [minBound .. (maxBound :: Planet)] + +letters = map f [minBound .. maxBound] + where + f :: Letter -> String + f = show + +shapes = [minBound .. maxBound] :: [Shape] + +colours :: [Colour] +colours = [minBound .. maxBound] :: [Colour] -- breaks diff --git a/test/Spec/RootClasses.stdout b/test/Spec/RootClasses.stdout new file mode 100644 index 0000000..46dcd77 --- /dev/null +++ b/test/Spec/RootClasses.stdout @@ -0,0 +1 @@ +test/Spec/RootClasses/RootClasses.hs:5: (Instance) :: Enum T diff --git a/test/Spec/RootClasses.toml b/test/Spec/RootClasses.toml new file mode 100644 index 0000000..a9eb77b --- /dev/null +++ b/test/Spec/RootClasses.toml @@ -0,0 +1,5 @@ +roots = [] + +type-class-roots = false + +root-classes = [ "Show", "Ord", "Bar" ] diff --git a/test/Spec/RootClasses/RootClasses.hs b/test/Spec/RootClasses/RootClasses.hs new file mode 100644 index 0000000..e365f49 --- /dev/null +++ b/test/Spec/RootClasses/RootClasses.hs @@ -0,0 +1,17 @@ +-- | Test for marking classes as roots +{-# LANGUAGE StandaloneDeriving #-} +module Spec.RootClasses.RootClasses where + +data T = MkT deriving (Eq, Show, Enum) + +data U = MkU + +deriving instance Ord T + +data V = MkV + +class Bar a where + bar :: a -> Char + +instance Bar V where + bar = const 'b' diff --git a/test/Spec/StandaloneDeriving.stdout b/test/Spec/StandaloneDeriving.stdout new file mode 100644 index 0000000..850368f --- /dev/null +++ b/test/Spec/StandaloneDeriving.stdout @@ -0,0 +1 @@ +test/Spec/StandaloneDeriving/StandaloneDeriving.hs:6: (Instance) :: Show A diff --git a/test/Spec/StandaloneDeriving.toml b/test/Spec/StandaloneDeriving.toml new file mode 100644 index 0000000..9ae705e --- /dev/null +++ b/test/Spec/StandaloneDeriving.toml @@ -0,0 +1,3 @@ +roots = [ "Spec.StandaloneDeriving.StandaloneDeriving.T" ] + +type-class-roots = false diff --git a/test/Spec/StandaloneDeriving/StandaloneDeriving.hs b/test/Spec/StandaloneDeriving/StandaloneDeriving.hs new file mode 100644 index 0000000..04c7668 --- /dev/null +++ b/test/Spec/StandaloneDeriving/StandaloneDeriving.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE StandaloneDeriving #-} +module Spec.StandaloneDeriving.StandaloneDeriving where + +data A = A + +deriving instance Show A diff --git a/weeder.cabal b/weeder.cabal index c25acfd..ec49ce4 100644 --- a/weeder.cabal +++ b/weeder.cabal @@ -18,6 +18,7 @@ extra-doc-files: extra-source-files: test/Spec/*.toml test/Spec/*.stdout + test/Spec/*.failing library build-depends: @@ -87,6 +88,19 @@ test-suite weeder-test other-modules: Paths_weeder -- Tests + Spec.ApplicativeDo.ApplicativeDo Spec.BasicExample.BasicExample + Spec.DeriveGeneric.DeriveGeneric + Spec.InstanceRootConstraint.InstanceRootConstraint + Spec.InstanceTypeclass.InstanceTypeclass + Spec.Monads.Monads + Spec.NumInstance.NumInstance + Spec.NumInstanceLiteral.NumInstanceLiteral + Spec.OverloadedLabels.OverloadedLabels + Spec.OverloadedLists.OverloadedLists + Spec.OverloadedStrings.OverloadedStrings + Spec.RangeEnum.RangeEnum + Spec.RootClasses.RootClasses + Spec.StandaloneDeriving.StandaloneDeriving ghc-options: -Wall -fwarn-incomplete-uni-patterns -fwrite-ide-info -hiedir ./test default-language: Haskell2010