Skip to content

Commit

Permalink
[feat] run cabal-install to generate a plan
Browse files Browse the repository at this point in the history
  • Loading branch information
MangoIV committed Feb 11, 2024
1 parent 3e093fe commit c7a701f
Show file tree
Hide file tree
Showing 4 changed files with 82 additions and 24 deletions.
9 changes: 5 additions & 4 deletions code/hsec-cabal/hsec-cabal.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -34,20 +34,21 @@ common common-all
BlockArguments
DeriveGeneric
DerivingStrategies
EmptyCase
LambdaCase
NamedFieldPuns

library
import: common-all
exposed-modules:
Distribution.Audit
Distribution.Audit.Option
Security.Advisories.Cabal

build-depends:
, base <5
, base <5
, Cabal
, cabal-install
, Cabal-syntax
, hsec-core
, optparse-applicative

hs-source-dirs: src
default-language: Haskell2010
Expand Down
76 changes: 74 additions & 2 deletions code/hsec-cabal/src/Distribution/Audit.hs
Original file line number Diff line number Diff line change
@@ -1,5 +1,77 @@
module Distribution.Audit (auditMain) where

import Data.Foldable (traverse_)
import qualified Distribution.Client.InstallPlan as Plan
import Distribution.Client.NixStyleOptions
( NixStyleFlags (configFlags)
, defaultNixStyleFlags
, nixStyleOptions
)
import Distribution.Client.ProjectConfig (ProjectConfig)
import Distribution.Client.ProjectOrchestration
( CurrentCommand (OtherCommand)
, ProjectBaseContext
( ProjectBaseContext
, cabalDirLayout
, distDirLayout
, localPackages
, projectConfig
)
, commandLineFlagsToProjectConfig
, establishProjectBaseContext
)
import Distribution.Client.ProjectPlanning (rebuildInstallPlan)
import Distribution.Client.Setup (ConfigFlags (configVerbosity), defaultGlobalFlags)
import Distribution.Simple.Command
( CommandParse (CommandErrors, CommandHelp, CommandList, CommandReadyToGo)
, CommandUI (..)
, commandParseArgs
)
import Distribution.Simple.Flag (fromFlagOrDefault)
import qualified Distribution.Verbosity as Verbosity
import System.Environment (getArgs)

auditMain :: IO ()
auditMain = do
putStrLn "unimplemented"
auditMain =
handleArgs auditCommandUI \flags -> do
let verbosity = verbosityFromFlags flags
cliConfig = projectConfigFromFlags flags
ProjectBaseContext {distDirLayout, cabalDirLayout, projectConfig, localPackages} <-
establishProjectBaseContext
verbosity
cliConfig
OtherCommand
(_, plan, _, _, _) <-
rebuildInstallPlan verbosity distDirLayout cabalDirLayout projectConfig localPackages Nothing
print `traverse_` Plan.toList plan

projectConfigFromFlags :: NixStyleFlags a -> ProjectConfig
projectConfigFromFlags flags = commandLineFlagsToProjectConfig defaultGlobalFlags flags mempty

verbosityFromFlags :: NixStyleFlags a -> Verbosity.Verbosity
verbosityFromFlags = fromFlagOrDefault Verbosity.normal . configVerbosity . configFlags

auditCommandUI :: CommandUI (NixStyleFlags ())
auditCommandUI =
CommandUI
{ commandName = "cabal-audit"
, commandSynopsis = "Audits your cabal project"
, commandUsage = ("Usage: " ++)
, commandDescription = Nothing
, commandNotes = Nothing
, commandDefaultFlags = defaultNixStyleFlags ()
, commandOptions = nixStyleOptions (const [])
}

-- | handle cabal global command args
handleArgs
:: CommandUI flags
-> (flags -> IO ())
-> IO ()
handleArgs ui k = do
args <- getArgs
case commandParseArgs ui True args of
CommandHelp help -> putStrLn $ help "cabal-audit"
CommandList opts -> putStrLn $ "commandList: " <> show opts
CommandErrors errs -> putStrLn $ "commandErrors: " <> show errs
CommandReadyToGo (flags, _commandParse) -> k $ flags $ commandDefaultFlags ui
18 changes: 0 additions & 18 deletions code/hsec-cabal/src/Distribution/Audit/Option.hs

This file was deleted.

3 changes: 3 additions & 0 deletions code/hsec-cabal/src/Security/Advisories/Cabal.hs
Original file line number Diff line number Diff line change
@@ -1 +1,4 @@
module Security.Advisories.Cabal where



0 comments on commit c7a701f

Please sign in to comment.