{-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} module Development.Guardian.App ( BuildInfo (..), defaultMain, defaultMainWith, reportPackageGraphValidation, buildInfoQ, ) where import Control.Applicative ((<**>)) import qualified Data.Aeson as J import Data.Foldable.WithIndex import Data.Functor.WithIndex.Instances () import Data.List (intersperse) import qualified Data.List.NonEmpty as NE import qualified Data.Map.Strict as Map import Data.Monoid (Sum (..)) import qualified Data.Set as Set import Data.Version (Version (..), showVersion) import qualified Data.Yaml as Y import Development.Guardian.Constants (configFileName) import Development.Guardian.Graph import qualified Development.Guardian.Graph.Adapter.Cabal as Cabal import Development.Guardian.Graph.Adapter.Detection (detectAdapterThrow) import qualified Development.Guardian.Graph.Adapter.Stack as Stack import Development.Guardian.Graph.Adapter.Types import Development.Guardian.Types import GitHash (GitInfo, giDirty, giHash, tGitInfoCwdTry) import Language.Haskell.TH.Syntax import qualified Options.Applicative as Opts import Path import Path.IO (canonicalizePath, getCurrentDir) import RIO import System.Environment (getArgs) import Validation (validation, validationToEither) data Option = Option { Option -> Maybe StandardAdapters mode :: Maybe StandardAdapters , Option -> Maybe (SomeBase Dir) target :: Maybe (SomeBase Dir) , Option -> Path Rel File config :: Path Rel File } deriving (Int -> Option -> ShowS [Option] -> ShowS Option -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Option] -> ShowS $cshowList :: [Option] -> ShowS show :: Option -> String $cshow :: Option -> String showsPrec :: Int -> Option -> ShowS $cshowsPrec :: Int -> Option -> ShowS Show, Option -> Option -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Option -> Option -> Bool $c/= :: Option -> Option -> Bool == :: Option -> Option -> Bool $c== :: Option -> Option -> Bool Eq, Eq Option Option -> Option -> Bool Option -> Option -> Ordering Option -> Option -> Option forall a. Eq a -> (a -> a -> Ordering) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> a) -> (a -> a -> a) -> Ord a min :: Option -> Option -> Option $cmin :: Option -> Option -> Option max :: Option -> Option -> Option $cmax :: Option -> Option -> Option >= :: Option -> Option -> Bool $c>= :: Option -> Option -> Bool > :: Option -> Option -> Bool $c> :: Option -> Option -> Bool <= :: Option -> Option -> Bool $c<= :: Option -> Option -> Bool < :: Option -> Option -> Bool $c< :: Option -> Option -> Bool compare :: Option -> Option -> Ordering $ccompare :: Option -> Option -> Ordering Ord) data BuildInfo = BuildInfo {BuildInfo -> String versionString :: String, BuildInfo -> Maybe GitInfo gitInfo :: Maybe GitInfo} deriving (Int -> BuildInfo -> ShowS [BuildInfo] -> ShowS BuildInfo -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [BuildInfo] -> ShowS $cshowList :: [BuildInfo] -> ShowS show :: BuildInfo -> String $cshow :: BuildInfo -> String showsPrec :: Int -> BuildInfo -> ShowS $cshowsPrec :: Int -> BuildInfo -> ShowS Show) buildInfoQ :: Version -> Code Q BuildInfo buildInfoQ :: Version -> Code Q BuildInfo buildInfoQ Version version = [|| BuildInfo { versionString = $$(liftTyped $ showVersion version) , gitInfo = either (const Nothing) Just $$(tGitInfoCwdTry) } ||] optsPI :: BuildInfo -> Opts.ParserInfo Option optsPI :: BuildInfo -> ParserInfo Option optsPI BuildInfo {String Maybe GitInfo gitInfo :: Maybe GitInfo versionString :: String gitInfo :: BuildInfo -> Maybe GitInfo versionString :: BuildInfo -> String ..} = forall a. Parser a -> InfoMod a -> ParserInfo a Opts.info (Parser Option p forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b <**> forall a. Parser (a -> a) Opts.helper forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b <**> forall a. Parser (a -> a) versions) forall a. Monoid a => a mempty where gitRev :: String gitRev = forall b a. b -> (a -> b) -> Maybe a -> b maybe String "" ( \GitInfo gi -> String ", Git revision " forall a. Semigroup a => a -> a -> a <> GitInfo -> String giHash GitInfo gi forall a. Semigroup a => a -> a -> a <> if GitInfo -> Bool giDirty GitInfo gi then String " (dirty)" else String "" ) Maybe GitInfo gitInfo verStr :: String verStr = String "Guardian Version " forall a. Semigroup a => a -> a -> a <> String versionString forall a. Semigroup a => a -> a -> a <> String gitRev versions :: Parser (a -> a) versions = forall a. String -> Mod OptionFields (a -> a) -> Parser (a -> a) Opts.infoOption String verStr (forall (f :: * -> *) a. HasName f => String -> Mod f a Opts.long String "version" forall a. Semigroup a => a -> a -> a <> forall (f :: * -> *) a. HasName f => Char -> Mod f a Opts.short Char 'V' forall a. Semigroup a => a -> a -> a <> forall (f :: * -> *) a. String -> Mod f a Opts.help String "Prints version string and exit.") inP :: Maybe StandardAdapters -> Parser Option inP Maybe StandardAdapters mode = do Path Rel File config <- forall a. ReadM a -> Mod OptionFields a -> Parser a Opts.option (forall a. (String -> Either String a) -> ReadM a Opts.eitherReader String -> Either String (Path Rel File) parsFileP) forall a b. (a -> b) -> a -> b $ forall (f :: * -> *) a. HasName f => String -> Mod f a Opts.long String "config" forall a. Semigroup a => a -> a -> a <> forall (f :: * -> *) a. HasName f => Char -> Mod f a Opts.short Char 'c' forall a. Semigroup a => a -> a -> a <> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a Opts.metavar String "PATH" forall a. Semigroup a => a -> a -> a <> forall (f :: * -> *) a. HasValue f => a -> Mod f a Opts.value Path Rel File configFileName forall a. Semigroup a => a -> a -> a <> forall a (f :: * -> *). Show a => Mod f a Opts.showDefault forall a. Semigroup a => a -> a -> a <> forall (f :: * -> *) a. String -> Mod f a Opts.help String "configuration file, relative to the target directory" Maybe (SomeBase Dir) target <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a) optional forall a b. (a -> b) -> a -> b $ forall a. ReadM a -> Mod ArgumentFields a -> Parser a Opts.argument (forall a. (String -> Either String a) -> ReadM a Opts.eitherReader String -> Either String (SomeBase Dir) parseDirP) forall a b. (a -> b) -> a -> b $ forall (f :: * -> *) a. String -> Mod f a Opts.help String "input directory (uses current directory if missing)" forall a. Semigroup a => a -> a -> a <> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a Opts.metavar String "DIR" pure Option {Maybe (SomeBase Dir) Maybe StandardAdapters Path Rel File target :: Maybe (SomeBase Dir) config :: Path Rel File mode :: Maybe StandardAdapters config :: Path Rel File target :: Maybe (SomeBase Dir) mode :: Maybe StandardAdapters ..} autoP :: ParserInfo Option autoP = forall a. Parser a -> InfoMod a -> ParserInfo a Opts.info (Maybe StandardAdapters -> Parser Option inP forall a. Maybe a Nothing) forall a b. (a -> b) -> a -> b $ forall a. String -> InfoMod a Opts.progDesc String "Defends borders against the auto-detected build-system" p :: Parser Option p = forall a. Mod CommandFields a -> Parser a Opts.hsubparser ( forall a. Monoid a => [a] -> a mconcat [ forall a. String -> ParserInfo a -> Mod CommandFields a Opts.command String "auto" ParserInfo Option autoP , forall a. String -> ParserInfo a -> Mod CommandFields a Opts.command String "stack" ( forall a. Parser a -> InfoMod a -> ParserInfo a Opts.info (Maybe StandardAdapters -> Parser Option inP forall a b. (a -> b) -> a -> b $ forall a. a -> Maybe a Just StandardAdapters Stack) forall a b. (a -> b) -> a -> b $ forall a. String -> InfoMod a Opts.progDesc String "Defends borders against stack.yaml" ) , forall a. String -> ParserInfo a -> Mod CommandFields a Opts.command String "cabal" ( forall a. Parser a -> InfoMod a -> ParserInfo a Opts.info (Maybe StandardAdapters -> Parser Option inP forall a b. (a -> b) -> a -> b $ forall a. a -> Maybe a Just StandardAdapters Cabal) forall a b. (a -> b) -> a -> b $ forall a. String -> InfoMod a Opts.progDesc String "Defends borders against cabal.project" ) ] ) parseDirP :: String -> Either String (SomeBase Dir) parseDirP :: String -> Either String (SomeBase Dir) parseDirP = forall (p :: * -> * -> *) a b c. Bifunctor p => (a -> b) -> p a c -> p b c first forall a. Show a => a -> String show forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (m :: * -> *). MonadThrow m => String -> m (SomeBase Dir) parseSomeDir parsFileP :: String -> Either String (Path Rel File) parsFileP :: String -> Either String (Path Rel File) parsFileP = forall (p :: * -> * -> *) a b c. Bifunctor p => (a -> b) -> p a c -> p b c first forall a. Show a => a -> String show forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (m :: * -> *). MonadThrow m => String -> m (Path Rel File) parseRelFile data GuardianException = InvalidDependencyDomainYaml [DomainGraphError] | PackageGraphErrors [PackageViolation] deriving (Int -> GuardianException -> ShowS [GuardianException] -> ShowS GuardianException -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [GuardianException] -> ShowS $cshowList :: [GuardianException] -> ShowS show :: GuardianException -> String $cshow :: GuardianException -> String showsPrec :: Int -> GuardianException -> ShowS $cshowsPrec :: Int -> GuardianException -> ShowS Show, GuardianException -> GuardianException -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: GuardianException -> GuardianException -> Bool $c/= :: GuardianException -> GuardianException -> Bool == :: GuardianException -> GuardianException -> Bool $c== :: GuardianException -> GuardianException -> Bool Eq, Eq GuardianException GuardianException -> GuardianException -> Bool GuardianException -> GuardianException -> Ordering GuardianException -> GuardianException -> GuardianException forall a. Eq a -> (a -> a -> Ordering) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> a) -> (a -> a -> a) -> Ord a min :: GuardianException -> GuardianException -> GuardianException $cmin :: GuardianException -> GuardianException -> GuardianException max :: GuardianException -> GuardianException -> GuardianException $cmax :: GuardianException -> GuardianException -> GuardianException >= :: GuardianException -> GuardianException -> Bool $c>= :: GuardianException -> GuardianException -> Bool > :: GuardianException -> GuardianException -> Bool $c> :: GuardianException -> GuardianException -> Bool <= :: GuardianException -> GuardianException -> Bool $c<= :: GuardianException -> GuardianException -> Bool < :: GuardianException -> GuardianException -> Bool $c< :: GuardianException -> GuardianException -> Bool compare :: GuardianException -> GuardianException -> Ordering $ccompare :: GuardianException -> GuardianException -> Ordering Ord) deriving anyclass (Show GuardianException Typeable GuardianException SomeException -> Maybe GuardianException GuardianException -> String GuardianException -> SomeException forall e. Typeable e -> Show e -> (e -> SomeException) -> (SomeException -> Maybe e) -> (e -> String) -> Exception e displayException :: GuardianException -> String $cdisplayException :: GuardianException -> String fromException :: SomeException -> Maybe GuardianException $cfromException :: SomeException -> Maybe GuardianException toException :: GuardianException -> SomeException $ctoException :: GuardianException -> SomeException Exception) eitherResult :: J.Result a -> Either String a eitherResult :: forall a. Result a -> Either String a eitherResult (J.Error String s) = forall a b. a -> Either a b Left String s eitherResult (J.Success a a) = forall a b. b -> Either a b Right a a defaultMainWith :: (MonadUnliftIO m, MonadReader env m, HasLogFunc env) => BuildInfo -> [String] -> m () defaultMainWith :: forall (m :: * -> *) env. (MonadUnliftIO m, MonadReader env m, HasLogFunc env) => BuildInfo -> [String] -> m () defaultMainWith BuildInfo buildInfo [String] args = do Option {Maybe (SomeBase Dir) Maybe StandardAdapters Path Rel File config :: Path Rel File target :: Maybe (SomeBase Dir) mode :: Maybe StandardAdapters config :: Option -> Path Rel File target :: Option -> Maybe (SomeBase Dir) mode :: Option -> Maybe StandardAdapters ..} <- forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ forall a. ParserResult a -> IO a Opts.handleParseResult forall a b. (a -> b) -> a -> b $ forall a. ParserPrefs -> ParserInfo a -> [String] -> ParserResult a Opts.execParserPure ParserPrefs Opts.defaultPrefs (BuildInfo -> ParserInfo Option optsPI BuildInfo buildInfo) [String] args Path Abs Dir targ <- forall b a. b -> (a -> b) -> Maybe a -> b maybe forall (m :: * -> *). MonadIO m => m (Path Abs Dir) getCurrentDir forall path (m :: * -> *). (AnyPath path, MonadIO m) => path -> m (AbsPath path) canonicalizePath Maybe (SomeBase Dir) target forall (m :: * -> *) env. (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) => Utf8Builder -> m () logInfo forall a b. (a -> b) -> a -> b $ Utf8Builder "Using configuration: " forall a. Semigroup a => a -> a -> a <> forall a. IsString a => String -> a fromString (Path Rel File -> String fromRelFile Path Rel File config) Value yaml <- forall (m :: * -> *) a. (MonadIO m, FromJSON a) => String -> m a Y.decodeFileThrow (Path Abs File -> String fromAbsFile forall a b. (a -> b) -> a -> b $ Path Abs Dir targ forall b t. Path b Dir -> Path Rel t -> Path b t </> Path Rel File config) Domains doms <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c either forall (m :: * -> *) a. (MonadIO m, HasCallStack) => String -> m a throwString forall (f :: * -> *) a. Applicative f => a -> f a pure forall a b. (a -> b) -> a -> b $ forall a. Result a -> Either String a eitherResult forall a b. (a -> b) -> a -> b $ forall a. FromJSON a => Value -> Result a J.fromJSON Value yaml StandardAdapters mode' <- forall b a. b -> (a -> b) -> Maybe a -> b maybe (forall (m :: * -> *) b. MonadIO m => Value -> Path b Dir -> m StandardAdapters detectAdapterThrow Value yaml Path Abs Dir targ) forall (f :: * -> *) a. Applicative f => a -> f a pure Maybe StandardAdapters mode forall (m :: * -> *) env. (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) => Utf8Builder -> m () logInfo forall a b. (a -> b) -> a -> b $ Utf8Builder "Checking dependency of " forall a. Semigroup a => a -> a -> a <> forall a. Show a => a -> Utf8Builder displayShow Path Abs Dir targ forall a. Semigroup a => a -> a -> a <> Utf8Builder " with backend " forall a. Semigroup a => a -> a -> a <> forall a. Show a => a -> Utf8Builder displayShow StandardAdapters mode' PackageGraph pkgGraph <- case StandardAdapters mode' of StandardAdapters Stack -> forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c either forall (m :: * -> *) a. (MonadIO m, HasCallStack) => String -> m a throwString (PackageGraphOptions Stack -> IO PackageGraph Stack.buildPackageGraph forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a b c. (a -> b -> c) -> b -> a -> c flip forall backend. PackageBuildParser backend -> Path Abs Dir -> PackageGraphOptions backend withTargetPath Path Abs Dir targ) forall a b. (a -> b) -> a -> b $ forall a. Result a -> Either String a eitherResult forall a b. (a -> b) -> a -> b $ forall a. FromJSON a => Value -> Result a J.fromJSON Value yaml StandardAdapters Cabal -> forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c either forall (m :: * -> *) a. (MonadIO m, HasCallStack) => String -> m a throwString (PackageGraphOptions Cabal -> IO PackageGraph Cabal.buildPackageGraph forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a b c. (a -> b -> c) -> b -> a -> c flip forall backend. PackageBuildParser backend -> Path Abs Dir -> PackageGraphOptions backend withTargetPath Path Abs Dir targ) forall a b. (a -> b) -> a -> b $ forall a. Result a -> Either String a eitherResult forall a b. (a -> b) -> a -> b $ forall a. FromJSON a => Value -> Result a J.fromJSON Value yaml forall env (m :: * -> *). (MonadReader env m, MonadIO m, HasLogFunc env) => Domains -> PackageGraph -> m () reportPackageGraphValidation Domains doms PackageGraph pkgGraph reportPackageGraphValidation :: (MonadReader env m, MonadIO m, HasLogFunc env) => Domains -> PackageGraph -> m () reportPackageGraphValidation :: forall env (m :: * -> *). (MonadReader env m, MonadIO m, HasLogFunc env) => Domains -> PackageGraph -> m () reportPackageGraphValidation Domains doms PackageGraph pkgGraph = do let mdomInfo :: Validation (NonEmpty DomainGraphError) DomainInfo mdomInfo = Domains -> Validation (NonEmpty DomainGraphError) DomainInfo buildDomainInfo Domains doms DomainInfo domInfo <- forall e x a. (e -> x) -> (a -> x) -> Validation e a -> x validation ( \NonEmpty DomainGraphError errs -> do forall (m :: * -> *) env. (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) => Utf8Builder -> m () logError Utf8Builder "Errors exists in dependency domain definition!" forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => (a -> m b) -> t a -> m () mapM_ (forall (m :: * -> *) env. (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) => Utf8Builder -> m () logError forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. Show a => a -> Utf8Builder displayShow) NonEmpty DomainGraphError errs forall (m :: * -> *) a. MonadIO m => m a exitFailure ) forall (f :: * -> *) a. Applicative f => a -> f a pure Validation (NonEmpty DomainGraphError) DomainInfo mdomInfo let chkResult :: Either (NonEmpty PackageViolation) CheckResult chkResult = forall e a. Validation e a -> Either e a validationToEither forall a b. (a -> b) -> a -> b $ DomainInfo -> PackageGraph -> Validation (NonEmpty PackageViolation) CheckResult validatePackageGraph DomainInfo domInfo PackageGraph pkgGraph case Either (NonEmpty PackageViolation) CheckResult chkResult of Left NonEmpty PackageViolation errs -> do forall (m :: * -> *) env. (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) => Utf8Builder -> m () logError forall a b. (a -> b) -> a -> b $ Utf8Builder "Dependency domain violation(s): found " forall a. Semigroup a => a -> a -> a <> forall a. Show a => a -> Utf8Builder displayShow (forall a. NonEmpty a -> Int NE.length NonEmpty PackageViolation errs) forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => (a -> m b) -> t a -> m () mapM_ (forall (m :: * -> *) env. (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) => Utf8Builder -> m () logError forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. Show a => a -> Utf8Builder displayShow) NonEmpty PackageViolation errs forall (m :: * -> *) a. MonadIO m => m a exitFailure Right CheckResult Ok -> forall (m :: * -> *) env. (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) => Utf8Builder -> m () logInfo Utf8Builder "All dependency boundary is good!" Right (OkWithDiagnostics Diagnostics {Map PackageName (Set Dependency) usedExceptionalRules :: Diagnostics -> Map PackageName (Set Dependency) redundantExtraDeps :: Diagnostics -> Map PackageName (Set Dependency) usedExceptionalRules :: Map PackageName (Set Dependency) redundantExtraDeps :: Map PackageName (Set Dependency) ..}) -> do forall (f :: * -> *). Applicative f => Bool -> f () -> f () unless (forall k a. Map k a -> Bool Map.null Map PackageName (Set Dependency) usedExceptionalRules) forall a b. (a -> b) -> a -> b $ do forall (m :: * -> *) env. (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) => Utf8Builder -> m () logWarn Utf8Builder "------------------------------" forall (m :: * -> *) env. (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) => Utf8Builder -> m () logWarn Utf8Builder "* Following exceptional rules are used:" forall i (t :: * -> *) (m :: * -> *) a b. (FoldableWithIndex i t, Monad m) => t a -> (i -> a -> m b) -> m () iforM_ Map PackageName (Set Dependency) usedExceptionalRules forall a b. (a -> b) -> a -> b $ \PackageName pkg Set Dependency deps -> do let ds :: [Dependency] ds = forall a. Set a -> [a] Set.toList Set Dependency deps forall (m :: * -> *) env. (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) => Utf8Builder -> m () logWarn forall a b. (a -> b) -> a -> b $ Utf8Builder " - " forall a. Semigroup a => a -> a -> a <> forall a. Show a => a -> Utf8Builder displayShow PackageName pkg forall a. Semigroup a => a -> a -> a <> Utf8Builder " depends on: " forall a. Semigroup a => a -> a -> a <> forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m fold (forall a. a -> [a] -> [a] intersperse Utf8Builder "," forall a b. (a -> b) -> a -> b $ forall a b. (a -> b) -> [a] -> [b] map forall a. Show a => a -> Utf8Builder displayShow [Dependency] ds) forall (f :: * -> *). Applicative f => Bool -> f () -> f () unless (forall k a. Map k a -> Bool Map.null Map PackageName (Set Dependency) redundantExtraDeps) forall a b. (a -> b) -> a -> b $ do let reduntCount :: Int reduntCount = forall a. Sum a -> a getSum forall a b. (a -> b) -> a -> b $ forall (t :: * -> *) m a. (Foldable t, Monoid m) => (a -> m) -> t a -> m foldMap (forall a. a -> Sum a Sum forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. Set a -> Int Set.size) Map PackageName (Set Dependency) redundantExtraDeps forall (m :: * -> *) env. (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) => Utf8Builder -> m () logWarn Utf8Builder "------------------------------" forall (m :: * -> *) env. (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) => Utf8Builder -> m () logWarn forall a b. (a -> b) -> a -> b $ Utf8Builder "* " forall a. Semigroup a => a -> a -> a <> forall a. Show a => a -> Utf8Builder displayShow Int reduntCount forall a. Semigroup a => a -> a -> a <> Utf8Builder " redundant exceptional dependency(s) found:" forall i (t :: * -> *) (m :: * -> *) a b. (FoldableWithIndex i t, Monad m) => t a -> (i -> a -> m b) -> m () iforM_ Map PackageName (Set Dependency) redundantExtraDeps forall a b. (a -> b) -> a -> b $ \PackageName pkg Set Dependency deps -> do let ds :: [Dependency] ds = forall a. Set a -> [a] Set.toList Set Dependency deps forall (m :: * -> *) env. (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) => Utf8Builder -> m () logWarn forall a b. (a -> b) -> a -> b $ Utf8Builder " - " forall a. Semigroup a => a -> a -> a <> forall a. Show a => a -> Utf8Builder displayShow PackageName pkg forall a. Semigroup a => a -> a -> a <> Utf8Builder " doesn't depends on: " forall a. Semigroup a => a -> a -> a <> forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m fold (forall a. a -> [a] -> [a] intersperse Utf8Builder ", " forall a b. (a -> b) -> a -> b $ forall a b. (a -> b) -> [a] -> [b] map forall a. Show a => a -> Utf8Builder displayShow [Dependency] ds) forall a. Semigroup a => a -> a -> a <> Utf8Builder "\n" forall (m :: * -> *) env. (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) => Utf8Builder -> m () logInfo Utf8Builder "------------------------------" forall (m :: * -> *) env. (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) => Utf8Builder -> m () logInfo Utf8Builder "All dependency boundary is good, with some additional warning." defaultMain :: MonadUnliftIO m => BuildInfo -> m () defaultMain :: forall (m :: * -> *). MonadUnliftIO m => BuildInfo -> m () defaultMain BuildInfo binfo = do LogOptions logOpts <- forall (m :: * -> *). MonadIO m => Handle -> Bool -> m LogOptions logOptionsHandle Handle stdout Bool True forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b <&> Bool -> LogOptions -> LogOptions setLogUseTime Bool False forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b <&> Bool -> LogOptions -> LogOptions setLogUseLoc Bool False forall (m :: * -> *) a. MonadUnliftIO m => LogOptions -> (LogFunc -> m a) -> m a withLogFunc LogOptions logOpts forall a b. (a -> b) -> a -> b $ \LogFunc logFun -> do SimpleApp app <- forall (m :: * -> *). MonadIO m => LogFunc -> Maybe ProcessContext -> m SimpleApp mkSimpleApp LogFunc logFun forall a. Maybe a Nothing forall (m :: * -> *) env a. MonadIO m => env -> RIO env a -> m a runRIO SimpleApp app forall a b. (a -> b) -> a -> b $ forall (m :: * -> *) env. (MonadUnliftIO m, MonadReader env m, HasLogFunc env) => BuildInfo -> [String] -> m () defaultMainWith BuildInfo binfo forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO IO [String] getArgs